Index: LMDZ6/trunk/libf/phylmd/conf_phys_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/conf_phys_m.F90	(revision 3906)
+++ LMDZ6/trunk/libf/phylmd/conf_phys_m.F90	(revision 3908)
@@ -2614,4 +2614,9 @@
       ENDIF
     ELSE IF (iflag_rrtm .EQ. 1) THEN
+      IF (NSW.NE.2.AND.NSW.NE.4.AND.NSW.NE.6) THEN
+        WRITE(lunout,*) ' ERROR iflag_rrtm=1 and NSW<>2,4,6 not possible'
+        CALL abort_physic('conf_phys','choice NSW not valid',1)
+      ENDIF
+   ELSE IF (iflag_rrtm .EQ. 2) THEN
       IF (NSW.NE.2.AND.NSW.NE.4.AND.NSW.NE.6) THEN
         WRITE(lunout,*) ' ERROR iflag_rrtm=1 and NSW<>2,4,6 not possible'
Index: LMDZ6/trunk/libf/phylmd/ecrad/AER-BSD3-LICENSE
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/AER-BSD3-LICENSE	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/AER-BSD3-LICENSE	(revision 3908)
@@ -0,0 +1,28 @@
+THE BSD 3-CLAUSE LICENSE
+
+Copyright (c) 2002-2016, Atmospheric & Environmental Research, Inc. (AER)
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of Atmospheric & Environmental Research, Inc., nor the
+      names of its contributors may be used to endorse or promote products
+      derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL ATMOSPHERIC &
+ENVIRONMENTAL RESEARCH, INC., BE LIABLE FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
+OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR
+TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
+USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGE.
Index: LMDZ6/trunk/libf/phylmd/ecrad/CONVENTIONS
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/CONVENTIONS	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/CONVENTIONS	(revision 3908)
@@ -0,0 +1,63 @@
+The Fortran conventions that the author of the code in this directory
+aspired to are as follows:
+
+ - Module names are prefixed by the static library name, in this case
+   "radiation" (no need to suffix by "_mod" since this is always
+   obvious from the context)
+
+ - Names of derived types are suffixed by "_type"
+
+ - Implicit none everywhere
+
+ - Logicals are prefixed by "do_", "use_" or "is_"
+
+ - All variables in SI units by default
+
+ - Variables not in SI units have the units in the variable name,
+   e.g. pressure_hPa
+
+ - Integers either prefixed by "j" to indicate loop counter, "n" to
+   indicate the size of an array dimension, or "i" otherwise.
+
+ - Loop counters should be brief and contain no underscores
+
+ - Integers variables beginning with "n" or "i" should either contain
+   no underscores (e.g. "naerosoltypes"), or should have an underscore
+   immediately after the "n" or "i" (e.g. "n_aerosol_types"). Thus, a
+   variable beginning with "n" or "i" containing an underscore but not
+   as its second character need not be an integer (would normally then
+   be a real or a derived type), in order to enable real variables
+   such as "ice_water_content".
+
+ - All variables and procedure names in lower case using descriptive
+   names, and if not too long these will be composed of complete words
+   separated by underscores
+
+ - All parameters are in CamelCase, and integer parameters are
+   prefixed by "I" or "N"
+
+ - C-style enumerations are treated as integer parameters
+
+ - Variable character strings are suffixed by "_name" or "_str", while
+   parameter character strings (in CamelCase) are suffixed by "Name"
+   or "Str"
+
+ - Global data included in modules must be constant; any variable data
+   must be passed to procedures via dummy arguments
+
+ - Long argument lists avoided by grouping variables thematically into
+   derived types
+
+ - Any variable used in a source file should be defined in a comment
+   earlier in the source file (if this is not obvious from the
+   variable name) including its units if it has them (even if they are
+   SI units)
+
+ - All functions and subroutines to be defined in modules and their
+   explicit interfaces to be revealed via the "use" command, which
+   should use "only".
+
+ - Data are read in at run-time from NetCDF files rather than being
+   embedded in the code (e.g. using data statements).
+
+ - Lots of comments!
Index: LMDZ6/trunk/libf/phylmd/ecrad/DEPENDENCIES.txt
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/DEPENDENCIES.txt	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/DEPENDENCIES.txt	(revision 3908)
@@ -0,0 +1,51 @@
+PARKIND1
+PARRRTM
+PARSRTM
+YOEAERATM
+YOERAD
+YOERDI
+YOERRTA1
+YOERRTA10
+YOERRTA11
+YOERRTA12
+YOERRTA13
+YOERRTA14
+YOERRTA15
+YOERRTA16
+YOERRTA2
+YOERRTA3
+YOERRTA4
+YOERRTA5
+YOERRTA6
+YOERRTA7
+YOERRTA8
+YOERRTA9
+YOERRTAB
+YOERRTM
+YOERRTRF
+YOERRTWN
+YOESRTA16
+YOESRTA17
+YOESRTA18
+YOESRTA19
+YOESRTA20
+YOESRTA21
+YOESRTA22
+YOESRTA23
+YOESRTA24
+YOESRTA25
+YOESRTA26
+YOESRTA27
+YOESRTA28
+YOESRTA29
+YOESRTAB
+YOESRTAER
+YOESRTM
+YOESRTWN
+YOESW
+YOMCST
+YOMDIMV
+YOMDYNCORE
+YOMHOOK
+YOMPHY3
+YOM_YGFL
Index: LMDZ6/trunk/libf/phylmd/ecrad/MODIFICATIONS
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/MODIFICATIONS	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/MODIFICATIONS	(revision 3908)
@@ -0,0 +1,16 @@
+srtm_gas_optical_depth.F90
+	New file - adapted from srtm_spcrt(_mcica).F90
+	MODIFIED 28 Sept 2015
+rrtm_prepare_gases.F90
+	New file - adapted from rrtm_ecrt_140gp_mcica.F90
+	MODIFIED 28 Sept 2015
+rrtm_rrtm_140gp_mcica.F90
+	Remove ZHEATFAC
+srtm_srtm_224gp_mcica.F90 - NOT USED?
+	RII0 is an argument
+rrtm_setcoeff_140gp.F90
+	Fix argument order
+yoesrta21.F90
+	Fix equivalence
+rrtm_init_140gp.F90, rrtm_kgb1.F90, srtm_init.F90, srtm_kgb16.F90
+	Pass through directory containing RADRRTM and RADSRTM
Index: LMDZ6/trunk/libf/phylmd/ecrad/README
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/README	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/README	(revision 3908)
@@ -0,0 +1,72 @@
+This directory contains the main part of the radiation scheme except
+for the calculation of gas optics.  It is compiled into static library
+../lib/libradiation.a and module files ../mod/radiation_*.mod. The
+coding conventions are described in the CONVENTIONS file.  See the
+file ../driver/radiation_driver.f90 for an example of how the
+radiation scheme is called. The code is arranged as follows.
+
+The configuration information for the radiation scheme is stored in a
+"config" object (type defined in *radiation_config.f90*).  After this
+has been populated depending on how the radiation scheme is to be
+configured, the subroutine "setup_radiation" in
+*radiation_interface.f90* is called.  This sets up the gas, cloud and
+aerosol optics, all of which involve reading data from NetCDF files.
+The cloud and aerosol optics data are described in
+*radiation_aerosol_optics_data.f90* and
+*radiation_cloud_optics_data.f90*.
+
+The main interface to the radiation scheme is via the "radiation"
+subroutine in radiation_interface.f90, which takes six objects as
+input (noting that multiple columns are processed at once):
+
+  single_level - all single-level fields such as skin temperature and
+      surface albedo (type defined in *radiation_single_level.f90*)
+
+  thermodynamics - pressure and temperature (type defined in
+      *radiation_thermodynamics.f90*)
+
+  gas - mixing ratios of gases (type defined in *radiation_gas.f90*)
+
+  cloud - cloud fraction, water content and other information (type
+      defined in *radiation_cloud.f90*)
+
+  aerosol - mixing ratios of different aerosol species (type defined
+      in *radiation_aerosol.f90*)
+
+The output is stored in the following object:
+
+  flux - upwelling and downwelling shortwave and longwave fluxes (type
+      defined in *radiation_flux.f90*)
+
+The "radiation" subroutine first computes the gas optical properties
+(in the form of 3D arrays of dimension column, height and spectral
+g-point), via a call to the "gas_optics" subroutine in
+*radiation_ifsrrtm.f90*, which provides an interface to the IFS
+implementation of the RRTM-G gas optics model in the ../ifsrrtm
+directory.  For testing, a simple monochromatic gas model is also
+provided in *radiation_monochromatic.f90*.
+
+To these fields are added the contribution from aerosols via a call to
+the "aerosol_optics" subroutine, from *radiation_aerosol_optics.f90*.
+
+Cloud optical properties are computed (in the form of 3D arrays of
+dimension column, height and spectral band), via a call to the
+"cloud_optics" subroutine in *radiation_cloud_optics.f90*.
+
+The optical properties may then be saved to an intermediate NetCDF
+file via a routine in *radiation_save.f90*.
+
+Finally, the optics data are passed to the solver, which computes the
+flux profiles.  Currently McICA nad SPARTACUS solvers are
+available. In the case of SPARTACUS, the longwave and shortwave
+versions are in *radiation_spartacus_lw.f90* and
+*radiation_spartacus_sw.f90*, respectively.  These make use of
+routines in the following files:
+
+  *radiation_two_stream.f90* - compute two-stream coefficients
+
+  *radiation_matrix.f90* - matrix operations needed by SPARTACUS
+
+  *radiation_overlap.f90* - compute cloud overlap matrices.
+
+Physical constants are provided in *radiation_constants.f90*.
Index: LMDZ6/trunk/libf/phylmd/ecrad/abor1.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/abor1.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/abor1.F90	(revision 3908)
@@ -0,0 +1,34 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+SUBROUTINE ABOR1(CDTEXT)
+
+USE PARKIND1,      ONLY : JPIM, JPRB
+USE YOMLUN_IFSAUX, ONLY : NULOUT, NULERR
+
+IMPLICIT NONE
+
+CHARACTER(LEN=*), INTENT(IN) :: CDTEXT
+
+IF (NULOUT >= 0) WRITE(NULOUT,'(1X,A)') CDTEXT
+IF (NULERR >= 0) WRITE(NULERR,'(1X,A,A)') 'ABORT! ', CDTEXT
+
+IF (NULOUT >= 0) THEN
+  ! FLUSH not understood by NAG compiler
+  !CALL FLUSH(NULOUT)
+  IF (NULOUT /= 0 .and. NULOUT /= 6) CLOSE(NULOUT)
+ENDIF
+
+#ifdef __PGI
+      stop 1
+#else
+      error stop 1
+#endif
+
+END SUBROUTINE ABOR1
Index: LMDZ6/trunk/libf/phylmd/ecrad/abor1.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/abor1.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/abor1.intfb.h	(revision 3908)
@@ -0,0 +1,5 @@
+INTERFACE
+SUBROUTINE ABOR1(CDTEXT)
+CHARACTER(LEN=*), INTENT(IN) :: CDTEXT
+END SUBROUTINE ABOR1
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/cargs.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/cargs.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/cargs.h	(revision 3908)
@@ -0,0 +1,70 @@
+/**
+ * (C) Copyright 2014- ECMWF.
+ *
+ * This software is licensed under the terms of the Apache Licence Version 2.0
+ * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+ *
+ * In applying this licence, ECMWF does not waive the privileges and immunities
+ * granted to it by virtue of its status as an intergovernmental organisation
+ * nor does it submit to any jurisdiction.
+ */
+
+/* cargs.h */
+
+/* prototypes for ifsaux/support/cargs.c */
+
+/* Author: Sami Saarinen, ECMWF, 27-Apr-2006 */
+
+#if defined(__cplusplus)
+extern "C" {
+#endif
+
+void ec_PutArgs(int argc, char *argv[]);
+const char *ec_GetArgs(int argno);
+int ec_NumArgs(void);
+
+/* The following two as in C-main : "int main(int argc, char *argv[])" */
+
+int ec_argc(void);
+char **ec_argv(void);
+
+/* Fortran interface */
+
+int iargc_c_(void);
+int iargc_c (void);
+
+void getarg_c_(const int *argno, char *arg
+	       /* Hidden argument */
+	       , const int arg_len);
+
+void getarg_c (const int *argno, char *arg
+	       /* Hidden argument */
+	       , const int arg_len);
+
+void putarg_c_(const int *argno, const char *arg
+	       /* Hidden argument */
+	       , int arg_len);
+
+void putarg_c (const int *argno, const char *arg
+	       /* Hidden argument */
+	       , int arg_len);
+
+void putarg_info_(const int *argc, const char *cterm
+		  /* Hidden argument */
+		  , int cterm_len);
+
+void putarg_info (const int *argc, const char *cterm
+		  /* Hidden argument */
+		  , int cterm_len);
+
+/* From ifsaux/support/cmpl_binding.F90 */
+
+void cmpl_getarg_(const int *argno, char *arg
+		  /* Hidden argument */
+		  , const int arg_len);
+
+int cmpl_iargc_(); 
+
+#if defined(__cplusplus)
+}
+#endif
Index: LMDZ6/trunk/libf/phylmd/ecrad/cas.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/cas.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/cas.h	(revision 3908)
@@ -0,0 +1,62 @@
+/**
+ * (C) Copyright 2014- ECMWF.
+ *
+ * This software is licensed under the terms of the Apache Licence Version 2.0
+ * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+ *
+ * In applying this licence, ECMWF does not waive the privileges and immunities
+ * granted to it by virtue of its status as an intergovernmental organisation
+ * nor does it submit to any jurisdiction.
+ */
+
+// cas.h
+//
+// compare_and_swap -based locks
+//
+// Thanks to https://github.com/majek/dump/blob/master/msqueue/queue_lock_myspinlock1.c
+//
+
+#include <signal.h>
+#include <sched.h>
+
+#ifndef INLINE
+#define INLINE __inline__
+#endif
+
+#if defined(__GNUC__) && !defined(__NEC__)
+
+#define CAS(lock,oldval,newval) __sync_bool_compare_and_swap(lock,oldval,newval)
+
+#else
+
+#warning *** CAS-locks self-implemented ***
+
+static INLINE int CAS(volatile sig_atomic_t *lock, int oldval, int newval)
+{
+  int tmp = *lock;
+  if (tmp == oldval) *lock = newval;
+  return tmp;
+}
+
+#endif
+
+static INLINE void cas_init(volatile sig_atomic_t *lock)
+{
+  if (lock) *lock = 0;
+}
+
+static INLINE void cas_lock(volatile sig_atomic_t *lock) 
+{
+  while (1) {
+    int i;
+    for (i=0; i < 10000; ++i) {
+      if (CAS(lock, 0, 1)) return;
+    }
+    sched_yield();
+  }
+}
+
+static INLINE void cas_unlock(volatile sig_atomic_t *lock) 
+{
+  CAS(lock, 1, 0);
+}
Index: LMDZ6/trunk/libf/phylmd/ecrad/crc.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/crc.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/crc.h	(revision 3908)
@@ -0,0 +1,46 @@
+/**
+ * (C) Copyright 2014- ECMWF.
+ *
+ * This software is licensed under the terms of the Apache Licence Version 2.0
+ * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+ *
+ * In applying this licence, ECMWF does not waive the privileges and immunities
+ * granted to it by virtue of its status as an intergovernmental organisation
+ * nor does it submit to any jurisdiction.
+ */
+
+/* crc.h */
+/* Calculates 32-bit  Cyclic Redundancy Check as in Unix cksum command */
+/* Also calculates 64-bit  Cyclic Redundancy Check */
+
+/* Sami Saarinen, 17-Feb-2005 : crc32       */
+/*                24-Jun-2005 : Added crc64 */
+/*                29-Dec-2005 : Added protos for direct C-calls */
+/*                29-Dec-2005 : Length argument for crc64 now 64-bit int */
+
+/* C callables */
+
+extern unsigned int 
+pp_cksum32(int nbuf, unsigned int nCRC);
+
+extern unsigned int 
+pp_cksum32but64len(long long int nbuf, unsigned int nCRC);
+
+extern unsigned long long int 
+pp_cksum64(long long int nbuf, unsigned long long int nCRC);
+
+extern unsigned int 
+cksum32(const char *buf, int nbuf, unsigned int nCRC);
+
+extern unsigned long long int
+cksum64(const char *buf, long long int nbuf, unsigned long long int nCRC);
+
+/* Fortran callable */
+
+extern void 
+crc32_(const void *vbuf, const int *pnbuf, 
+       unsigned int *pnCRC /* Note: An in & out -variable */);
+
+extern void 
+crc64_(const void *vbuf, const long long int *pnbuf, 
+       unsigned long long int *pnCRC /* Note: An in & out -variable */);
Index: LMDZ6/trunk/libf/phylmd/ecrad/dr_hook_util.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/dr_hook_util.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/dr_hook_util.h	(revision 3908)
@@ -0,0 +1,21 @@
+/**
+ * (C) Copyright 2014- ECMWF.
+ *
+ * This software is licensed under the terms of the Apache Licence Version 2.0
+ * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+ *
+ * In applying this licence, ECMWF does not waive the privileges and immunities
+ * granted to it by virtue of its status as an intergovernmental organisation
+ * nor does it submit to any jurisdiction.
+ */
+
+INTERFACE
+SUBROUTINE DR_HOOK_UTIL(LDHOOK,CDNAME,KCASE,PKEY,CDFILENAME,KSIZEINFO)
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+IMPLICIT NONE
+LOGICAL, INTENT(INOUT)      :: LDHOOK
+CHARACTER(LEN=*),INTENT(IN) :: CDNAME,CDFILENAME
+INTEGER(KIND=JPIM),INTENT(IN) :: KCASE,KSIZEINFO
+REAL(KIND=JPRB),INTENT(INOUT) :: PKEY
+END SUBROUTINE DR_HOOK_UTIL
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/dr_hook_util_multi.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/dr_hook_util_multi.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/dr_hook_util_multi.h	(revision 3908)
@@ -0,0 +1,21 @@
+/**
+ * (C) Copyright 2014- ECMWF.
+ *
+ * This software is licensed under the terms of the Apache Licence Version 2.0
+ * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+ *
+ * In applying this licence, ECMWF does not waive the privileges and immunities
+ * granted to it by virtue of its status as an intergovernmental organisation
+ * nor does it submit to any jurisdiction.
+ */
+
+INTERFACE
+SUBROUTINE DR_HOOK_UTIL_MULTI(LDHOOK,CDNAME,KCASE,PKEY,KPKEY,CDFILENAME,KSIZEINFO)
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+IMPLICIT NONE
+LOGICAL,INTENT(IN)          :: LDHOOK
+CHARACTER(LEN=*),INTENT(IN) :: CDNAME,CDFILENAME
+INTEGER(KIND=JPIM),INTENT(IN) :: KPKEY, KCASE,KSIZEINFO
+REAL(KIND=JPRB),INTENT(INOUT) :: PKEY(KPKEY)
+END SUBROUTINE DR_HOOK_UTIL_MULTI
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/drhook.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/drhook.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/drhook.h	(revision 3908)
@@ -0,0 +1,242 @@
+/**
+ * (C) Copyright 2014- ECMWF.
+ *
+ * This software is licensed under the terms of the Apache Licence Version 2.0
+ * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+ *
+ * In applying this licence, ECMWF does not waive the privileges and immunities
+ * granted to it by virtue of its status as an intergovernmental organisation
+ * nor does it submit to any jurisdiction.
+ */
+
+#ifndef _DRHOOK_H_
+#define _DRHOOK_H_
+
+#ifndef GNUC_BTRACE
+#define GNUC_BTRACE 128
+#endif
+
+#ifdef _DRHOOK_C_
+
+#if defined(__GNUC__)
+#define _GNU_SOURCE
+#endif
+
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+#include <sys/time.h>
+#include <sys/resource.h>
+#include <unistd.h>
+#include <ctype.h>
+#include <signal.h>
+#include <errno.h>
+#include <time.h>
+#include <math.h>
+#include <sys/syscall.h>
+#include <sys/types.h>
+#include <pthread.h>
+#include <limits.h>
+#ifdef __NEC__
+static int backtrace(void **buffer, int size) { return 0; }
+#else
+#include <execinfo.h>
+#endif
+#include <sys/file.h>
+
+//#ifdef _OPENMP
+//#include <omp.h>
+//#endif
+
+#ifdef RS6K
+#include <fptrap.h>
+#endif
+
+#ifdef VPP
+#include <ucontext.h>
+#endif
+
+int drhook_lhook = 1;
+#else
+extern int drhook_lhook;
+#endif
+
+#ifndef O_LOCK_DONE
+#define O_LOCK_DONE
+
+/* OpenMP/ODB lock type */
+/* Keep consistent with "odb/include/privpub.h" */
+/* Be ALSO consistent with OML_LOCK_KIND in ifsaux/module/oml_mod.F90 */
+
+typedef long long int o_lock_t; /* i.e. 64-bit integer */
+
+#define INIT_LOCKID_WITH_NAME(mylock, lockname) \
+  coml_init_lockid_with_name_(mylock, lockname, strlen(lockname))
+
+extern void coml_set_debug_(const int *konoff, int *kret);
+extern void coml_init_lock_();
+extern void coml_init_lockid_(o_lock_t *mylock);
+extern void coml_init_lockid_with_name_(o_lock_t *mylock, const char *name, int name_len);
+extern void coml_set_lock_();
+extern void coml_set_lockid_(o_lock_t *mylock);
+extern void coml_unset_lock_();
+extern void coml_unset_lockid_(o_lock_t *mylock);
+extern void coml_test_lock_(int *is_set);
+extern void coml_test_lockid_(int *is_set, o_lock_t *mylock);
+extern void coml_in_parallel_(int *is_parallel_region);
+
+#endif
+
+/* drhook.c external interfaces */
+
+extern void
+c_drhook_getenv_(const char *s,
+                 char *value,
+                 /* Hidden arguments */
+                 int slen,
+                 const int valuelen);
+
+extern void
+c_drhook_memcounter_(const int *thread_id,
+                     const long long int *size,
+                     long long int *keyptr_addr);
+
+extern void
+c_drhook_raise_(const int *sig);
+
+extern void
+c_drhook_print_(const int *ftnunitno,
+                const int *thread_id,
+                const int *print_option, /* 
+                                            1=raw call counts 
+                                            2=calling tree
+                                            3=profiling info
+                                         */
+                int *level);
+
+extern void
+c_drhook_init_signals_(const int *enforce);
+
+extern void
+c_drhook_set_lhook_(const int *lhook);
+
+extern void 
+c_drhook_init_(const char *progname,
+               const int *num_threads
+               /* Hidden length */
+               ,int progname_len);
+
+extern void
+c_drhook_start_(const char *name, 
+                const int *thread_id, 
+                double *key,
+                const char *filename,
+                const int *sizeinfo
+                /* Hidden length */
+                ,int name_len, int filename_len);
+
+extern void
+c_drhook_end_(const char *name,
+              const int *thread_id,
+              const double *key,
+              const char *filename,
+              const int *sizeinfo
+              /* Hidden length */
+              ,int name_len, int filename_len);
+
+extern void
+c_drhook_watch_(const int *onoff,
+		const char *array_name,
+		const void *array_ptr,
+		const int *nbytes,
+		const int *abort_if_changed,
+		const int *printkey,
+		const int *nvals,
+		const int *print_traceback_when_set
+		/* Hidden length */
+		,int array_name_len);
+
+extern void
+c_drhook_check_watch_(const char *where,
+		      const int *allow_abort
+		      /* Hidden length */
+		      , int where_len);
+
+/* see dr_hook_prt.F90 for below */
+extern void dr_hook_prt_logical_(const int *ftnunitno, const void *ptr, const int *nmax);
+extern void dr_hook_prt_char_(const int *ftnunitno, const void *ptr, const int *nmax);
+extern void dr_hook_prt_i4_(const int *ftnunitno, const void *ptr, const int *nmax);
+extern void dr_hook_prt_i8_(const int *ftnunitno, const void *ptr, const int *nmax);
+extern void dr_hook_prt_r4_(const int *ftnunitno, const void *ptr, const int *nmax);
+extern void dr_hook_prt_r8_(const int *ftnunitno, const void *ptr, const int *nmax);
+
+extern void ec_meminfo_(const int *KU, const char *CDSTRING, 
+			const int *KCOMM, const int *KBARR, 
+			const int *KIOTASK, const int *KCALL,
+			int len_CDSTRING); /* see ec_meminfo.F90 */
+
+
+/* see comp_binding.F90 */
+extern void coml_get_max_threads_(int *numthreads);
+extern void coml_get_num_threads_(int *numthreads);
+extern void coml_my_thread_(int *mytid);
+
+/* see drhook.c */
+extern const char *drhook_TIMESTR(int tid);
+extern const char *drhook_PREFIX(int tid);
+
+/**** C-interface to Dr.Hook ****/
+
+extern void
+Dr_Hook(const char *name, int option, double *handle, 
+        const char *filename, int sizeinfo,
+        int name_len, int filename_len);
+
+#define DRHOOK_START_RECUR(name,recur) \
+  static const char *drhook_name = #name; \
+  static const int drhook_name_len = sizeof(#name) - 1; /* Compile time eval */ \
+  static const char *drhook_filename = __FILE__; \
+  static const int drhook_filename_len = sizeof(__FILE__) - 1; /* Compile time eval */ \
+  double zhook_handle; \
+  if (!recur && drhook_lhook) Dr_Hook(drhook_name, 0, &zhook_handle, \
+                                      drhook_filename, 0, \
+                                      drhook_name_len, drhook_filename_len); {
+
+#define DRHOOK_START(name) DRHOOK_START_RECUR(name,0)
+
+#define DRHOOK_START_BY_STRING_RECUR(name, recur) \
+  static const char *drhook_name = name; \
+  static const int drhook_name_len = sizeof(name) - 1; /* Compile time eval */ \
+  static const char *drhook_filename = __FILE__; \
+  static const int drhook_filename_len = sizeof(__FILE__) - 1; /* Compile time eval */ \
+  double zhook_handle; \
+  if (!recur && drhook_lhook) Dr_Hook(drhook_name, 0, &zhook_handle, \
+                                      drhook_filename, 0, \
+                                      drhook_name_len, drhook_filename_len); {
+
+#define DRHOOK_START_BY_STRING(name) DRHOOK_START_BY_STRING_RECUR(name,0)
+
+#define DRHOOK_RETURN_RECUR(sizeinfo,recur) \
+  if (!recur && drhook_lhook) Dr_Hook(drhook_name, 1, &zhook_handle, \
+                                      drhook_filename, sizeinfo, \
+                                      drhook_name_len, drhook_filename_len)
+
+#define DRHOOK_RETURN(sizeinfo) DRHOOK_RETURN_RECUR(sizeinfo,0)
+
+#define DRHOOK_END_RECUR(sizeinfo,recur) ; } DRHOOK_RETURN_RECUR(sizeinfo,recur)
+
+#define DRHOOK_END(sizeinfo) DRHOOK_END_RECUR(sizeinfo,0) 
+
+/* Fortran routines */
+
+extern void
+dr_hook_prt_(const int *ftnunitno,
+             const char *s
+             /* Hidden arguments */
+             , int s_len);
+
+extern void
+dr_hook_procinfo_(int *myproc, int *nproc);
+
+#endif  /* _DRHOOK_H_ */
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/easy_netcdf.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/easy_netcdf.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/easy_netcdf.F90	(revision 3908)
@@ -0,0 +1,2328 @@
+! easy_netcdf.F90 - Module providing convenient NetCDF read/write capability
+!
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2017-04-28  R. Hogan  Fix "reshape" when writing 3D array
+!   2017-10-23  A. Bozzo  Reading 4-D array
+!   2018-03-14  R. Hogan  Fix "reshape" properly this time
+!   2019-01-04  R. Hogan  Allow reading and writing a slice of a larger array
+!   2019-01-07  R. Hogan  HDF5 writing support, allowing larger files, provided NC_NETCDF4 defined
+!   2019-01-16  R. Hogan  Revised interpretation of "iverbose"
+!   2019-06-17  R. Hogan  Pass through deflate_level and shuffle to variable definition
+
+module easy_netcdf
+
+  use netcdf
+  use parkind1,      only : jprb, jpib, jprm, jprd
+  use radiation_io,  only : nulout, nulerr, my_abort => radiation_abort
+
+  implicit none
+  public
+
+  !---------------------------------------------------------------------
+  ! An object of this type provides convenient read or write access to
+  ! a NetCDF file
+  type netcdf_file
+    integer :: ncid             ! NetCDF file ID
+    integer :: iverbose ! Verbosity: 0 = report only fatal errors,
+                        !            1 = ...and warnings,
+                        !            2 = ...and when opening files,
+                        !            3 = ...and when reading/writing variables,
+                        !            4 = ...and variable attributes and when writing dimensions,
+                        !            5 = ...and debugging information
+    logical :: do_transpose_2d = .false.   ! Transpose 2D arrays on read/write?
+    logical :: is_write_mode   = .false.   ! .false. for read, .true. for write
+    logical :: is_define_mode  = .true.    ! .true. if in NetCDF define mode
+    logical :: is_double_precision = .false. ! Write reals in double precision?
+    logical :: do_permute_3d   = .false.   ! Permute 3D arrays on write?
+    logical :: do_permute_4d   = .false.   ! Permute 3D arrays on write?
+    integer :: i_permute_3d(3) = (/1,2,3/) ! New order of dimensions
+    integer :: i_permute_4d(4) = (/1,2,3,4/) ! New order of dimensions
+    character(len=511) :: file_name
+  contains
+    procedure :: open => open_netcdf_file
+    procedure :: create => create_netcdf_file
+    procedure :: close => close_netcdf_file
+    procedure :: get_real_scalar
+    procedure :: get_real_vector
+    procedure :: get_integer_vector
+    procedure :: get_real_matrix
+    procedure :: get_real_array3
+    procedure :: get_real_scalar_indexed
+    procedure :: get_real_vector_indexed
+    procedure :: get_real_matrix_indexed
+    procedure :: get_real_array3_indexed
+    procedure :: get_real_array4
+    generic   :: get => get_real_scalar, get_real_vector, &
+         &              get_real_matrix, get_real_array3, &
+         &              get_real_array4, get_integer_vector, &
+         &              get_real_scalar_indexed, get_real_vector_indexed, &
+         &              get_real_matrix_indexed, get_real_array3_indexed
+    procedure :: get_real_scalar_attribute
+    procedure :: get_string_attribute
+    generic   :: get_attribute => get_real_scalar_attribute, &
+         &                        get_string_attribute
+    procedure :: get_global_attribute
+
+    procedure :: define_dimension
+    procedure :: define_variable
+    procedure :: put_attribute
+    procedure :: put_global_attributes
+    procedure :: put_global_attribute
+    procedure :: put_real_scalar
+    procedure :: put_real_vector
+    procedure :: put_real_matrix
+    procedure :: put_real_array3
+    procedure :: put_real_scalar_indexed
+    procedure :: put_real_vector_indexed
+    procedure :: put_real_matrix_indexed
+    generic   :: put => put_real_scalar, put_real_vector, &
+         &              put_real_matrix, put_real_array3, &
+         &              put_real_scalar_indexed, put_real_vector_indexed, &
+         &              put_real_matrix_indexed
+    procedure :: set_verbose
+    procedure :: transpose_matrices
+    procedure :: double_precision
+    procedure :: permute_3d_arrays
+    procedure :: get_rank
+    procedure :: exists
+    procedure :: get_outer_dimension
+    procedure :: attribute_exists
+    procedure :: global_attribute_exists
+    procedure, private :: get_array_dimensions
+    procedure, private :: get_variable_id
+    procedure, private :: end_define_mode
+    procedure, private :: print_variable_attributes
+  end type netcdf_file
+
+contains
+
+  ! --- GENERIC SUBROUTINES ---
+
+  !---------------------------------------------------------------------
+  ! Open a NetCDF file with name "file_name", optionally specifying the
+  ! verbosity level (0-5) and if the file is for writing (the default
+  ! is read-only)
+  subroutine open_netcdf_file(this, file_name, iverbose, is_write_mode, is_hdf5_file)
+    class(netcdf_file)            :: this
+    character(len=*), intent(in)  :: file_name
+    integer, intent(in), optional :: iverbose
+    logical, intent(in), optional :: is_write_mode
+    logical, intent(in), optional :: is_hdf5_file ! Only for write mode
+
+    integer                       :: istatus
+    integer                       :: i_write_mode
+
+
+    ! Store verbosity level in object
+    if (present(iverbose)) then
+      this%iverbose = iverbose
+    else
+      ! By default announce files being opened and closed, but not
+      ! variables read/written
+      this%iverbose = 2
+    end if
+
+    ! Store read/write mode in object
+    if (present(is_write_mode)) then
+      this%is_write_mode = is_write_mode
+    else
+      this%is_write_mode = .false.
+    end if
+
+    ! By default we don't transpose 2D arrays on read/write
+    this%do_transpose_2d = .false.
+
+    ! Store filename
+    this%file_name = file_name
+
+    ! Open file according to write mode
+    if (.not. this%is_write_mode) then
+      istatus = nf90_open(file_name, NF90_NOWRITE, this%ncid)
+      if (this%iverbose >= 2) then
+        write(nulout,'(a,a)') 'Reading NetCDF file ', file_name
+        !write(nulout,'(a,a,a,i0,a)') 'Reading NetCDF file ', file_name, ' (ID=', this%ncid, ')'
+      end if
+      this%is_define_mode = .false.
+    else
+      i_write_mode = NF90_CLOBBER
+      ! Check if HDF5 file is to be written (which can be larger)
+      if (present(is_hdf5_file)) then
+        if (is_hdf5_file) then
+#ifdef NC_NETCDF4
+          i_write_mode = ior(i_write_mode, NF90_HDF5)
+#else
+          if (this%iverbose >= 1) then
+            write(nulout,'(a,a)') 'Warning: cannot use HDF5 format for writing ', file_name, &
+                 &                ' unless compiled with NC_NETCDF4 defined'
+          end if
+#endif
+        end if
+      end if
+
+      istatus = nf90_create(file_name, i_write_mode, this%ncid)
+      if (this%iverbose >= 2) then
+        write(nulout,'(a,a)') 'Writing NetCDF file ', file_name
+      end if
+      this%is_define_mode = .true.
+    end if
+
+    ! Check the file opened correctly
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error opening NetCDF file ', &
+           &       file_name, ': ', trim(nf90_strerror(istatus))
+      call my_abort('Error opening NetCDF file')
+    end if
+
+  end subroutine open_netcdf_file
+
+
+  !---------------------------------------------------------------------
+  ! Open a NetCDF file for writing
+  subroutine create_netcdf_file(this, file_name, iverbose, is_hdf5_file)
+    class(netcdf_file)            :: this
+    character(len=*), intent(in)  :: file_name
+    integer, intent(in), optional :: iverbose
+    logical, intent(in), optional :: is_hdf5_file
+
+    integer                       :: istatus
+    integer                       :: i_write_mode
+
+    if (present(iverbose)) then
+      this%iverbose = iverbose
+    else
+      this%iverbose = 2
+    end if
+
+    this%do_transpose_2d = .false.
+
+    i_write_mode = NF90_CLOBBER
+    ! Check if HDF5 file is to be written (which can be large)
+    if (present(is_hdf5_file)) then
+      if (is_hdf5_file) then
+#ifdef NC_NETCDF4
+        i_write_mode = ior(i_write_mode, NF90_HDF5)
+#else
+        if (this%iverbose >= 1) then
+          write(nulout,'(a,a)') 'Warning: cannot use HDF5 format for writing ', file_name, &
+               &                ' unless compiled with NC_NETCDF4 defined'
+        end if
+#endif
+      end if
+    end if
+
+    istatus = nf90_create(file_name, i_write_mode, this%ncid)
+    if (this%iverbose >= 2) then
+      write(nulout,'(a,a)') 'Writing NetCDF file ', file_name
+      !write(nulout,'(a,a,a,i0,a)') 'Writing NetCDF file ', file_name, ' (ID=', this%ncid, ')'
+    end if
+    this%is_define_mode = .true.
+
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a)') '*** Error opening NetCDF file ', file_name, &
+           &                  ': ', trim(nf90_strerror(istatus))
+      stop
+    end if
+    this%file_name = file_name
+
+  end subroutine create_netcdf_file
+
+
+  !---------------------------------------------------------------------
+  ! Close the NetCDF file
+  subroutine close_netcdf_file(this)
+    class(netcdf_file) :: this
+    integer            :: istatus
+
+    if (this%iverbose >= 3) then
+      write(nulout,'(a,a)') 'Closing NetCDF file ', trim(this%file_name)
+    end if
+
+    istatus = nf90_close(this%ncid)
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error closing NetCDF file ', &
+           & trim(this%file_name), ': ', trim(nf90_strerror(istatus))
+      stop
+    end if
+
+  end subroutine close_netcdf_file
+
+
+  !---------------------------------------------------------------------
+  ! Set the verbosity level from 0 to 5, where the codes have the
+  ! following meaning: 0=errors only, 1=warning, 2=info, 3=progress,
+  ! 4=detailed, 5=debug
+  subroutine set_verbose(this, ival)
+    class(netcdf_file) :: this
+    integer, optional  :: ival
+
+    if (present(ival)) then
+      this%iverbose = ival
+    else
+      this%iverbose = 2
+    end if
+
+  end subroutine set_verbose
+
+
+  !---------------------------------------------------------------------
+  ! Specify whether floating-point arrays should be written in double precision
+  subroutine double_precision(this, is_double)
+    class(netcdf_file) :: this
+    logical, optional  :: is_double
+
+    if (present(is_double)) then
+      this%is_double_precision = is_double
+    else
+      this%is_double_precision = .true.
+    end if
+
+  end subroutine double_precision
+
+
+  !---------------------------------------------------------------------
+  ! Specify whether 2D arrays should be transposed on read/write
+  subroutine transpose_matrices(this, do_transpose)
+    class(netcdf_file) :: this
+    logical, optional  :: do_transpose
+
+    if (present(do_transpose)) then
+      this%do_transpose_2d = do_transpose
+    else
+      this%do_transpose_2d = .true.
+    end if
+
+  end subroutine transpose_matrices
+
+
+  !---------------------------------------------------------------------
+  ! Specify that 3D arrays should be permuted on write, with the new
+  ! dimension order in the input argument "ipermute" (e.g. 3,2,1)
+  subroutine permute_3d_arrays(this, ipermute)
+    class(netcdf_file)  :: this
+    integer, intent(in) :: ipermute(3)
+
+    this%do_permute_3d = .true.
+    this%i_permute_3d  = ipermute
+
+  end subroutine permute_3d_arrays
+
+
+  !---------------------------------------------------------------------
+  ! Specify that 4D arrays should be permuted on write, with the new
+  ! dimension order in the input argument "ipermute" (e.g. 4,3,2,1)
+  subroutine permute_4d_arrays(this, ipermute)
+    class(netcdf_file)  :: this
+    integer, intent(in) :: ipermute(4)
+
+    this%do_permute_4d = .true.
+    this%i_permute_4d  = ipermute
+
+  end subroutine permute_4d_arrays
+
+
+  ! --- PRIVATE SUBROUTINES ---
+
+  !---------------------------------------------------------------------
+  ! Return the NetCDF variable ID for variable "var_name", or abort if
+  ! not present
+  subroutine get_variable_id(this, var_name, ivarid)
+    class(netcdf_file)           :: this
+    character(len=*), intent(in) :: var_name
+    integer, intent(out)         :: ivarid
+
+    integer                      :: istatus
+
+    istatus = nf90_inq_varid(this%ncid, var_name, ivarid)
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error reading NetCDF variable ', &
+           & var_name, ': ', trim(nf90_strerror(istatus))
+      call my_abort('Error reading NetCDF file')
+    end if
+
+  end subroutine get_variable_id
+
+
+  !---------------------------------------------------------------------
+  ! Return the array dimensions of variable with specified ID, along
+  ! with the number of dimensions and optionally the total number of
+  ! elements, or abort if variable not present
+  subroutine get_array_dimensions(this, ivarid, ndims, ndimlens, ntotal)
+    class(netcdf_file)             :: this
+    integer, intent(in)            :: ivarid
+    integer, intent(out)           :: ndims
+    integer, intent(out)           :: ndimlens(NF90_MAX_VAR_DIMS)
+    integer(kind=jpib), intent(out), optional :: ntotal
+
+    integer                        :: j, istatus
+    integer                        :: dimids(NF90_MAX_VAR_DIMS)
+
+    istatus = nf90_inquire_variable(this%ncid, ivarid, &
+         &                          ndims=ndims, dimids=dimids)
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,i0,a,a)') '*** Error inquiring about NetCDF variable with id ', &
+           & ivarid, ': ', trim(nf90_strerror(istatus))
+      call my_abort('Error reading NetCDF file')
+    end if
+
+    ndimlens(:) = 0
+    do j = 1,ndims
+      istatus = nf90_inquire_dimension(this%ncid, dimids(j), len=ndimlens(j))
+      if (istatus /= NF90_NOERR) then
+        write(nulerr,'(a,i0,a,i0,a,a)') '*** Error reading length of dimension ', &
+             & j, ' of NetCDF variable with id ', ivarid, ': ', &
+             & trim(nf90_strerror(istatus))
+        call my_abort('Error reading NetCDF file')
+      end if
+    end do
+
+    if (present(ntotal)) then
+      ntotal = 1
+      do j = 1, ndims
+        ntotal = ntotal * ndimlens(j)
+      end do
+    end if
+
+  end subroutine get_array_dimensions
+
+
+  !---------------------------------------------------------------------
+  ! End define mode, if in define mode, and check the error code
+  ! (errors are possible if variables are too large for the format,
+  ! for example)
+  subroutine end_define_mode(this)
+    class(netcdf_file)             :: this
+    integer                        :: istatus
+    if (this%is_define_mode) then
+      istatus = nf90_enddef(this%ncid)
+      if (istatus /= NF90_NOERR) then
+        write(nulerr,'(a,a,a,a)') '*** Error ending define mode when writing ', &
+             &    trim(this%file_name), ': ', trim(nf90_strerror(istatus))
+        call my_abort('Error writing NetCDF file')
+      end if
+      this%is_define_mode = .false.
+    end if
+  end subroutine end_define_mode
+
+
+  ! --- READING SUBROUTINES ---
+
+  !---------------------------------------------------------------------
+  ! Return the number of dimensions of variable with name var_name, or
+  ! -1 if the variable is not found
+  function get_rank(this, var_name) result(ndims)
+    class(netcdf_file)           :: this
+    character(len=*), intent(in) :: var_name
+
+    integer :: ndims
+    integer :: ivarid
+    integer :: ndimlens(NF90_MAX_VAR_DIMS)
+    integer :: istatus
+
+    istatus = nf90_inq_varid(this%ncid, var_name, ivarid)
+    if (istatus /= NF90_NOERR) then
+      if (istatus == NF90_ENOTVAR) then
+        if (this%iverbose >= 1) then
+          write(nulout,'(a,a,a)') '  Warning: variable ', var_name, ' not found'
+        end if
+      else
+        write(nulerr,'(a,a,a)') '*** Error inquiring about variable ', &
+             &                  var_name, ': ', trim(nf90_strerror(istatus))
+        call my_abort('Error reading NetCDF file')
+      end if
+      ndims = -1
+    else
+      call this%get_array_dimensions(ivarid, ndims, ndimlens)
+    end if
+
+  end function get_rank
+
+
+  !---------------------------------------------------------------------
+  ! Return the length of the slowest-varying dimension of variable
+  ! with name var_name, or -1 if the variable is not found
+  function get_outer_dimension(this, var_name) result(n)
+    class(netcdf_file)           :: this
+    character(len=*), intent(in) :: var_name
+
+    integer :: n
+    integer :: ndims
+    integer :: ivarid
+    integer :: ndimlens(NF90_MAX_VAR_DIMS)
+    integer :: istatus
+
+    istatus = nf90_inq_varid(this%ncid, var_name, ivarid)
+    if (istatus /= NF90_NOERR) then
+      if (istatus == NF90_ENOTVAR) then
+        if (this%iverbose >= 1) then
+          write(nulout,'(a,a,a)') '  Warning: variable ', var_name, ' not found'
+        end if
+      else
+        write(nulerr,'(a,a,a)') '*** Error inquiring about variable ', &
+             &                  var_name, ': ', trim(nf90_strerror(istatus))
+        call my_abort('Error reading NetCDF file')
+      end if
+      n = -1
+    else
+      call this%get_array_dimensions(ivarid, ndims, ndimlens)
+      n = ndimlens(ndims)
+    end if
+
+  end function get_outer_dimension
+
+
+  !---------------------------------------------------------------------
+  ! Return true if the variable is present, false otherwise
+  function exists(this, var_name) result(is_present)
+    class(netcdf_file)           :: this
+    character(len=*), intent(in) :: var_name
+
+    logical :: is_present
+
+    integer :: ivarid
+    integer :: istatus
+
+    istatus = nf90_inq_varid(this%ncid, var_name, ivarid)
+    if (istatus /= NF90_NOERR) then
+      is_present = .false.
+    else
+      is_present = .true.
+    end if
+
+  end function exists
+
+
+  !---------------------------------------------------------------------
+  ! Return true if the attribute is present, false otherwise.  If
+  ! argument "len" is provided then return false if len is smaller
+  ! than the length of the attribute.  This is useful if you have a
+  ! fixed array size and want to check whether the attribute will fit
+  ! into it.
+  function attribute_exists(this, var_name, attr_name, len) result(is_present)
+    class(netcdf_file)            :: this
+    character(len=*), intent(in)  :: var_name, attr_name
+    integer, optional, intent(in) :: len
+
+    logical :: is_present
+    integer :: i_attr_len, ivarid
+    integer :: istatus
+
+    istatus = nf90_inq_varid(this%ncid, var_name, ivarid)
+    if (istatus /= NF90_NOERR) then
+      is_present = .false.
+    else
+      istatus = nf90_inquire_attribute(this%ncid, ivarid, attr_name, &
+           &                           len=i_attr_len)
+      if (istatus /= NF90_NOERR) then
+        is_present = .false.
+      else 
+        is_present = .true.
+        if (present(len)) then
+          if (i_attr_len > len) then
+            is_present = .false.
+          end if
+        end if
+      end if
+    end if
+
+  end function attribute_exists
+
+
+  !---------------------------------------------------------------------
+  ! Return true if the global attribute is present, false otherwise.
+  ! If argument "len" is provided then return false if len is smaller
+  ! than the length of the attribute.  This is useful if you have a
+  ! fixed array size and want to check whether the attribute will fit
+  ! into it.
+  function global_attribute_exists(this, attr_name, len) result(is_present)
+    class(netcdf_file)            :: this
+    character(len=*), intent(in)  :: attr_name
+    integer, optional, intent(in) :: len
+
+    logical :: is_present
+    integer :: i_attr_len
+    integer :: istatus
+
+    istatus = nf90_inquire_attribute(this%ncid, NF90_GLOBAL, attr_name, &
+         &                           len=i_attr_len)
+    if (istatus /= NF90_NOERR) then
+      is_present = .false.
+    else 
+      is_present = .true.
+      if (present(len)) then
+        if (i_attr_len > len) then
+          is_present = .false.
+        end if
+      end if
+    end if
+
+  end function global_attribute_exists
+
+
+  !---------------------------------------------------------------------
+  ! The method "get" will read either a scalar, vector or matrix
+  ! depending on the rank of the output argument. This version reads a
+  ! scalar.
+  subroutine get_real_scalar(this, var_name, scalar)
+    class(netcdf_file)           :: this
+    character(len=*), intent(in) :: var_name
+    real(jprb), intent(out)      :: scalar
+
+    integer                      :: istatus
+    integer                      :: ivarid, ndims
+    integer                      :: ndimlens(NF90_MAX_VAR_DIMS)
+    integer                      :: j, ntotal
+
+    ! Inquire the ID, shape & size of the variable
+    call this%get_variable_id(var_name, ivarid)
+    call this%get_array_dimensions(ivarid, ndims, ndimlens)
+
+    ! Compute number of elements of the variable in the file
+    ntotal = 1
+    do j = 1, ndims
+      ntotal = ntotal * ndimlens(j)
+    end do
+
+    if (this%iverbose >= 3) then
+      write(nulout,'(a,a)',advance='no') '  Reading ', var_name
+      call this%print_variable_attributes(ivarid,nulout)
+    end if
+
+    ! Abort if the number of elements is anything other than 1
+    if (ntotal /= 1) then
+      write(nulerr,'(a,a,a,i0,a)') '*** Error reading NetCDF variable ', &
+           &    var_name, ' with total length ', ntotal, ' as a scalar'
+      call my_abort('Error reading NetCDF file')
+    end if
+
+    ! Read variable
+    istatus = nf90_get_var(this%ncid, ivarid, scalar)
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error reading NetCDF variable ', &
+           &  var_name, ' as a scalar: ', trim(nf90_strerror(istatus))
+      call my_abort('Error reading NetCDF file')
+    end if
+
+  end subroutine get_real_scalar
+
+
+  !---------------------------------------------------------------------
+  ! Read a scalar from a larger array, where "index" indexes the most
+  ! slowly varying dimension
+  subroutine get_real_scalar_indexed(this, var_name, index, scalar)
+    class(netcdf_file)           :: this
+    character(len=*), intent(in) :: var_name
+    integer, intent(in)          :: index
+    real(jprb), intent(out)      :: scalar
+
+    integer                      :: istatus
+    integer                      :: ivarid, ndims
+    integer                      :: ndimlens(NF90_MAX_VAR_DIMS)
+    integer                      :: vstart(NF90_MAX_VAR_DIMS)
+    integer                      :: j, ntotal
+
+    ! Inquire the ID, shape & size of the variable
+    call this%get_variable_id(var_name, ivarid)
+    call this%get_array_dimensions(ivarid, ndims, ndimlens)
+
+    ! Compute number of elements of the slice in the file,
+    ! i.e. excluding the slowest varying dimension, indexed by "index"
+    ntotal = 1
+    do j = 1, ndims-1
+      ntotal = ntotal * ndimlens(j)
+    end do
+
+    if (this%iverbose >= 3) then
+      write(nulout,'(a,a,i0,a,a)') '  Reading element ', index, ' of ', var_name
+    end if
+
+    ! Abort if the number of elements is anything other than 1
+    if (ntotal /= 1) then
+      write(nulerr,'(a,a,a,i0,a)') '*** Error reading NetCDF variable ', &
+           &    var_name, ' with slice length ', ntotal, ' as a scalar'
+      call my_abort('Error reading NetCDF file')
+    end if
+
+    if (index < 1 .or. index > ndimlens(ndims)) then
+      write(nulerr,'(a,i0,a,a,a,i0)') '*** Error reading element ', index, &
+           &  ' of NetCDF variable ', &
+           &    var_name, ' with outer dimension ', ndimlens(ndims)
+      call my_abort('Error reading NetCDF file')
+    end if
+
+    ! Read variable
+    vstart(1:ndims-1) = 1
+    vstart(ndims)     = index
+    istatus = nf90_get_var(this%ncid, ivarid, scalar, start=vstart)
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error reading NetCDF variable ', &
+           &  var_name, ' as a scalar: ', trim(nf90_strerror(istatus))
+      call my_abort('Error reading NetCDF file')
+    end if
+
+  end subroutine get_real_scalar_indexed
+
+
+  !---------------------------------------------------------------------
+  ! Read a 1D array into "vector", which must be allocatable and will
+  ! be reallocated if necessary
+  subroutine get_real_vector(this, var_name, vector)
+    class(netcdf_file)           :: this
+    character(len=*), intent(in) :: var_name
+    real(jprb), allocatable, intent(out) :: vector(:)
+
+    integer                      :: n  ! Length of vector
+    integer                      :: istatus
+    integer                      :: ivarid, ndims
+    integer                      :: ndimlens(NF90_MAX_VAR_DIMS)
+    integer                      :: j
+
+    call this%get_variable_id(var_name, ivarid)
+    call this%get_array_dimensions(ivarid, ndims, ndimlens)
+
+    ! Ensure variable has only one dimension in the file
+    n = 1
+    do j = 1, ndims
+      n = n * ndimlens(j)
+      if (j > 1 .and. ndimlens(j) > 1) then
+        write(nulerr,'(a,a,a)') '*** Error reading NetCDF variable ', &
+             & var_name, &
+             & ' as a vector: all dimensions above the first must be singletons'
+        call my_abort('Error reading NetCDF file')
+      end if
+    end do
+
+    ! Reallocate if necessary
+    if (allocated(vector)) then
+      if (size(vector) /= n) then
+        if (this%iverbose >= 1) then
+          write(nulout,'(a,a)') '  Warning: resizing vector to read ', var_name
+        end if
+        deallocate(vector)
+        allocate(vector(n))
+      end if
+    else
+      allocate(vector(n))
+    end if
+
+    if (this%iverbose >= 3) then
+      write(nulout,'(a,a,a,i0,a)',advance='no') '  Reading ', var_name, '(', n, ')'
+      call this%print_variable_attributes(ivarid,nulout)
+    end if
+
+    ! Read variable
+    istatus = nf90_get_var(this%ncid, ivarid, vector)
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error reading NetCDF variable ', &
+           &  var_name, ' as a vector: ', trim(nf90_strerror(istatus))
+      call my_abort('Error reading NetCDF file')
+    end if
+
+  end subroutine get_real_vector
+
+
+  !---------------------------------------------------------------------
+  ! Read a 1D integer array into "vector", which must be allocatable
+  ! and will be reallocated if necessary
+  subroutine get_integer_vector(this, var_name, vector)
+    class(netcdf_file)           :: this
+    character(len=*), intent(in) :: var_name
+    integer, allocatable, intent(out) :: vector(:)
+
+    integer                      :: n  ! Length of vector
+    integer                      :: istatus
+    integer                      :: ivarid, ndims
+    integer                      :: ndimlens(NF90_MAX_VAR_DIMS)
+    integer                      :: j
+
+    call this%get_variable_id(var_name, ivarid)
+    call this%get_array_dimensions(ivarid, ndims, ndimlens)
+
+    ! Ensure variable has only one dimension in the file
+    n = 1
+    do j = 1, ndims
+      n = n * ndimlens(j)
+      if (j > 1 .and. ndimlens(j) > 1) then
+        write(nulerr,'(a,a,a)') '*** Error reading NetCDF variable ', &
+             & var_name, &
+             & ' as a vector: all dimensions above the first must be singletons'
+        call my_abort('Error reading NetCDF file')
+      end if
+    end do
+
+    ! Reallocate if necessary
+    if (allocated(vector)) then
+      if (size(vector) /= n) then
+        if (this%iverbose >= 1) then
+          write(nulout,'(a,a)') '  Warning: resizing vector to read ', var_name
+        end if
+        deallocate(vector)
+        allocate(vector(n))
+      end if
+    else
+      allocate(vector(n))
+    end if
+
+    if (this%iverbose >= 3) then
+      write(nulout,'(a,a,a,i0,a)',advance='no') '  Reading ', var_name, '(', n, ')'
+      call this%print_variable_attributes(ivarid,nulout)
+    end if
+
+    ! Read variable
+    istatus = nf90_get_var(this%ncid, ivarid, vector)
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error reading NetCDF variable ', &
+           &  var_name, ' as an integer vector: ', trim(nf90_strerror(istatus))
+      call my_abort('Error reading NetCDF file')
+    end if
+
+  end subroutine get_integer_vector
+
+
+  !---------------------------------------------------------------------
+  ! Read a vector of data from a larger array; the vector must be
+  ! allocatable and will be reallocated if necessary
+  subroutine get_real_vector_indexed(this, var_name, index, vector)
+    class(netcdf_file)           :: this
+    character(len=*), intent(in) :: var_name
+    integer, intent(in)          :: index
+    real(jprb), allocatable, intent(out) :: vector(:)
+
+    integer                      :: n  ! Length of vector
+    integer                      :: istatus
+    integer                      :: ivarid, ndims
+    integer                      :: ndimlens(NF90_MAX_VAR_DIMS)
+    integer                      :: vstart(NF90_MAX_VAR_DIMS)
+    integer                      :: vcount(NF90_MAX_VAR_DIMS)
+    integer                      :: j
+
+    call this%get_variable_id(var_name, ivarid)
+    call this%get_array_dimensions(ivarid, ndims, ndimlens)
+
+    ! Ensure variable has only one dimension aside from the last one
+    n = 1
+    do j = 1, ndims-1
+      n = n * ndimlens(j)
+      if (j > 1 .and. ndimlens(j) > 1) then
+        write(nulerr,'(a,a,a)') '*** Error reading 1D slice from NetCDF variable ', &
+             & var_name, &
+             & ': all dimensions except the first and last must be singletons'
+        call my_abort('Error reading NetCDF file')
+      end if
+    end do
+
+    ! Reallocate if necessary
+    if (allocated(vector)) then
+      if (size(vector) /= n) then
+        if (this%iverbose >= 1) then
+          write(nulout,'(a,i0,a,a)') '  Warning: resizing vector to length ', n, &
+               &                ' to read slice of ', var_name
+        end if
+        deallocate(vector)
+        allocate(vector(n))
+      end if
+    else
+      allocate(vector(n))
+    end if
+
+    if (this%iverbose >= 3) then
+      write(nulout,'(a,i0,a,a)') '  Reading column ', index, ' of ', var_name
+    end if
+
+    if (index < 1 .or. index > ndimlens(ndims)) then
+      write(nulerr,'(a,i0,a,a,a,i0)') '*** Error reading element ', index, &
+           &  ' of NetCDF variable ', &
+           &    var_name, ' with outer dimension ', ndimlens(ndims)
+      call my_abort('Error reading NetCDF file')
+    end if
+
+    ! Read variable
+    vstart(1:ndims-1) = 1
+    vstart(ndims)     = index
+    vcount(1:ndims-1) = ndimlens(1:ndims-1)
+    vcount(ndims)     = 1
+    istatus = nf90_get_var(this%ncid, ivarid, vector, &
+         &                 start=vstart, count=vcount)
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error reading 1D slice of NetCDF variable ', &
+           &  var_name, ': ', trim(nf90_strerror(istatus))
+      call my_abort('Error reading NetCDF file')
+    end if
+
+  end subroutine get_real_vector_indexed
+
+
+  !---------------------------------------------------------------------
+  ! Read 2D array into "matrix", which must be allocatable and will be
+  ! reallocated if necessary.  Whether to transpose is specifed by the
+  ! final optional argument, but can also be specified by the
+  ! do_transpose_2d class data member.
+  subroutine get_real_matrix(this, var_name, matrix, do_transp)
+    class(netcdf_file)           :: this
+    character(len=*), intent(in) :: var_name
+    real(jprb), allocatable, intent(out) :: matrix(:,:)
+    logical, optional, intent(in):: do_transp ! Transpose data?
+
+    real(jprb), allocatable      :: tmp_matrix(:,:)
+    integer                      :: ndimlen1, ndimlen2
+    integer                      :: istatus
+    integer                      :: ivarid, ndims
+    integer                      :: ndimlens(NF90_MAX_VAR_DIMS)
+    integer                      :: j, ntotal
+    logical                      :: do_transpose
+
+    ! Decide whether to transpose the array
+    if (present(do_transp)) then
+      do_transpose = do_transp
+    else
+      do_transpose = this%do_transpose_2d
+    end if
+
+    call this%get_variable_id(var_name, ivarid)
+    call this%get_array_dimensions(ivarid, ndims, ndimlens)
+
+    ! Ensure the variable has no more than two non-singleton
+    ! dimensions
+    ntotal = 1
+    do j = 1, ndims
+      ntotal = ntotal * ndimlens(j)
+      if (j > 2 .and. ndimlens(j) > 1) then
+        write(nulerr,'(a,a,a)') '*** Error reading NetCDF variable ', &
+           & var_name, &
+           & ' as a matrix: all dimensions above the second must be singletons'
+        call my_abort('Error reading NetCDF file')
+      end if
+    end do
+
+    ! Work out dimension lengths
+    if (ndims >= 2) then
+      ndimlen1 = ndimlens(1)
+      ndimlen2 = ntotal/ndimlen1
+    else
+      ndimlen1 = ntotal
+      ndimlen2 = 1
+    end if
+
+    if (do_transpose) then
+      ! Read and transpose
+      allocate(tmp_matrix(ndimlen1, ndimlen2))
+
+      ! Reallocate if necessary
+      if (allocated(matrix)) then
+        if (size(matrix,1) /= ndimlen2 .or. size(matrix,2) /= ndimlen1) then
+          if (this%iverbose >= 1) then
+            write(nulout,'(a,a)') '  Warning: resizing matrix to read ', var_name
+          end if
+          deallocate(matrix)
+          allocate(matrix(ndimlen2, ndimlen1))
+        end if
+      else
+        allocate(matrix(ndimlen2, ndimlen1))
+      end if
+
+      if (this%iverbose >= 3) then
+        write(nulout,'(a,a,a,i0,a,i0,a)',advance='no') '  Reading ', var_name, '(', &
+             &                            ndimlen2, ',', ndimlen1, ')'
+        call this%print_variable_attributes(ivarid,nulout)
+      end if
+
+      istatus = nf90_get_var(this%ncid, ivarid, tmp_matrix)
+      matrix = transpose(tmp_matrix)
+      deallocate(tmp_matrix)
+    else
+      ! Read data without transposition
+
+      ! Reallocate if necessary
+      if (allocated(matrix)) then
+        if (size(matrix,1) /= ndimlen1 .or. size(matrix,2) /= ndimlen2) then
+          if (this%iverbose >= 1) then
+            write(nulout,'(a,a)') '  Warning: resizing matrix to read ', var_name
+          end if
+          allocate(matrix(ndimlen1, ndimlen2))
+        end if
+      else
+        allocate(matrix(ndimlen1, ndimlen2))
+      end if
+
+      if (this%iverbose >= 3) then
+        write(nulout,'(a,a,a,i0,a,i0,a)',advance='no') '  Reading ', var_name, '(', &
+             &                            ndimlen1, ',', ndimlen2, ')'
+        call this%print_variable_attributes(ivarid,nulout)
+      end if
+
+      istatus = nf90_get_var(this%ncid, ivarid, matrix)
+    end if
+
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error reading NetCDF variable ', &
+           &    var_name, ' as a matrix: ', trim(nf90_strerror(istatus))
+      call my_abort('Error reading NetCDF file')
+    end if
+
+  end subroutine get_real_matrix
+
+
+  !---------------------------------------------------------------------
+  ! Read matrix of data from a larger array, which must be allocatable
+  ! and will be reallocated if necessary.  Whether to transpose is
+  ! specifed by the final optional argument, but can also be specified
+  ! by the do_transpose_2d class data member.
+  subroutine get_real_matrix_indexed(this, var_name, index, matrix, do_transp)
+    class(netcdf_file)           :: this
+    character(len=*), intent(in) :: var_name
+    integer, intent(in)          :: index
+    real(jprb), allocatable, intent(out) :: matrix(:,:)
+    logical, optional, intent(in):: do_transp ! Transpose data?
+
+    real(jprb), allocatable      :: tmp_matrix(:,:)
+    integer                      :: ndimlen1, ndimlen2
+    integer                      :: istatus
+    integer                      :: ivarid, ndims
+    integer                      :: ndimlens(NF90_MAX_VAR_DIMS)
+    integer                      :: vstart(NF90_MAX_VAR_DIMS)
+    integer                      :: vcount(NF90_MAX_VAR_DIMS)
+    integer                      :: j, ntotal
+    logical                      :: do_transpose
+
+    ! Decide whether to transpose the array
+    if (present(do_transp)) then
+      do_transpose = do_transp
+    else
+      do_transpose = this%do_transpose_2d
+    end if
+
+    call this%get_variable_id(var_name, ivarid)
+    call this%get_array_dimensions(ivarid, ndims, ndimlens)
+
+    ! Ensure the variable has no more than two non-singleton
+    ! dimensions aside from the last one
+    ntotal = 1
+    do j = 1, ndims-1
+      ntotal = ntotal * ndimlens(j)
+      if (j > 2 .and. ndimlens(j) > 1) then
+        write(nulerr,'(a,a,a)') '*** Error reading 2D slice from NetCDF variable ', &
+           & var_name, &
+           & ': all dimensions except the first, second and last must be singletons'
+        call my_abort('Error reading NetCDF file')
+      end if
+    end do
+
+    if (index < 1 .or. index > ndimlens(ndims)) then
+      write(nulerr,'(a,i0,a,a,a,i0)') '*** Error reading element ', index, &
+           &  ' of NetCDF variable ', &
+           &    var_name, ' with outer dimension ', ndimlens(ndims)
+      call my_abort('Error reading NetCDF file')
+    end if
+
+    ! Work out dimension lengths
+    if (ndims >= 2) then
+      ndimlen1 = ndimlens(1)
+      ndimlen2 = ntotal/ndimlen1
+    else
+      ndimlen1 = ntotal
+      ndimlen2 = 1
+    end if
+
+    vstart(1:ndims-1) = 1
+    vstart(ndims)     = index
+    vcount(1:ndims-1) = ndimlens(1:ndims-1)
+    vcount(ndims)     = 1
+
+    if (do_transpose) then
+      ! Read and transpose
+      allocate(tmp_matrix(ndimlen1, ndimlen2))
+
+      ! Reallocate if necessary
+      if (allocated(matrix)) then
+        if (size(matrix,1) /= ndimlen2 .or. size(matrix,2) /= ndimlen1) then
+          if (this%iverbose >= 1) then
+            write(nulout,'(a,a)') '  Warning: resizing matrix to read ', var_name
+          end if
+          allocate(matrix(ndimlen2, ndimlen1))
+        end if
+      else
+        allocate(matrix(ndimlen2, ndimlen1))
+      end if
+
+      if (this%iverbose >= 3) then
+        write(nulout,'(a,i0,a,a,a,i0,a,i0,a)') '  Reading slice ', index, &
+             &  ' of ', var_name, ' as ', ndimlen2, 'x', ndimlen1, ' array'
+      end if
+
+      istatus = nf90_get_var(this%ncid, ivarid, tmp_matrix, &
+           &                 start=vstart, count=vcount)
+      matrix = transpose(tmp_matrix)
+      deallocate(tmp_matrix)
+    else
+      ! Read data without transposition
+
+      ! Reallocate if necessary
+      if (allocated(matrix)) then
+        if (size(matrix,1) /= ndimlen1 .or. size(matrix,2) /= ndimlen2) then
+          if (this%iverbose >= 1) then
+            write(nulout,'(a,a)') '  Warning: resizing matrix to read ', var_name
+          end if
+          allocate(matrix(ndimlen1, ndimlen2))
+        end if
+      else
+        allocate(matrix(ndimlen1, ndimlen2))
+      end if
+
+      if (this%iverbose >= 3) then
+        write(nulout,'(a,i0,a,a,a,i0,a,i0,a)') '  Reading slice ', index, &
+             &  ' of ', var_name, ' as ', ndimlen1, 'x', ndimlen2, ' array'
+      end if
+
+      istatus = nf90_get_var(this%ncid, ivarid, matrix, &
+           &                 start=vstart, count=vcount)
+    end if
+
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error reading 2D slice of NetCDF variable ', &
+           &    var_name, ': ', trim(nf90_strerror(istatus))
+      call my_abort('Error reading NetCDF file')
+    end if
+
+  end subroutine get_real_matrix_indexed
+
+
+  !---------------------------------------------------------------------
+  ! Read 3D array into "var", which must be allocatable and will be
+  ! reallocated if necessary.  Whether to pemute is specifed by the
+  ! final optional argument
+  subroutine get_real_array3(this, var_name, var, ipermute)
+    class(netcdf_file)                   :: this
+    character(len=*), intent(in)         :: var_name
+    real(jprb), allocatable, intent(out) :: var(:,:,:)
+    integer, optional, intent(in)        :: ipermute(3)
+
+    real(jprb), allocatable   :: var_permute(:,:,:)
+    integer                   :: ndimlen1, ndimlen2, ndimlen3
+    integer                   :: istatus
+    integer                   :: ivarid, ndims
+    integer                   :: ndimlens(NF90_MAX_VAR_DIMS)
+    integer                   :: j, ntotal
+    integer                   :: n_dimlens_permuted(3)
+    integer                   :: i_permute_3d(3)
+    logical                   :: do_permute
+
+    ! Decide whether to permute
+    if (present(ipermute)) then
+      do_permute = .true.
+      i_permute_3d = ipermute
+    else
+      do_permute = this%do_permute_3d
+      i_permute_3d = this%i_permute_3d
+    end if
+
+    call this%get_variable_id(var_name, ivarid)
+    call this%get_array_dimensions(ivarid, ndims, ndimlens)
+
+    ! Ensure the variable has no more than three non-singleton
+    ! dimensions
+    ntotal = 1
+    do j = 1, ndims
+      ntotal = ntotal * ndimlens(j)
+      if (j > 3 .and. ndimlens(j) > 1) then
+        write(nulerr,'(a,a,a)') '*** Error reading NetCDF variable ', &
+           & var_name, &
+           & ' as a 3D array: all dimensions above the third must be singletons'
+        call my_abort('Error reading NetCDF file')
+      end if
+    end do
+
+    ! Work out dimension lengths
+    if (ndims >= 3) then
+      ndimlen1 = ndimlens(1)
+      ndimlen2 = ndimlens(2)
+      ndimlen3 = ntotal/(ndimlen1*ndimlen2)
+    else if (ndims >= 2) then
+      ndimlen1 = ndimlens(1)
+      ndimlen2 = ntotal/ndimlen1
+      ndimlen3 = 1
+    else
+      ndimlen1 = ntotal
+      ndimlen2 = 1
+      ndimlen3 = 1
+    end if
+
+    ! Deallocate if necessary
+    if (allocated(var)) then
+      deallocate(var)
+    end if
+
+    if (do_permute) then
+      ! Read and permute
+      allocate(var_permute(ndimlen1, ndimlen2, ndimlen3))
+      n_dimlens_permuted(i_permute_3d) = ndimlens(1:3)
+
+      ! Reallocate if necessary
+      if (allocated(var)) then
+        if (size(var,1) /= n_dimlens_permuted(1) &
+             &  .or. size(var,2) /= n_dimlens_permuted(2) &
+             &  .or. size(var,3) /= n_dimlens_permuted(3)) then
+          if (this%iverbose >= 1) then
+            write(nulout,'(a,a)') '  Warning: resizing array to read ', var_name
+          end if
+          deallocate(var)
+          allocate(var(n_dimlens_permuted(1), n_dimlens_permuted(2), &
+               &       n_dimlens_permuted(3)))
+        end if
+      else
+        allocate(var(n_dimlens_permuted(1), n_dimlens_permuted(2), &
+             &       n_dimlens_permuted(3)))
+      end if
+
+      if (this%iverbose >= 3) then
+        write(nulout,'(a,a,a,i0,i0,i0,a)',advance='no') '  Reading ', var_name, &
+             & ' (permuted dimensions ', i_permute_3d, ')'
+        call this%print_variable_attributes(ivarid,nulout)
+      end if
+
+      istatus = nf90_get_var(this%ncid, ivarid, var_permute)
+      var = reshape(var_permute, n_dimlens_permuted, order=i_permute_3d)
+      deallocate(var_permute)
+
+    else
+      ! Read data without permutation
+
+      ! Reallocate if necessary
+      if (allocated(var)) then
+        if (size(var,1) /= ndimlen1 &
+             &  .or. size(var,2) /= ndimlen2 &
+             &  .or. size(var,3) /= ndimlen3) then
+          if (this%iverbose >= 1) then
+            write(nulout,'(a,a)') '  Warning: resizing array to read ', var_name
+          end if
+          deallocate(var)
+          allocate(var(ndimlen1, ndimlen2, ndimlen3))
+        end if
+      else
+        allocate(var(ndimlen1, ndimlen2, ndimlen3))
+      end if
+
+      if (this%iverbose >= 3) then
+        write(nulout,'(a,a,a,i0,a,i0,a,i0,a)',advance='no') '  Reading ', var_name, &
+             &            '(', ndimlen1, ',', ndimlen2, ',', ndimlen3, ')'
+        call this%print_variable_attributes(ivarid,nulout)
+      end if
+
+      istatus = nf90_get_var(this%ncid, ivarid, var)
+    end if
+
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error reading NetCDF variable ', &
+           &  var_name, ' as a 3D array: ', trim(nf90_strerror(istatus))
+      call my_abort('Error reading NetCDF file')
+    end if
+
+  end subroutine get_real_array3
+
+
+  !---------------------------------------------------------------------
+  ! Read 3D array of data from a larger-dimensional array, which must
+  ! be allocatable and will be reallocated if necessary.  Whether to
+  ! pemute is specifed by the final optional argument
+  subroutine get_real_array3_indexed(this, var_name, index, var, ipermute)
+    class(netcdf_file)                   :: this
+    character(len=*), intent(in)         :: var_name
+    integer, intent(in)                  :: index
+    real(jprb), allocatable, intent(out) :: var(:,:,:)
+    integer, optional, intent(in)        :: ipermute(3)
+
+    real(jprb), allocatable   :: var_permute(:,:,:)
+    integer                   :: ndimlen1, ndimlen2, ndimlen3
+    integer                   :: istatus
+    integer                   :: ivarid, ndims
+    integer                   :: ndimlens(NF90_MAX_VAR_DIMS)
+    integer                   :: vstart(NF90_MAX_VAR_DIMS)
+    integer                   :: vcount(NF90_MAX_VAR_DIMS)
+    integer                   :: j, ntotal
+    integer                   :: n_dimlens_permuted(3)
+    integer                   :: i_permute_3d(3)
+    logical                   :: do_permute
+
+    ! Decide whether to permute
+    if (present(ipermute)) then
+      do_permute = .true.
+      i_permute_3d = ipermute
+    else
+      do_permute = this%do_permute_3d
+      i_permute_3d = this%i_permute_3d
+    end if
+
+    call this%get_variable_id(var_name, ivarid)
+    call this%get_array_dimensions(ivarid, ndims, ndimlens)
+
+    ! Ensure the variable has no more than three non-singleton
+    ! dimensions aside from the last one
+    ntotal = 1
+    do j = 1, ndims-1
+      ntotal = ntotal * ndimlens(j)
+      if (j > 3 .and. ndimlens(j) > 1) then
+        write(nulerr,'(a,a,a)') '*** Error reading 3D slice from NetCDF variable ', &
+           & var_name, &
+           & ': all dimensions above the third must be singletons'
+        call my_abort('Error reading NetCDF file')
+      end if
+    end do
+
+    if (index < 1 .or. index > ndimlens(ndims)) then
+      write(nulerr,'(a,i0,a,a,a,i0)') '*** Error reading element ', index, &
+           &  ' of NetCDF variable ', &
+           &    var_name, ' with outer dimension ', ndimlens(ndims)
+      call my_abort('Error reading NetCDF file')
+    end if
+
+    ! Work out dimension lengths
+    if (ndims >= 3) then
+      ndimlen1 = ndimlens(1)
+      ndimlen2 = ndimlens(2)
+      ndimlen3 = ntotal/(ndimlen1*ndimlen2)
+    else if (ndims >= 2) then
+      ndimlen1 = ndimlens(1)
+      ndimlen2 = ntotal/ndimlen1
+      ndimlen3 = 1
+    else
+      ndimlen1 = ntotal
+      ndimlen2 = 1
+      ndimlen3 = 1
+    end if
+
+    vstart(1:ndims-1) = 1
+    vstart(ndims)     = index
+    vcount(1:ndims-1) = ndimlens(1:ndims-1)
+    vcount(ndims)     = 1
+
+    if (do_permute) then
+      ! Read and permute
+      allocate(var_permute(ndimlen1, ndimlen2, ndimlen3))
+      n_dimlens_permuted(i_permute_3d) = ndimlens(1:3)
+
+      ! Reallocate if necessary
+      if (allocated(var)) then
+        if (size(var,1) /= n_dimlens_permuted(1) &
+             &  .or. size(var,2) /= n_dimlens_permuted(2) &
+             &  .or. size(var,3) /= n_dimlens_permuted(3)) then
+          if (this%iverbose >= 1) then
+            write(nulout,'(a,a)') '  Warning: resizing array to read ', var_name
+          end if
+          deallocate(var)
+          allocate(var(n_dimlens_permuted(1), n_dimlens_permuted(2), &
+               &       n_dimlens_permuted(3)))
+        end if
+      else
+        allocate(var(n_dimlens_permuted(1), n_dimlens_permuted(2), &
+             &       n_dimlens_permuted(3)))
+      end if
+
+      if (this%iverbose >= 3) then
+        write(nulout,'(a,i0,a,a,a,i0,i0,i0,a)') '  Reading slice ', index, &
+             &  ' of ', var_name, &
+             & ' (permuted dimensions ', i_permute_3d, ')'
+      end if
+
+      istatus = nf90_get_var(this%ncid, ivarid, var_permute, &
+           &                 start=vstart, count=vcount)
+      var = reshape(var_permute, n_dimlens_permuted, order=i_permute_3d)
+      deallocate(var_permute)
+
+    else
+      ! Read data without permutation
+
+      ! Reallocate if necessary
+      if (allocated(var)) then
+        if (size(var,1) /= ndimlen1 &
+             &  .or. size(var,2) /= ndimlen2 &
+             &  .or. size(var,3) /= ndimlen3) then
+          if (this%iverbose >= 1) then
+            write(nulout,'(a,a)') '  Warning: resizing array to read ', var_name
+          end if
+          deallocate(var)
+          allocate(var(ndimlen1, ndimlen2, ndimlen3))
+        end if
+      else
+        allocate(var(ndimlen1, ndimlen2, ndimlen3))
+      end if
+
+      if (this%iverbose >= 3) then
+        write(nulout,'(a,i0,a,a,a,i0,a,i0,a,i0,a)') '  Reading slice ', index, &
+             &  ' of ', var_name, ' as ', ndimlen1, 'x', ndimlen2, 'x', &
+             &  ndimlen3, 'array'
+      end if
+
+      istatus = nf90_get_var(this%ncid, ivarid, var, &
+           &                 start=vstart, count=vcount)
+    end if
+
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error reading 3D slice of NetCDF variable ', &
+           &  var_name, ': ', trim(nf90_strerror(istatus))
+      call my_abort('Error reading NetCDF file')
+    end if
+
+  end subroutine get_real_array3_indexed
+
+
+  !---------------------------------------------------------------------
+  ! Read 4D array into "var", which must be allocatable and will be
+  ! reallocated if necessary.  Whether to pemute is specifed by the
+  ! final optional argument
+  subroutine get_real_array4(this, var_name, var, ipermute)
+    class(netcdf_file)                   :: this
+    character(len=*), intent(in)         :: var_name
+    real(jprb), allocatable, intent(out) :: var(:,:,:,:)
+    integer, optional, intent(in)        :: ipermute(4)
+
+    real(jprb), allocatable   :: var_permute(:,:,:,:)
+    integer                   :: ndimlen1, ndimlen2, ndimlen3, ndimlen4
+    integer                   :: istatus
+    integer                   :: ivarid, ndims
+    integer                   :: ndimlens(NF90_MAX_VAR_DIMS)
+    integer                   :: j, ntotal
+    integer                   :: n_dimlens_permuted(4)
+    integer                   :: i_permute_4d(4)
+    logical                   :: do_permute
+
+    ! Decide whether to permute
+    if (present(ipermute)) then
+      do_permute = .true.
+      i_permute_4d = ipermute
+    else
+      do_permute = this%do_permute_4d
+      i_permute_4d = this%i_permute_4d
+    end if
+
+    call this%get_variable_id(var_name, ivarid)
+    call this%get_array_dimensions(ivarid, ndims, ndimlens)
+
+    ! Ensure the variable has no more than three non-singleton
+    ! dimensions
+    ntotal = 1
+    do j = 1, ndims
+      ntotal = ntotal * ndimlens(j)
+      if (j > 4 .and. ndimlens(j) > 1) then
+        write(nulerr,'(a,a,a)') '*** Error reading NetCDF variable ', &
+           & var_name, &
+           & ' as a 4D array: all dimensions above the third must be singletons'
+        call my_abort('Error reading NetCDF file')
+      end if
+    end do
+
+    ! Work out dimension lengths
+    if (ndims >= 4) then
+      ndimlen1 = ndimlens(1)
+      ndimlen2 = ndimlens(2)
+      ndimlen3 = ndimlens(3)
+      ndimlen4 = ntotal/(ndimlen1*ndimlen2*ndimlen3)
+    else if (ndims >= 3) then
+      ndimlen1 = ndimlens(1)
+      ndimlen2 = ndimlens(2)
+      ndimlen3 = ntotal/(ndimlen1*ndimlen2)
+    else if (ndims >= 2) then
+      ndimlen1 = ndimlens(1)
+      ndimlen2 = ntotal/ndimlen1
+      ndimlen3 = 1
+    else
+      ndimlen1 = ntotal
+      ndimlen2 = 1
+      ndimlen3 = 1
+    end if
+
+    ! Deallocate if necessary
+    if (allocated(var)) then
+      deallocate(var)
+    end if
+
+    if (do_permute) then
+      ! Read and permute - not tested
+      allocate(var_permute(ndimlen1, ndimlen2, ndimlen3, ndimlen4))
+      n_dimlens_permuted(i_permute_4d) = ndimlens(1:4)
+
+      ! Reallocate if necessary
+      if (allocated(var)) then
+        if (size(var,1) /= n_dimlens_permuted(1) &
+             &  .or. size(var,2) /= n_dimlens_permuted(2) &
+             &  .or. size(var,3) /= n_dimlens_permuted(3) &
+             &  .or. size(var,4) /= n_dimlens_permuted(4)) then
+          if (this%iverbose >= 1) then
+            write(nulout,'(a,a)') '  Warning: resizing array to read ', var_name
+          end if
+          deallocate(var)
+          allocate(var(n_dimlens_permuted(1), n_dimlens_permuted(2), &
+               &       n_dimlens_permuted(3), n_dimlens_permuted(4)))
+        end if
+      else
+        allocate(var(n_dimlens_permuted(1), n_dimlens_permuted(2), &
+             &       n_dimlens_permuted(3), n_dimlens_permuted(4)))
+      end if
+
+      if (this%iverbose >= 3) then
+        write(nulout,'(a,a,a,i0,i0,i0,a)',advance='no') '  Reading ', var_name, &
+             & ' (permuted dimensions ', i_permute_4d, ')'
+        call this%print_variable_attributes(ivarid,nulout)
+      end if
+
+      istatus = nf90_get_var(this%ncid, ivarid, var_permute)
+      var = reshape(var_permute, n_dimlens_permuted, order=i_permute_4d)
+      deallocate(var_permute)
+
+    else
+      ! Read data without permutation
+
+      ! Reallocate if necessary
+      if (allocated(var)) then
+        if (size(var,1) /= ndimlen1 &
+             &  .or. size(var,2) /= ndimlen2 &
+             &  .or. size(var,3) /= ndimlen3 &
+             &  .or. size(var,4) /= ndimlen4) then
+          if (this%iverbose >= 1) then
+            write(nulout,'(a,a)') '  Warning: resizing array to read ', var_name
+          end if
+          deallocate(var)
+          allocate(var(ndimlen1, ndimlen2, ndimlen3, ndimlen4))
+        end if
+      else
+        allocate(var(ndimlen1, ndimlen2, ndimlen3, ndimlen4))
+      end if
+
+      if (this%iverbose >= 3) then
+        write(nulout,'(a,a,a,i0,a,i0,a,i0,a,i0,a)',advance='no') '  Reading ', var_name, &
+             &            '(', ndimlen1, ',', ndimlen2, ',', ndimlen3,',', ndimlen4, ')'
+        call this%print_variable_attributes(ivarid,nulout)
+      end if
+
+      istatus = nf90_get_var(this%ncid, ivarid, var)
+    end if
+
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error reading NetCDF variable ', &
+           &  var_name, ' as a 4D array: ', trim(nf90_strerror(istatus))
+      call my_abort('Error reading NetCDF file')
+    end if
+
+  end subroutine get_real_array4
+
+
+  !---------------------------------------------------------------------
+  ! Get attribute as a character string
+  subroutine get_string_attribute(this, var_name, attr_name, attr_str)
+    class(netcdf_file) :: this
+
+    character(len=*), intent(in)    :: var_name, attr_name
+    character(len=*), intent(inout) :: attr_str
+
+    integer :: i_attr_len, ivarid
+    integer :: istatus
+    integer :: j
+
+    istatus = nf90_inq_varid(this%ncid, var_name, ivarid)
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error inquiring about variable ', var_name, &
+           &                    ': ', trim(nf90_strerror(istatus))
+      call my_abort('Error reading NetCDF file')
+    end if
+    istatus = nf90_inquire_attribute(this%ncid, ivarid, attr_name, &
+         &                           len = i_attr_len)
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error reading size of attribute ', attr_name, &
+           &                    ': ', trim(nf90_strerror(istatus))
+      call my_abort('Error reading NetCDF file')
+    end if
+
+    ! Allocatable character strings not supported on enough compilers
+    ! yet
+    !    if (allocated(attr_str)) then
+    !      deallocate(attr_str)
+    !    end if
+    !    allocate(character(len=i_attr_len) :: attr_str)
+    if (len(attr_str) < i_attr_len) then
+      write(nulerr,'(a,a)') '*** Error: not enough space to read attribute ', attr_name
+      call my_abort('Error reading NetCDF file')
+    end if
+
+    istatus = nf90_get_att(this%ncid, ivarid, attr_name, attr_str)
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error reading attribute ', attr_name, &
+           &                    ': ', trim(nf90_strerror(istatus))
+      call my_abort('Error reading NetCDF file')
+    end if
+
+    ! Pad with blanks since nf90_get_att does not do this
+    do j = i_attr_len+1,len(attr_str)
+      attr_str(j:j) = ' '
+    end do
+
+  end subroutine get_string_attribute
+
+
+
+  !---------------------------------------------------------------------
+  ! Get attribute as a real scalar
+  subroutine get_real_scalar_attribute(this, var_name, attr_name, attr)
+    class(netcdf_file) :: this
+
+    character(len=*), intent(in)  :: var_name, attr_name
+    real(jprb),       intent(out) :: attr
+
+    integer :: i_attr_len, ivarid
+    integer :: istatus
+    integer :: j
+
+    istatus = nf90_inq_varid(this%ncid, var_name, ivarid)
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error inquiring about variable ', var_name, &
+           &                    ': ', trim(nf90_strerror(istatus))
+      call my_abort('Error reading NetCDF file')
+    end if
+    istatus = nf90_get_att(this%ncid, ivarid, attr_name, attr)
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error reading attribute ', attr_name, &
+           &                    ': ', trim(nf90_strerror(istatus))
+      call my_abort('Error reading NetCDF file')
+    end if
+
+  end subroutine get_real_scalar_attribute
+
+
+  !---------------------------------------------------------------------
+  ! Get a global attribute as a character string
+  subroutine get_global_attribute(this, attr_name, attr_str)
+    class(netcdf_file) :: this
+
+    character(len=*), intent(in)    :: attr_name
+    character(len=*), intent(inout) :: attr_str
+
+    integer :: i_attr_len
+    integer :: istatus
+    integer :: j
+
+    istatus = nf90_inquire_attribute(this%ncid, NF90_GLOBAL, attr_name, &
+         &                           len = i_attr_len)
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error reading size of global attribute ', attr_name, &
+           &                    ': ', trim(nf90_strerror(istatus))
+      call my_abort('Error reading NetCDF file')
+    end if
+
+    ! Allocatable character strings not supported one enough compilers
+    ! yet
+    !    if (allocated(attr_str)) then
+    !      deallocate(attr_str)
+    !    end if
+    !    allocate(character(len=i_attr_len) :: attr_str)
+    if (len(attr_str) < i_attr_len) then
+      write(nulerr,'(a,a)') '*** Error: not enough space to read global attribute ', attr_name
+      call my_abort('Error reading NetCDF file')
+    end if
+
+    istatus = nf90_get_att(this%ncid, NF90_GLOBAL, attr_name, attr_str)
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error reading global attribute ', attr_name, &
+           &                    ': ', trim(nf90_strerror(istatus))
+      call my_abort('Error reading NetCDF file')
+    end if
+
+    ! Pad with blanks since nf90_get_att does not do this
+    do j = i_attr_len+1,len(attr_str)
+      attr_str(j:j) = ' '
+    end do
+
+  end subroutine get_global_attribute
+
+
+  !---------------------------------------------------------------------
+  ! Print a variable's long_name, units and comment, according to
+  ! verbosity level
+  subroutine print_variable_attributes(this, ivarid, iunit)
+    class(netcdf_file)  :: this
+    integer, intent(in) :: ivarid   ! NetCDF ID of variable
+    integer, intent(in) :: iunit    ! Unit to print information to
+
+    character(len=4000) :: attr_str
+    integer :: i_attr_len
+    integer :: istatus
+    integer :: j
+
+    if (this%iverbose >= 4) then
+      istatus = nf90_get_att(this%ncid, ivarid, 'long_name', attr_str)
+      if (istatus == NF90_NOERR) then
+        write(iunit, '(a)') ':'
+        write(iunit, '(a,a)', advance='no') '    ', trim(attr_str)
+        istatus = nf90_get_att(this%ncid, ivarid, 'units', attr_str)
+        if (istatus == NF90_NOERR) then
+          if (trim(attr_str) == '1') then
+            write(iunit, '(a)') ' (dimensionless)'
+          else
+            write(iunit, '(a,a,a)') ' (', trim(attr_str), ')'
+          end if
+        else
+          ! No units present
+          write(iunit, '(1x)')
+        end if
+        if (this%iverbose >= 5) then
+          istatus = nf90_get_att(this%ncid, ivarid, 'comment', attr_str)
+          if (istatus == NF90_NOERR) then
+            write(iunit, '(a,a,a)') 'comment="', trim(attr_str), '"'
+          end if
+        end if
+      end if
+    else
+      ! No long_name present
+      write(iunit, '(1x)')
+    end if
+
+  end subroutine print_variable_attributes
+
+
+  ! --- WRITING SUBROUTINES ---
+
+  !---------------------------------------------------------------------
+  ! Define a dimension with name dim_name of length n (or 0 to
+  ! indicate the unlimited dimension)
+  subroutine define_dimension(this, dim_name, n)
+    class(netcdf_file)           :: this
+    character(len=*), intent(in) :: dim_name
+    integer, intent(in)          :: n
+    integer                      :: idimid, istatus
+
+    istatus = nf90_def_dim(this%ncid, dim_name, n, idimid)
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error defining ', dim_name, &
+           &   ' as a dimension: ', trim(nf90_strerror(istatus))
+      call my_abort('Error writing NetCDF file')
+    end if
+
+    if (this%iverbose >= 4) then
+      write(nulout,'(a,a,a,i0)') '  Defining dimension ',trim(dim_name), &
+           & ' of length ', n
+    end if
+
+  end subroutine define_dimension
+
+
+  !---------------------------------------------------------------------
+  ! Define a variable with name var_name, and specify its shape via
+  ! the dim1_name, dim2_name and dim3_name optional arguments, which
+  ! are strings referring to existing dimensions. If none are
+  ! specified, the variable will be a scalar. The optional arguments
+  ! long_name, units and comment write string attributes with these
+  ! names.
+  subroutine define_variable(this, var_name, dim1_name, dim2_name, dim3_name, &
+       &                     long_name, units_str, comment_str, standard_name, is_double, &
+       &                     data_type_name, fill_value, deflate_level, shuffle, chunksizes)
+    class(netcdf_file)                     :: this
+    character(len=*), intent(in)           :: var_name
+    character(len=*), intent(in), optional :: long_name, units_str, comment_str, standard_name
+    character(len=*), intent(in), optional :: dim1_name, dim2_name, dim3_name
+    logical,          intent(in), optional :: is_double
+    character(len=*), intent(in), optional :: data_type_name
+    real(jprb),       intent(in), optional :: fill_value
+    integer,          intent(in), optional :: deflate_level ! Compression: 0 (none) to 9 (most)
+    logical,          intent(in), optional :: shuffle ! Shuffle bytes before compression
+    integer, dimension(:), intent(in), optional :: chunksizes
+
+    integer :: istatus, ndims, ivarid
+    integer, dimension(NF90_MAX_VAR_DIMS) :: idimids
+    integer :: data_type
+
+    if (present(dim1_name)) then
+      ! Variable is at least one dimensional
+      ndims = 1
+      istatus = nf90_inq_dimid(this%ncid, dim1_name, idimids(1))
+      if (istatus /= NF90_NOERR) then
+        write(nulerr,'(a,a,a,a)') '*** Error inquiring ID of dimension ', &
+             &             dim1_name, ': ', trim(nf90_strerror(istatus))
+        call my_abort('Error writing NetCDF file')
+      end if
+      if (present(dim2_name)) then
+        ! Variable is at least two dimensional
+        ndims = 2
+        istatus = nf90_inq_dimid(this%ncid, dim2_name, idimids(2))
+        if (istatus /= NF90_NOERR) then
+          write(nulerr,'(a,a,a)') '*** Error inquiring ID of dimension ', &
+               &           dim2_name, ': ', trim(nf90_strerror(istatus))
+          call my_abort('Error writing NetCDF file')
+        end if
+        if (present(dim3_name)) then
+          ! Variable is at least three dimensional
+          ndims = 3
+          istatus = nf90_inq_dimid(this%ncid, dim3_name, idimids(3))
+          if (istatus /= NF90_NOERR) then
+            write(nulerr,'(a,a,a,a)') '*** Error inquiring ID of dimension ', &
+                 &             dim3_name, ': ', trim(nf90_strerror(istatus))
+            call my_abort('Error writing NetCDF file')
+          end if
+        end if
+      end if
+    else
+      ! Variable is a scalar
+      ndims = 0
+    end if
+
+    ! Read output precision from optional argument "is_double" if
+    ! present, otherwise from default output precision for this file
+    data_type = NF90_FLOAT ! Default
+    if (present(data_type_name)) then
+      if (data_type_name == 'double') then
+        data_type = NF90_DOUBLE
+      else if (data_type_name == 'byte') then
+        data_type = NF90_BYTE
+      else if (data_type_name == 'short') then
+        data_type = NF90_SHORT
+      else if (data_type_name == 'int') then
+        data_type = NF90_INT
+      else if (data_type_name == 'float') then
+        data_type = NF90_FLOAT
+      else
+        write(nulerr,'(a,a,a)') '*** Error: netCDF data type "', data_type_name, '" not supported'
+        call my_abort('Error writing NetCDF file')
+      end if
+    else if (present(is_double)) then
+      data_type = NF90_DOUBLE
+    end if
+
+    ! Define variable
+#ifdef NC_NETCDF4
+    istatus = nf90_def_var(this%ncid, var_name, data_type, idimids(1:ndims), &
+         & ivarid, deflate_level=deflate_level, shuffle=shuffle, chunksizes=chunksizes)
+#else
+    istatus = nf90_def_var(this%ncid, var_name, data_type, idimids(1:ndims), ivarid)
+#endif
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error defining variable ', var_name, &
+           &                    ': ', trim(nf90_strerror(istatus))
+      call my_abort('Error writing NetCDF file')
+    end if
+
+    ! Add optional attributes
+    if (present(long_name)) then
+      istatus = nf90_put_att(this%ncid, ivarid, "long_name", long_name)
+      if (this%iverbose >= 4) then
+        write(nulout,'(a,a,a,a)') '  Defining ',trim(var_name),': ',long_name
+      end if
+    else
+      if (this%iverbose >= 4) then
+        write(nulout,'(a,a)') '  Defining ',trim(var_name)
+      end if
+    end if
+    if (present(units_str)) then
+      istatus = nf90_put_att(this%ncid, ivarid, "units", units_str)
+    end if
+    if (present(standard_name)) then
+      istatus = nf90_put_att(this%ncid, ivarid, "standard_name", standard_name)
+    end if
+    if (present(comment_str)) then
+      istatus = nf90_put_att(this%ncid, ivarid, "comment", comment_str)
+    end if
+
+    if (present(fill_value)) then
+#ifdef NC_NETCDF4
+      if (data_type == NF90_DOUBLE) then
+        istatus = nf90_def_var_fill(this%ncid, ivarid, 0, real(fill_value,jprd))
+      else if (data_type == NF90_FLOAT) then
+        istatus = nf90_def_var_fill(this%ncid, ivarid, 0, real(fill_value,jprm))
+      else if (data_type == NF90_INT) then
+        istatus = nf90_def_var_fill(this%ncid, ivarid, 0, int(fill_value,4))
+      else if (data_type == NF90_SHORT) then
+        istatus = nf90_def_var_fill(this%ncid, ivarid, 0, int(fill_value,2))
+      else if (data_type == NF90_BYTE) then
+        istatus = nf90_def_var_fill(this%ncid, ivarid, 0, int(fill_value,1))
+      end if
+#else
+      if (data_type == NF90_DOUBLE) then
+        istatus = nf90_put_att(this%ncid, ivarid, "_FillValue", real(fill_value,jprd))
+      else if (data_type == NF90_FLOAT) then
+        istatus = nf90_put_att(this%ncid, ivarid, "_FillValue", real(fill_value,jprm))
+      else if (data_type == NF90_INT) then
+        istatus = nf90_put_att(this%ncid, ivarid, "_FillValue", int(fill_value,4))
+      else if (data_type == NF90_SHORT) then
+        istatus = nf90_put_att(this%ncid, ivarid, "_FillValue", int(fill_value,2))
+      else if (data_type == NF90_BYTE) then
+        istatus = nf90_put_att(this%ncid, ivarid, "_FillValue", int(fill_value,1))
+      end if
+#endif
+    end if
+
+  end subroutine define_variable
+
+
+  !---------------------------------------------------------------------
+  ! Put CF-compliant global attributes into the file
+  subroutine put_global_attributes(this, title_str, inst_str, source_str, &
+       &  comment_str, references_str, creator_name, creator_email_str, &
+       &  contributor_name, project_str, conventions_str)
+    class(netcdf_file)                     :: this
+
+    character(len=*), intent(in), optional :: title_str
+    character(len=*), intent(in), optional :: inst_str
+    character(len=*), intent(in), optional :: source_str
+    character(len=*), intent(in), optional :: creator_name, creator_email_str
+    character(len=*), intent(in), optional :: contributor_name, project_str
+    character(len=*), intent(in), optional :: comment_str, conventions_str
+    character(len=*), intent(in), optional :: references_str
+
+    character(len=32)   :: date_time_str
+    character(len=4000) :: command_line_str
+    character(len=4032) :: history_str
+
+    integer :: time_vals(8)
+    integer :: i ! status
+
+    call date_and_time(values=time_vals)
+    call get_command(command_line_str)
+
+    write(date_time_str,"(i0.4,'-',i0.2,'-',i0.2,' ',i0.2,':',i0.2,':',i0.2)") &
+         &   time_vals(1), time_vals(2), time_vals(3), time_vals(5), time_vals(6), time_vals(7)
+
+    history_str = trim(date_time_str) // ': ' // trim(command_line_str)
+
+    if (present(title_str))   i=nf90_put_att(this%ncid, NF90_GLOBAL, "title", title_str)
+    if (present(inst_str))    i=nf90_put_att(this%ncid, NF90_GLOBAL, "institution", inst_str)
+    if (present(source_str))  i=nf90_put_att(this%ncid, NF90_GLOBAL, "source", source_str)
+    if (present(creator_name))i=nf90_put_att(this%ncid, NF90_GLOBAL, "creator_name", creator_name)
+    if (present(creator_email_str))i=nf90_put_att(this%ncid, NF90_GLOBAL, "creator_email", creator_email_str)
+    if (present(contributor_name))i=nf90_put_att(this%ncid, NF90_GLOBAL, "contributor_name", contributor_name)
+
+    i = nf90_put_att(this%ncid, NF90_GLOBAL, "history", history_str)
+
+    if (present(project_str)) i=nf90_put_att(this%ncid, NF90_GLOBAL, "project", project_str)
+    if (present(comment_str)) i=nf90_put_att(this%ncid, NF90_GLOBAL, "comment", comment_str)
+    if (present(references_str)) i=nf90_put_att(this%ncid, NF90_GLOBAL, &
+         &  "references", references_str)
+    if (present(conventions_str)) i=nf90_put_att(this%ncid, NF90_GLOBAL, &
+         &  "conventions", conventions_str)
+
+  end subroutine put_global_attributes
+
+
+  !---------------------------------------------------------------------
+  ! Put a non-standard global attribute into the file
+  subroutine put_global_attribute(this, attr_name, attr_str)
+    class(netcdf_file) :: this
+
+    character(len=*), intent(in) :: attr_name, attr_str
+
+    integer :: istatus
+
+    istatus = nf90_put_att(this%ncid, NF90_GLOBAL, trim(attr_name), trim(attr_str))
+
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error writing global attribute ', attr_name, &
+           &                    ': ', trim(nf90_strerror(istatus))
+      call my_abort('Error writing NetCDF file')
+    end if
+
+  end subroutine put_global_attribute
+
+
+  !---------------------------------------------------------------------
+  ! Put a non-standard variable attribute into the file
+  subroutine put_attribute(this, var_name, attr_name, attr_str)
+    class(netcdf_file) :: this
+
+    character(len=*), intent(in) :: var_name, attr_name, attr_str
+
+    integer :: istatus, ivarid
+
+    call this%get_variable_id(var_name, ivarid)
+
+    istatus = nf90_put_att(this%ncid, ivarid, trim(attr_name), trim(attr_str))
+
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error writing attribute ', attr_name, &
+           &                    ': ', trim(nf90_strerror(istatus))
+      call my_abort('Error writing NetCDF file')
+    end if
+
+  end subroutine put_attribute
+
+
+  !---------------------------------------------------------------------
+  ! The "put" method saves a scalar, vector or matrix into the
+  ! variable with name var_name, according to the rank of the var
+  ! argument. This version saves a scalar.
+  subroutine put_real_scalar(this, var_name, var)
+    class(netcdf_file)             :: this
+    character(len=*), intent(in)   :: var_name
+    real(jprb), intent(in)         :: var
+
+    integer :: ivarid, ndims, istatus
+    integer(kind=jpib) :: ntotal
+    integer :: ndimlens(NF90_MAX_VAR_DIMS)
+
+    ! If we are in define mode, exit define mode
+    call this%end_define_mode()
+
+    ! Check the variable is a scalar
+    call this%get_variable_id(var_name, ivarid)
+    call this%get_array_dimensions(ivarid, ndims, ndimlens, ntotal)
+    if (ntotal /= 1) then
+      write(nulerr,'(a,a,a,i0)') '*** Error: attempt to write scalar to ', &
+           &                 var_name, ' which has total length ', ntotal
+      call my_abort('Error writing NetCDF file')
+    end if
+
+    ! Save the scalar
+    istatus = nf90_put_var(this%ncid, ivarid, var)
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error writing scalar ', var_name, ': ', &
+           &                    trim(nf90_strerror(istatus))
+      call my_abort('Error writing NetCDF file')
+    end if
+
+  end subroutine put_real_scalar
+
+
+  !---------------------------------------------------------------------
+  ! Save a scalar.
+  subroutine put_real_scalar_indexed(this, var_name, index, var)
+    class(netcdf_file)             :: this
+    character(len=*), intent(in)   :: var_name
+    real(jprb), intent(in)         :: var
+    integer, intent(in)            :: index
+
+    integer :: ivarid, ndims, istatus
+    integer :: ndimlens(NF90_MAX_VAR_DIMS)
+    integer :: vstart(NF90_MAX_VAR_DIMS)
+
+    ! If we are in define mode, exit define mode
+    call this%end_define_mode()
+
+    ! Check the variable is a scalar
+    call this%get_variable_id(var_name, ivarid)
+    call this%get_array_dimensions(ivarid, ndims, ndimlens)
+    if (index < 1 .or. index > ndimlens(ndims)) then
+      write(nulerr,'(a,i0,a,a,a,i0)') '*** Error: attempt to write scalar to element ', &
+           &  index, ' of ', var_name, ' which has outer dimension  ', ndimlens(ndims)
+      call my_abort('Error writing NetCDF file')
+    end if
+
+    ! Save the scalar
+    vstart(1:ndims-1) = 1
+    vstart(ndims)     = index
+    istatus = nf90_put_var(this%ncid, ivarid, var, start=vstart)
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error writing scalar to ', var_name, ': ', &
+           &                    trim(nf90_strerror(istatus))
+      call my_abort('Error writing NetCDF file')
+    end if
+
+  end subroutine put_real_scalar_indexed
+
+
+  !---------------------------------------------------------------------
+  ! Save a vector with name var_name in the file
+  subroutine put_real_vector(this, var_name, var)
+    class(netcdf_file)             :: this
+    character(len=*), intent(in)   :: var_name
+    real(jprb), intent(in)         :: var(:)
+
+    integer :: ivarid, ndims, istatus
+    integer(kind=jpib) :: ntotal
+    integer :: ndimlens(NF90_MAX_VAR_DIMS)
+
+    call this%end_define_mode()
+
+    ! Check the vector is of the right length
+    call this%get_variable_id(var_name, ivarid)
+    call this%get_array_dimensions(ivarid, ndims, ndimlens, ntotal)
+    if (ntotal /= size(var,kind=jpib)) then
+      write(nulerr,'(a,i0,a,a,a,i0)') '*** Error: attempt to write vector of length ', &
+           & size(var), ' to ', var_name, ' which has total length ', ntotal
+      call my_abort('Error writing NetCDF file')
+    end if
+
+    ! Save the vector
+    istatus = nf90_put_var(this%ncid, ivarid, var)
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error writing vector ', var_name, ': ', &
+           &                    trim(nf90_strerror(istatus))
+      call my_abort('Error writing NetCDF file')
+    end if
+
+  end subroutine put_real_vector
+
+
+  !---------------------------------------------------------------------
+  ! Save a vector slice with name var_name in the file
+  subroutine put_real_vector_indexed(this, var_name, index, var)
+    class(netcdf_file)             :: this
+    character(len=*), intent(in)   :: var_name
+    real(jprb), intent(in)         :: var(:)
+    integer, intent(in)            :: index
+
+    integer :: ivarid, ndims, istatus
+    integer(kind=jpib) :: ntotal
+    integer :: ndimlens(NF90_MAX_VAR_DIMS)
+    integer :: vstart(NF90_MAX_VAR_DIMS)
+    integer :: vcount(NF90_MAX_VAR_DIMS)
+
+    call this%end_define_mode()
+
+    ! Check the vector is of the right length
+    call this%get_variable_id(var_name, ivarid)
+    call this%get_array_dimensions(ivarid, ndims, ndimlens, ntotal)
+    ntotal = ntotal / ndimlens(ndims)
+    if (ntotal /= size(var,kind=jpib)) then
+      write(nulerr,'(a,i0,a,a,a,i0)') '*** Error: attempt to write vector of length ', &
+           & size(var), ' to slice of ', var_name, ' which has length ', ntotal
+      call my_abort('Error writing NetCDF file')
+    end if
+    if (index < 1 .or. index > ndimlens(ndims)) then
+      write(nulerr,'(a,i0,a,a,a,i0)') '*** Error: attempt to write vector to slice ', &
+           &  index, ' of ', var_name, ' which has outer dimension  ', ndimlens(ndims)
+      call my_abort('Error writing NetCDF file')
+    end if
+
+    ! Save the vector
+    vstart(1:ndims-1) = 1
+    vstart(ndims)     = index
+    vcount(1:ndims-1) = ndimlens(1:ndims-1)
+    vcount(ndims)     = 1
+    istatus = nf90_put_var(this%ncid, ivarid, var, start=vstart, count=vcount)
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error writing vector to ', var_name, ': ', &
+           &                    trim(nf90_strerror(istatus))
+      call my_abort('Error writing NetCDF file')
+    end if
+
+  end subroutine put_real_vector_indexed
+
+
+  !---------------------------------------------------------------------
+  ! Save a matrix with name var_name in the file, transposing its
+  ! dimensions if either optional argument transp is .true., or the
+  ! transpose_matrices method has already been called.
+  subroutine put_real_matrix(this, var_name, var, do_transp)
+    class(netcdf_file)             :: this
+    character(len=*), intent(in)   :: var_name
+    real(jprb), intent(in)         :: var(:,:)
+    real(jprb), allocatable        :: var_transpose(:,:)
+    logical, optional, intent(in):: do_transp
+
+    integer :: ivarid, ndims, nvarlen, istatus
+    integer(kind=jpib) :: ntotal
+    integer :: ndimlens(NF90_MAX_VAR_DIMS)
+
+    logical :: do_transpose
+
+    if (present(do_transp)) then
+      do_transpose = do_transp
+    else
+      do_transpose = this%do_transpose_2d
+    end if
+
+    call this%end_define_mode()
+
+    call this%get_variable_id(var_name, ivarid)
+    call this%get_array_dimensions(ivarid, ndims, ndimlens, ntotal)
+
+    nvarlen = size(var,1)*size(var,2)
+
+    ! Check the total size of the variable to be stored (but receiving
+    ! ntotal is zero then there must be an unlimited dimension)
+    if (ntotal /= size(var,kind=jpib) .and. ntotal /= 0) then
+      write(nulerr,'(a,i0,a,a,a,i0)') '*** Error: attempt to write matrix of total size ', &
+           & nvarlen, ' to ', var_name, ' which has total size ', ntotal
+      call my_abort('Error writing NetCDF file')
+    end if
+
+    if (do_transpose) then
+      ! Save the matrix with transposition
+      if (this%iverbose >= 3) then
+        write(nulout,'(a,a,a)') '  Writing ', var_name, &
+             & ' (transposing dimensions)'
+      end if
+      allocate(var_transpose(size(var,2), size(var,1)))
+      var_transpose = transpose(var)
+      istatus = nf90_put_var(this%ncid, ivarid, var_transpose)
+      deallocate(var_transpose)
+    else
+      ! Save the matrix without transposition
+      if (this%iverbose >= 3) then
+        write(nulout,'(a,a)') '  Writing ', var_name
+      end if
+      istatus = nf90_put_var(this%ncid, ivarid, var)
+    end if
+
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error writing matrix ', var_name, &
+           &                    ': ', trim(nf90_strerror(istatus))
+      call my_abort('Error writing NetCDF file')
+    end if
+
+  end subroutine put_real_matrix
+
+
+  !---------------------------------------------------------------------
+  ! Save a matrix slice with name var_name in the file, transposing its
+  ! dimensions if either optional argument transp is .true., or the
+  ! transpose_matrices method has already been called.
+  subroutine put_real_matrix_indexed(this, var_name, index, var, do_transp)
+    class(netcdf_file)             :: this
+    character(len=*), intent(in)   :: var_name
+    real(jprb), intent(in)         :: var(:,:)
+    integer, intent(in)            :: index
+
+    real(jprb), allocatable        :: var_transpose(:,:)
+    logical, optional, intent(in):: do_transp
+
+    integer :: ivarid, ndims, nvarlen, istatus
+    integer(kind=jpib) :: ntotal
+    integer :: ndimlens(NF90_MAX_VAR_DIMS)
+    integer :: vstart(NF90_MAX_VAR_DIMS)
+    integer :: vcount(NF90_MAX_VAR_DIMS)
+
+    logical :: do_transpose
+
+    if (present(do_transp)) then
+      do_transpose = do_transp
+    else
+      do_transpose = this%do_transpose_2d
+    end if
+
+    call this%end_define_mode()
+
+    call this%get_variable_id(var_name, ivarid)
+    call this%get_array_dimensions(ivarid, ndims, ndimlens, ntotal)
+
+    nvarlen = size(var,1)*size(var,2)
+
+    ! Check the total size of the variable to be stored (but receiving
+    ! ntotal is zero then there must be an unlimited dimension)
+    ntotal = ntotal / ndimlens(ndims)
+    if (ntotal /= size(var,kind=jpib) .and. ntotal /= 0) then
+      write(nulerr,'(a,i0,a,a,a,i0)') '*** Error: attempt to write matrix of total size ', &
+           & nvarlen, ' to ', var_name, ' which has total size ', ntotal
+      call my_abort('Error writing NetCDF file')
+    end if
+
+    vstart(1:ndims-1) = 1
+    vstart(ndims)     = index
+    vcount(1:ndims-1) = ndimlens(1:ndims-1)
+    vcount(ndims)     = 1
+
+    if (do_transpose) then
+      ! Save the matrix with transposition
+      if (this%iverbose >= 3) then
+        write(nulout,'(a,i0,a,a,a)') '  Writing slice ', index, ' of ', var_name, &
+             & ' (transposing dimensions)'
+      end if
+      allocate(var_transpose(size(var,2), size(var,1)))
+      var_transpose = transpose(var)
+      istatus = nf90_put_var(this%ncid, ivarid, var_transpose, start=vstart, count=vcount)
+      deallocate(var_transpose)
+    else
+      ! Save the matrix without transposition
+      if (this%iverbose >= 3) then
+        write(nulout,'(a,i0,a,a)') '  Writing slice ', index, ' of ', var_name
+      end if
+      istatus = nf90_put_var(this%ncid, ivarid, var, start=vstart, count=vcount)
+    end if
+
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error writing matrix ', var_name, &
+           &                    ': ', trim(nf90_strerror(istatus))
+      call my_abort('Error writing NetCDF file')
+    end if
+
+  end subroutine put_real_matrix_indexed
+
+
+  !---------------------------------------------------------------------
+  ! Save a 3D array with name var_name in the file.  The optional
+  ! argument permute specifies that the dimensions should first be
+  ! permuted according to the three integers therein (or if
+  ! permute_3d_arrays has already been called). ipermute is
+  ! interpretted such that if OLD and NEW are 3-element vectors
+  ! containing the size of each dimension in memory and in the written
+  ! file, respectively, then NEW=OLD(ipermute).
+  subroutine put_real_array3(this, var_name, var, ipermute)
+    class(netcdf_file)             :: this
+    character(len=*), intent(in)   :: var_name
+    real(jprb), intent(in)         :: var(:,:,:)
+    real(jprb), allocatable        :: var_permute(:,:,:)
+    integer, optional, intent(in)  :: ipermute(3)
+
+    integer :: ivarid, ndims, nvarlen, istatus
+    integer(kind=jpib) :: ntotal
+    integer :: ndimlens(NF90_MAX_VAR_DIMS)
+
+    logical :: do_permute          ! Do we permute?
+    integer :: i_permute_3d(3)
+    integer :: n_dimlens_permuted(3)
+    integer :: i_order(3)
+
+    ! Decide whether to permute
+    if (present(ipermute)) then
+      do_permute   = .true.
+      i_permute_3d = ipermute
+    else
+      do_permute   = this%do_permute_3d
+      i_permute_3d = this%i_permute_3d
+    end if
+
+    call this%end_define_mode()
+
+    ! Check total size
+    call this%get_variable_id(var_name, ivarid)
+    call this%get_array_dimensions(ivarid, ndims, ndimlens, ntotal)
+    nvarlen = size(var,1)*size(var,2)*size(var,3)
+    if (ntotal /= size(var,kind=jpib)) then
+      write(nulerr,'(a,i0,a,a,a,i0)') '*** Error: attempt to write array of total size ', &
+           & nvarlen, ' to ', var_name, ' which has total size ', ntotal
+      call my_abort('Error writing NetCDF file')
+    end if
+
+    if (do_permute) then
+      ! Save array after permuting dimensions
+      if (this%iverbose >= 3) then
+        write(nulout,'(a,a,a,i0,i0,i0,a)') '  Writing ', var_name, &
+             & ' (permuted dimensions: ', i_permute_3d, ')'
+      end if
+      n_dimlens_permuted = (/ size(var,i_permute_3d(1)), &
+           &                  size(var,i_permute_3d(2)), &
+           &                  size(var,i_permute_3d(3))  /)
+      if (this%iverbose >= 4) then
+        write(nulout,'(a,i0,a,i0,a,i0,a,i0,a,i0,a,i0,a)') '    (', &
+             &  n_dimlens_permuted(1), ',', n_dimlens_permuted(2), &
+             &  ',', n_dimlens_permuted(3), ') -> (', ndimlens(1), &
+             &  ',', ndimlens(2), ',', ndimlens(3), ')'
+      end if
+      allocate(var_permute(n_dimlens_permuted(1), &
+           &   n_dimlens_permuted(2), n_dimlens_permuted(3)))
+      ! Due to the odd way that ORDER works in Fortran RESHAPE, we
+      ! need to do this:
+      i_order(i_permute_3d) = (/ 1, 2, 3 /)
+      var_permute = reshape(var, n_dimlens_permuted, order=i_order)
+      istatus = nf90_put_var(this%ncid, ivarid, var_permute)
+      deallocate(var_permute)
+    else
+      ! Save array without permuting dimensions
+      if (this%iverbose >= 3) then
+        write(nulout,'(a,a)') '  Writing ', var_name
+      end if
+      istatus = nf90_put_var(this%ncid, ivarid, var)
+    end if
+
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error writing array ', var_name, &
+           &                    ': ', trim(nf90_strerror(istatus))
+      call my_abort('Error writing NetCDF file')
+    end if
+
+  end subroutine put_real_array3
+
+end module easy_netcdf
Index: LMDZ6/trunk/libf/phylmd/ecrad/ec_meminfo.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/ec_meminfo.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/ec_meminfo.intfb.h	(revision 3908)
@@ -0,0 +1,18 @@
+/**
+ * (C) Copyright 2014- ECMWF.
+ *
+ * This software is licensed under the terms of the Apache Licence Version 2.0
+ * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+ *
+ * In applying this licence, ECMWF does not waive the privileges and immunities
+ * granted to it by virtue of its status as an intergovernmental organisation
+ * nor does it submit to any jurisdiction.
+ */
+
+INTERFACE
+SUBROUTINE EC_MEMINFO(KU,CDSTRING,KCOMM,KBARR,KIOTASK,KCALL)
+USE PARKIND1, ONLY : JPIM
+INTEGER(KIND=JPIM), INTENT(IN) :: KU,KCOMM,KBARR,KIOTASK,KCALL
+CHARACTER(LEN=*), INTENT(IN) :: CDSTRING
+END SUBROUTINE EC_MEMINFO
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/ec_mpi_finalize.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/ec_mpi_finalize.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/ec_mpi_finalize.intfb.h	(revision 3908)
@@ -0,0 +1,20 @@
+/**
+ * (C) Copyright 2014- ECMWF.
+ *
+ * This software is licensed under the terms of the Apache Licence Version 2.0
+ * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+ *
+ * In applying this licence, ECMWF does not waive the privileges and immunities
+ * granted to it by virtue of its status as an intergovernmental organisation
+ * nor does it submit to any jurisdiction.
+ */
+
+INTERFACE
+SUBROUTINE EC_MPI_FINALIZE(KERROR,LDCALLFINITO,LDMEMINFO,CALLER)
+USE PARKIND1, ONLY : JPIM
+INTEGER(KIND=JPIM), INTENT(OUT) :: KERROR
+LOGICAL, INTENT(IN) :: LDCALLFINITO
+LOGICAL, INTENT(IN) :: LDMEMINFO
+CHARACTER(LEN=*), INTENT(IN) :: CALLER
+END SUBROUTINE EC_MPI_FINALIZE
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/ec_pmon.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/ec_pmon.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/ec_pmon.intfb.h	(revision 3908)
@@ -0,0 +1,17 @@
+/**
+ * (C) Copyright 2014- ECMWF.
+ *
+ * This software is licensed under the terms of the Apache Licence Version 2.0
+ * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+ *
+ * In applying this licence, ECMWF does not waive the privileges and immunities
+ * granted to it by virtue of its status as an intergovernmental organisation
+ * nor does it submit to any jurisdiction.
+ */
+
+INTERFACE
+SUBROUTINE EC_PMON(ENERGY,POWER)
+USE PARKIND1, ONLY : JPIB
+INTEGER(KIND=JPIB),INTENT(OUT) :: ENERGY,POWER
+END SUBROUTINE EC_PMON
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/ecsort_shared.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/ecsort_shared.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/ecsort_shared.h	(revision 3908)
@@ -0,0 +1,692 @@
+/**
+ * (C) Copyright 2014- ECMWF.
+ *
+ * This software is licensed under the terms of the Apache Licence Version 2.0
+ * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+ *
+ * In applying this licence, ECMWF does not waive the privileges and immunities
+ * granted to it by virtue of its status as an intergovernmental organisation
+ * nor does it submit to any jurisdiction.
+ */
+
+!*** ecsort_shared.h ***
+
+#if INT_VERSION == 4
+
+#define DATA_TYPE            INTEGER(KIND=JPIM)
+#define SIZEOF_ME            sizeof_int4
+#define KEYSORT_1D           INT4_KEYSORT_1D
+#define KEYSORT_1D_DRHOOKSTR 'ECSORT_MIX:INT4_KEYSORT_1D'
+#define KEYSORT_2D           INT4_KEYSORT_2D
+#define KEYSORT_2D_DRHOOKSTR 'ECSORT_MIX:INT4_KEYSORT_2D'
+#define KEYSORT_NUMBER       11
+#define RSORT_DRHOOKSTR      'ECSORT_MIX:RSORT32_FUNC_11'
+#define USE_RSORT64          0
+#define HEAPSORT             INT4_HEAPSORT
+#define HEAPSORT_DRHOOKSTR   'ECSORT_MIX:INT4_HEAPSORT'
+#define DBGPRINT             INT4_DBGPRINT
+#define DBGFMTNUM            1011
+#define ECQSORT_DRHOOKSTR    'ECSORT_MIX:INT4_ECQSORT'
+#define COUNT_DRHOOKSTR      'ECSORT_MIX:INT4_COUNT'
+#define GNOME_DRHOOKSTR      'ECSORT_MIX:INT4_GNOME'
+
+#elif REAL_VERSION == 8
+
+#define DATA_TYPE            REAL(KIND=JPRD)
+#define SIZEOF_ME            sizeof_real8
+#define KEYSORT_1D           REAL8_KEYSORT_1D
+#define KEYSORT_1D_DRHOOKSTR 'ECSORT_MIX:REAL8_KEYSORT_1D'
+#define KEYSORT_2D           REAL8_KEYSORT_2D
+#define KEYSORT_2D_DRHOOKSTR 'ECSORT_MIX:REAL8_KEYSORT_2D'
+#define KEYSORT_NUMBER       12
+#define RSORT_DRHOOKSTR      'ECSORT_MIX:RSORT64_12'
+#define USE_RSORT64          1
+#define HEAPSORT             REAL8_HEAPSORT
+#define HEAPSORT_DRHOOKSTR   'ECSORT_MIX:REAL8_HEAPSORT'
+#define DBGPRINT             REAL8_DBGPRINT
+#define DBGFMTNUM            1012
+#define ECQSORT_DRHOOKSTR    'ECSORT_MIX:REAL8_ECQSORT'
+#define COUNT_DRHOOKSTR      'ECSORT_MIX:REAL8_COUNT'
+#define GNOME_DRHOOKSTR      'ECSORT_MIX:REAL8_GNOME'
+
+#elif REAL_VERSION == 4
+
+#define DATA_TYPE            REAL(KIND=JPRM)
+#define SIZEOF_ME            sizeof_real4
+#define KEYSORT_1D           REAL4_KEYSORT_1D
+#define KEYSORT_1D_DRHOOKSTR 'ECSORT_MIX:REAL4_KEYSORT_1D'
+#define KEYSORT_2D           REAL4_KEYSORT_2D
+#define KEYSORT_2D_DRHOOKSTR 'ECSORT_MIX:REAL4_KEYSORT_2D'
+#define KEYSORT_NUMBER       13
+#define RSORT_DRHOOKSTR      'ECSORT_MIX:RSORT32_FUNC_13'
+#define USE_RSORT64          0
+#define HEAPSORT             REAL4_HEAPSORT
+#define HEAPSORT_DRHOOKSTR   'ECSORT_MIX:REAL4_HEAPSORT'
+#define DBGPRINT             REAL4_DBGPRINT
+#define DBGFMTNUM            1013
+#define ECQSORT_DRHOOKSTR    'ECSORT_MIX:REAL4_ECQSORT'
+#define COUNT_DRHOOKSTR      'ECSORT_MIX:REAL4_COUNT'
+#define GNOME_DRHOOKSTR      'ECSORT_MIX:REAL4_GNOME'
+
+#elif INT_VERSION == 8
+
+#define DATA_TYPE            INTEGER(KIND=JPIB)
+#define SIZEOF_ME            sizeof_int8
+#define KEYSORT_1D           INT8_KEYSORT_1D
+#define KEYSORT_1D_DRHOOKSTR 'ECSORT_MIX:INT8_KEYSORT_1D'
+#define KEYSORT_2D           INT8_KEYSORT_2D
+#define KEYSORT_2D_DRHOOKSTR 'ECSORT_MIX:INT8_KEYSORT_2D'
+#define KEYSORT_NUMBER       14
+#define RSORT_DRHOOKSTR      'ECSORT_MIX:RSORT64_14'
+#define USE_RSORT64          1
+#define HEAPSORT             INT8_HEAPSORT
+#define HEAPSORT_DRHOOKSTR   'ECSORT_MIX:INT8_HEAPSORT'
+#define DBGPRINT             INT8_DBGPRINT
+#define DBGFMTNUM            1014
+#define ECQSORT_DRHOOKSTR    'ECSORT_MIX:INT8_ECQSORT'
+#define COUNT_DRHOOKSTR      'ECSORT_MIX:INT8_COUNT'
+#define GNOME_DRHOOKSTR      'ECSORT_MIX:INT8_GNOME'
+
+#else
+
+  ERROR in programming : No datatype given (should never have ended up here)
+
+#endif
+
+!----------------------------
+!--   Public subroutines   --
+!----------------------------
+
+
+SUBROUTINE KEYSORT_1D(rc, a, n, method, descending, index, init)
+!-- Please note that we assume that a(:) occupies consecutive memory locations
+INTEGER(KIND=JPIM), intent(out)           :: rc
+DATA_TYPE         , intent(inout)         :: a(:)
+INTEGER(KIND=JPIM), intent(in)            :: n
+INTEGER(KIND=JPIM), intent(in), OPTIONAL  :: method
+logical, intent(in), OPTIONAL  :: descending
+INTEGER(KIND=JPIM), intent(inout), TARGET, OPTIONAL :: index(:)
+logical, intent(in), OPTIONAL  :: init
+! === END OF INTERFACE BLOCK ===
+DATA_TYPE          , allocatable :: aa(:,:)
+INTEGER(KIND=JPIM) :: imethod, irev, idummy, index_adj
+logical :: LLfast, LLdescending, LLomp_okay, LLinit
+INTEGER(KIND=JPIM) :: ITID, ichunk, iret, inumt
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+IF (LHOOK) CALL DR_HOOK(KEYSORT_1D_DRHOOKSTR,0,ZHOOK_HANDLE)
+
+rc = 0
+if (n <= 0 .or. size(a) <= 0) goto 99
+
+if (present(descending)) then
+  LLdescending = descending
+else
+  LLdescending = .FALSE.
+endif
+
+irev = 0
+if (LLdescending) irev = 1
+
+ITID = OML_MY_THREAD()
+imethod = current_method(ITID)
+if (present(method)) then
+  imethod = min(max(min_method,method),max_method)
+endif
+
+if (imethod /= quicksort_method .and. &
+   &imethod /= countingsort_method) then
+  LLfast = .FALSE.
+else if (imethod == quicksort_method) then
+  !-- hasn't been implemented if index is present ;-(
+  LLfast = (&
+       & .not.present(index) .and. &
+       & .not.present(init))
+else if (imethod == countingsort_method) then
+  !-- index-presence is ok
+  LLfast = .TRUE.
+endif
+
+if (LLfast) then
+  !- Only Quick-sort & CountingSort covered
+
+  if (imethod == quicksort_method) then
+    inumt = OML_MAX_THREADS()
+    LLomp_okay = (inumt > 1 .and. nomp >= inumt .and. n >= nomp)
+    LLomp_okay = (LLomp_okay .and. .not. OML_IN_PARALLEL()) ! Prevents nested OpenMP
+    if (LLomp_okay) then
+      !-- Max 2-way OpenMP parallelism for now ...
+      ichunk = n/2
+!$OMP PARALLEL PRIVATE(iret)
+!$OMP SECTIONS
+!$OMP SECTION
+      CALL ecqsortfast(KEYSORT_NUMBER, ichunk, a(1), irev, iret)
+!$OMP SECTION
+      CALL ecqsortfast(KEYSORT_NUMBER, n-ichunk, a(ichunk+1), irev, iret)
+!$OMP END SECTIONS
+!$OMP END PARALLEL
+      CALL ecmerge2(KEYSORT_NUMBER, 1, ichunk, n-ichunk, a(1), &
+           & idummy, 0, 1, irev, idummy, rc)
+    else
+      CALL ecqsortfast(KEYSORT_NUMBER, n, a(1), irev, rc)
+    endif
+    GOTO 99
+
+  else if (imethod == countingsort_method) then
+    if (.not.present(index)) then
+      CALL ec_countingsort(KEYSORT_NUMBER, n, 1, 1, a(1), idummy, 0, 1, irev, rc)
+    else
+      LLinit = .FALSE.
+      if (present(init)) LLinit = init
+      if (LLinit) then
+        CALL init_index(index, index_adj=-1)
+        index_adj = 0
+      else
+        index_adj = 1
+      endif
+      CALL ec_countingsort(KEYSORT_NUMBER, n, 1, 1, a(1), index(1), size(index), index_adj, irev, rc)
+      if (index_adj == 0) CALL adjust_index(index, +1)
+    endif
+    GOTO 99
+
+  else
+    LLfast = .false.
+  endif
+endif
+
+!-- LLfast == .FALSE. :
+
+allocate(aa(n,1))
+
+if (LLdescending) then
+  aa(1:n,1) = -a(1:n)
+else
+  aa(1:n,1) = a(1:n)
+endif
+
+CALL keysort(rc, aa, n, method=method, index=index, init=init)
+
+if (LLdescending) then
+  a(1:n) = -aa(1:n,1)
+else
+  a(1:n) = aa(1:n,1)
+endif
+
+deallocate(aa)
+
+99 continue
+IF (LHOOK) CALL DR_HOOK(KEYSORT_1D_DRHOOKSTR,1,ZHOOK_HANDLE,n)
+END SUBROUTINE
+
+
+SUBROUTINE KEYSORT_2D(&
+     &rc, a, n,&
+     &key, multikey, method,&
+     &index, init, transposed)
+
+INTEGER(KIND=JPIM), intent(out)           :: rc
+DATA_TYPE         , intent(inout)         :: a(:,:)
+INTEGER(KIND=JPIM), intent(in)            :: n
+INTEGER(KIND=JPIM), intent(in), OPTIONAL  :: key, method
+INTEGER(KIND=JPIM), intent(in), OPTIONAL  :: multikey(:)
+logical, intent(in), OPTIONAL  :: transposed
+INTEGER(KIND=JPIM), intent(inout), TARGET, OPTIONAL :: index(:)
+logical, intent(in), OPTIONAL  :: init
+! === END OF INTERFACE BLOCK ===
+INTEGER(KIND=JPIM), POINTER :: iindex(:)
+INTEGER(KIND=JPIM) :: ikey, istride, imethod, inumkeys, imethod_1st, imethod_rest
+INTEGER(KIND=JPIM) :: lda, iptr, i, j, sda, idiff, irev, inumt, jkey, jj, ilastkey
+INTEGER(KIND=JPIM) :: j1, j2, jmid, inum, imax, iadd, imod, iret, inc, iamax, ibmax
+DATA_TYPE         , allocatable :: data(:)
+INTEGER(KIND=JPIM), allocatable :: ikeys(:), ista(:), ichunk(:), irank(:)
+logical LLinit, LLdescending, LLtrans, LLomp_okay, LLadjusted, LLdebug, LLomp_prefix
+character(len=1) clenv
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_SUBHANDLE
+REAL(KIND=JPRB) :: ZHOOK_SUBHANDLE0
+REAL(KIND=JPRB) :: ZHOOK_SUBHANDLE1
+REAL(KIND=JPRB) :: ZHOOK_SUBHANDLE2
+REAL(KIND=JPRB) :: ZHOOK_SUBHANDLE3
+INTEGER(KIND=JPIM) :: ITID
+
+IF (LHOOK) CALL DR_HOOK(KEYSORT_2D_DRHOOKSTR,0,ZHOOK_HANDLE)
+
+rc = 0
+lda = size(a, dim=1)
+sda = size(a, dim=2)
+if (n <= 0 .or. lda <= 0 .or. sda <= 0) goto 99
+
+inumt = OML_MAX_THREADS()
+ITID = OML_MY_THREAD()
+imethod = current_method(ITID)
+if (present(method)) then
+  imethod = min(max(min_method,method),max_method)
+endif
+imethod_1st = imethod
+imethod_rest = imethod
+
+ikey = 1
+if (present(key)) ikey = key
+
+if (present(multikey)) then
+  allocate(ikeys(size(multikey)))
+  ikeys(:) = multikey(:)
+else
+  allocate(ikeys(1))
+  ikeys(1) = ikey
+endif
+inumkeys = size(ikeys)
+
+!-- Only the RADIX-sort & now also QUICK-sort & CountingSort give the result we want with multiple keys
+if (inumkeys > 1 .and. &
+    imethod /= radixsort_method .and. &
+    imethod /= quicksort_method .and. &
+    imethod /= countingsort_method) then
+   imethod = default_method
+   imethod_1st = imethod
+   imethod_rest = imethod
+   !-- Since "default_method" may now be [overridden as] HEAP-sort, make sure its then "radixsort_method"
+   !   Note: The first sweep may still be e.g. HEAP-sort
+   if (imethod /= radixsort_method .and. &
+       imethod /= quicksort_method .and. &
+       imethod /= countingsort_method) then
+     imethod = radixsort_method
+     imethod_rest = imethod
+   endif
+endif
+
+LLinit = .FALSE.
+if (present(init)) LLinit = init
+
+if (present(index)) then
+  iindex => index(1:n)
+else
+  allocate(iindex(n))
+  LLinit = .TRUE.
+endif
+
+if (LLinit) CALL init_index(iindex)
+
+istride = 1
+LLtrans = .FALSE.
+if (present(transposed)) LLtrans = transposed
+if (LLtrans) then
+  istride = lda
+else if (sda >= 2 .and. lda >= 1) then
+!-- Check for presence of sub-array and adjust lda automatically
+  call addrdiff(a(1,1),a(1,2),idiff)
+  ! lda below: The true leading dimension; overrides sub-arrays one
+  lda = idiff/SIZEOF_ME
+endif
+
+ilastkey = 0
+LLadjusted = .FALSE.
+LLomp_prefix = .FALSE.
+!$ LLomp_prefix = (istride == 1 .and. nomp >= inumt .and. n >= nomp)
+if (LLomp_prefix) then
+  call get_environment_variable('EC_SORTING_DEBUG',clenv)
+  LLdebug = (clenv == '1' .and. n < 10000)
+  if (LLdebug) write(0,*)'>> EC_SORTING_DEBUG=1'
+else
+  LLdebug = .FALSE.
+endif
+
+1000 format(1x,a,2i12,:,/,(10i5))
+1001 format(1x,'[#',i2,']:',a,(10i5))
+1002 format(1x,'[#',i2,']:',a,:,/,(10i5))
+1003 format(1x,'[#',i2,']:',a,2i12,:,/,(10i5))
+1004 format(1x,a,:,(10i5))
+1005 format(1x,a,i2,1x,a)
+
+imethod = imethod_1st
+KEYLOOP: do jkey=inumkeys,1,-1
+!--   Sort by the least significant key first
+  ikey = abs(ikeys(jkey))
+  if (ikey == 0) cycle KEYLOOP
+
+  if (istride == 1) then
+    iptr = lda * (ikey - 1) + 1
+  else
+    iptr = ikey
+  endif
+
+  if (LLdebug) then
+    write(0,1000) '<BEGIN>iindex(1:n)=',n,sum(iindex(1:n)),iindex(1:n)
+    if (LLadjusted) then
+      CALL DBGPRINT(-jkey,'<BEGIN>',a,iindex,n,ikey,1,n,1)
+    else
+      CALL DBGPRINT(-jkey,'<BEGIN>',a,iindex,n,ikey,1,n,0)
+    endif
+    ilastkey = ikey
+  endif
+
+  LLdescending = (ikeys(jkey) < 0)
+  irev = 0
+  if (LLdescending) irev = 1
+
+  !-- Since "irev" is passed into the ecqsort, no explicit reversing is needed --> savings
+  if (imethod == quicksort_method .or. &
+      imethod == countingsort_method) LLdescending = .FALSE.
+
+  if (LLdescending) then
+    if (istride == 1) then
+      a(1:n,ikey) = -a(1:n,ikey)
+    else
+      a(ikey,1:n) = -a(ikey,1:n)
+    endif
+    irev = 0 ! prevents use of "reverse" algorithm in ecmerge2 for radix-sort
+  endif
+
+  LLomp_okay = LLomp_prefix .and. (inumt > 1) .and. (&
+       & imethod == radixsort_method .or. &
+       & imethod == quicksort_method .or. &
+       & imethod == countingsort_method)
+  LLomp_okay = LLomp_okay .and. (.not. OML_IN_PARALLEL()) ! Prevents nested OpenMP
+
+  if (.not.LLomp_okay) then
+    select case (imethod)
+    case (radixsort_method)
+      IF (LHOOK) CALL DR_HOOK(RSORT_DRHOOKSTR,0,ZHOOK_SUBHANDLE0)
+#if USE_RSORT64 == 1
+      CALL rsort64(KEYSORT_NUMBER, n, istride, iptr, a(1,1), iindex(1), 1, rc)
+#else
+      CALL rsort32_func(KEYSORT_NUMBER, n, istride, iptr, a(1,1), iindex(1), 1, rc)
+#endif
+      IF (LHOOK) CALL DR_HOOK(RSORT_DRHOOKSTR,1,ZHOOK_SUBHANDLE0, n)
+    case (heapsort_method)
+      if (istride == 1) then
+        CALL HEAPSORT(KEYSORT_NUMBER, n, a(1:n, ikey), rc, irev, istride, iindex)
+      else
+        CALL HEAPSORT(KEYSORT_NUMBER, n, a(ikey, 1:n), rc, irev, istride, iindex)
+      endif
+    case (quicksort_method)
+      IF (LHOOK) CALL DR_HOOK(ECQSORT_DRHOOKSTR,0,ZHOOK_SUBHANDLE0)
+      CALL ecqsort(KEYSORT_NUMBER, n, istride, iptr, a(1,1), iindex(1), 1, irev, rc)
+      IF (LHOOK) CALL DR_HOOK(ECQSORT_DRHOOKSTR,1,ZHOOK_SUBHANDLE0,n)
+    case (countingsort_method)
+      IF (LHOOK) CALL DR_HOOK(COUNT_DRHOOKSTR,0,ZHOOK_SUBHANDLE0)
+      CALL ec_countingsort(KEYSORT_NUMBER, n, istride, iptr, a(1,1), iindex(1), n, 1, irev, rc)
+      IF (LHOOK) CALL DR_HOOK(COUNT_DRHOOKSTR,1,ZHOOK_SUBHANDLE0,n)
+    case (gnomesort_method)
+      IF (LHOOK) CALL DR_HOOK(GNOME_DRHOOKSTR,0,ZHOOK_SUBHANDLE0)
+      CALL ecgnomesort(KEYSORT_NUMBER, n, istride, iptr, a(1,1), iindex(1), n, 1, rc)
+      IF (LHOOK) CALL DR_HOOK(GNOME_DRHOOKSTR,1,ZHOOK_SUBHANDLE0,n)
+    end select
+
+  else ! i.e. LLomp_okay ; radix, quick & counting -sorts only
+    if (.not.allocated(ista)) then
+      allocate(ista(inumt+1),ichunk(inumt))
+      inc = n/inumt
+      iadd = 1
+      imod = mod(n,inumt)
+      if (imod == 0) iadd = 0
+      ista(1) = 1
+      do j=2,inumt
+        ista(j) = ista(j-1) + inc + iadd
+        if (iadd > 0 .and. j > imod) iadd = 0
+      enddo
+      ista(inumt+1) = n + 1
+      do j=1,inumt
+        ichunk(j) = ista(j+1) - ista(j)
+      enddo
+      if (LLdebug) then
+        write(0,1005) '>> imethod,name=',imethod,method_name(imethod)
+        write(0,1004) '>> inumt,n,nomp=',inumt,n,nomp
+        write(0,1004) '>> ista(1:inumt+1)=',ista(1:inumt+1)
+        write(0,1004) '>> ichunk(1:inumt)=',ichunk(1:inumt)
+      endif
+      allocate(irank(n))
+    endif
+
+    if (LLdebug) write(0,1004) '>>KEYLOOP: jkey,ikey,irev,iptr=',jkey,ikey,irev,iptr
+
+    if (.not.LLadjusted) then ! only once
+      if (LLdebug) write(0,1000) '<1>iindex(1:n)=',n,sum(iindex(1:n)),iindex(1:n)
+      call adjust_index(iindex, -1) ! Fortran -> C
+      if (LLdebug) write(0,1000) '<2>iindex(1:n)=',n,sum(iindex(1:n))+n,iindex(1:n)
+      LLadjusted = .TRUE.
+    endif
+
+    if (LLdebug) write(0,*)'>> Sorting inumt-chunks in parallel'
+!$OMP PARALLEL PRIVATE(j,j1,j2,inum,iret,inc,ITID,ZHOOK_SUBHANDLE1,ZHOOK_SUBHANDLE2)
+    IF (LHOOK) CALL DR_HOOK('ECSORT_MIX:KEYSORT_2D>OMPSORT',0,ZHOOK_SUBHANDLE1)
+    ITID = OML_MY_THREAD()
+!$OMP DO SCHEDULE(DYNAMIC,1)
+    do j=1,inumt
+      j1 = ista(j)
+      inum = ichunk(j)
+      j2 = j1 + inum - 1
+      inc = j1
+      if (LLdebug) write(0,1001) ITID,'j,j1,j2,inum,inc=',j,j1,j2,inum,inc
+      if (LLdebug) write(0,1002) ITID,'iindex(j1:j2) > ',iindex(j1:j2)
+      select case (imethod)
+      case (radixsort_method)
+        IF (LHOOK) CALL DR_HOOK(RSORT_DRHOOKSTR,0,ZHOOK_SUBHANDLE2)
+#if USE_RSORT64 == 1
+        CALL rsort64(KEYSORT_NUMBER, inum, istride, iptr, a(1,1), iindex(j1), 0, iret)
+#else
+        CALL rsort32_func(KEYSORT_NUMBER, inum, istride, iptr, a(1,1), iindex(j1), 0, iret)
+#endif
+        IF (LHOOK) CALL DR_HOOK(RSORT_DRHOOKSTR,1,ZHOOK_SUBHANDLE2, inum)
+      case (quicksort_method)
+        IF (LHOOK) CALL DR_HOOK(ECQSORT_DRHOOKSTR,0,ZHOOK_SUBHANDLE2)
+        CALL ecqsort(KEYSORT_NUMBER, inum, istride, iptr, a(1,1), iindex(j1), 0, irev, iret)
+        IF (LHOOK) CALL DR_HOOK(ECQSORT_DRHOOKSTR,1,ZHOOK_SUBHANDLE2,inum)
+      case (countingsort_method)
+        IF (LHOOK) CALL DR_HOOK(COUNT_DRHOOKSTR,0,ZHOOK_SUBHANDLE2)
+        CALL ec_countingsort(KEYSORT_NUMBER, inum, istride, iptr, a(1,1), iindex(j1), inum, 0, irev, iret)
+        IF (LHOOK) CALL DR_HOOK(COUNT_DRHOOKSTR,1,ZHOOK_SUBHANDLE2,inum)
+      end select
+      if (LLdebug) write(0,1002) ITID,'iindex(j1:j2) < ',iindex(j1:j2)
+    enddo
+!$OMP END DO
+    IF (LHOOK) CALL DR_HOOK('ECSORT_MIX:KEYSORT_2D>OMPSORT',1,ZHOOK_SUBHANDLE1)
+!$OMP END PARALLEL
+
+    if (LLdebug) write(0,1000) '<after_sort>iindex(1:n)=',n,sum(iindex(1:n))+n,iindex(1:n)
+    if (LLdebug) CALL DBGPRINT(0,'<after_sort>',a,iindex,n,ikey,1,n,1)
+    CALL get_rank(iindex, irank, index_adj=+1)
+
+    if (LLdebug) write(0,*) '>> Merge neighbouring chunks in parallel as much as possible'
+    inc = 2
+    imax = (inumt+inc-1)/inc
+    do jj=1,imax
+      if (LLdebug) write(0,1001) jj,'<before_merge> jj,inc,imax,inumt=',jj,inc,imax,inumt
+!$OMP PARALLEL PRIVATE(j,j1,j2,inum,iamax,ibmax,jmid,iret,ZHOOK_SUBHANDLE3,ITID)
+      IF (LHOOK) CALL DR_HOOK('ECSORT_MIX:KEYSORT_2D>OMPMERGE',0,ZHOOK_SUBHANDLE3)
+      ITID = OML_MY_THREAD()
+!$OMP DO SCHEDULE(DYNAMIC,1)
+      do j=1,inumt,inc
+        j1 = j
+        j2 = j + inc - 1
+        jmid = (j1 + j2)/2 + 1
+        j2 = min(j2,inumt)
+        jmid = min(jmid,inumt)
+        if (LLdebug) write(0,1001) ITID,'j,j1,j2,jmid=',j,j1,j2,jmid
+        iamax = ista(jmid) - ista(j1)
+        inum = sum(ichunk(j1:j2))
+        ibmax = inum - iamax
+        if (LLdebug) write(0,1001) ITID,'j,iamax,ibmax,inum=',j,iamax,ibmax,inum
+        if (iamax == 0 .or. ibmax == 0 .or. inum == 0) cycle
+        j1 = ista(j1)
+        j2 = ista(j2+1) - 1
+        if (LLdebug) write(0,1001) ITID,'j,j1,j2,inum=',j,j1,j2,inum
+        if (LLdebug) write(0,1002) ITID,'iindex(j1:j2) > ',iindex(j1:j2)
+        call ecmerge2(KEYSORT_NUMBER, iptr, iamax, ibmax, a(1,1), &
+             & iindex(j1), inum, 0, irev, irank(1), iret)
+        if (LLdebug) write(0,1002) ITID,'iindex(j1:j2) < ',iindex(j1:j2)
+      enddo ! do j=1,inumt,inc
+!$OMP END DO
+      IF (LHOOK) CALL DR_HOOK('ECSORT_MIX:KEYSORT_2D>OMPMERGE',1,ZHOOK_SUBHANDLE3)
+!$OMP END PARALLEL
+
+      if (LLdebug) write(0,1003) jj,'<after_merge>iindex(1:n)=',n,sum(iindex(1:n))+n,iindex(1:n)
+      if (LLdebug) CALL DBGPRINT(jj,'<after_merge>',a,iindex,n,ikey,1,n,1)
+
+      inc = inc * 2
+    enddo ! do jj=1,imax
+    rc = n
+  endif ! if (LLomp_okay)
+
+  if (LLdescending) then
+    if (istride == 1) then
+      a(1:n,ikey) = -a(1:n,ikey)
+    else
+      a(ikey,1:n) = -a(ikey,1:n)
+    endif
+  endif
+
+  if (LLadjusted .and. imethod /= imethod_rest) then ! Restore back immediately
+    if (LLdebug) write(0,1000) '<3a>iindex(1:n)=',n,sum(iindex(1:n))+n,iindex(1:n)
+    call adjust_index(iindex, +1) ! C -> Fortran
+    if (LLdebug) write(0,1000) '<4a>iindex(1:n)=',n,sum(iindex(1:n)),iindex(1:n)
+    LLadjusted = .FALSE.
+  endif
+
+  imethod = imethod_rest
+enddo KEYLOOP
+
+deallocate(ikeys)
+if (allocated(ista)) deallocate(ista)
+if (allocated(ichunk)) deallocate(ichunk)
+if (allocated(irank)) deallocate(irank)
+
+if (LLadjusted) then ! Restore back
+  if (LLdebug) write(0,1000) '<3b>iindex(1:n)=',n,sum(iindex(1:n))+n,iindex(1:n)
+  call adjust_index(iindex, +1) ! C -> Fortran
+  if (LLdebug) write(0,1000) '<4b>iindex(1:n)=',n,sum(iindex(1:n)),iindex(1:n)
+  LLadjusted = .FALSE.
+endif
+
+if (LLdebug) write(0,1000) '<END>iindex(1:n)=',n,sum(iindex(1:n)),iindex(1:n)
+if (LLdebug) CALL DBGPRINT(0,'<END>',a,iindex,n,ilastkey,1,n,0)
+
+if (.not.present(index)) then
+  LLomp_okay = (nomp >= inumt .and. n >= nomp)
+  if (istride == 1) then
+    LLomp_okay = (LLomp_okay .and. sda >= inumt .and. .not. OML_IN_PARALLEL()) ! Prevents nested OpenMP
+!$OMP PARALLEL PRIVATE(j,data) IF (LLomp_okay)
+    allocate(data(n))
+!$OMP DO SCHEDULE(DYNAMIC,1)
+    do j=1,sda
+      data(1:n) = a(iindex(1:n),j)
+      a(1:n,j) = data(1:n)
+    enddo
+!$OMP END DO
+    deallocate(data)
+!$OMP END PARALLEL
+  else
+    LLomp_okay = (LLomp_okay .and. lda >= inumt .and. .not. OML_IN_PARALLEL()) ! Prevents nested OpenMP
+!$OMP PARALLEL PRIVATE(i,data) IF (LLomp_okay)
+    allocate(data(n))
+!$OMP DO SCHEDULE(DYNAMIC,1)
+    do i=1,lda
+      data(1:n) = a(i,iindex(1:n))
+      a(i,1:n) = data(1:n)
+    enddo
+!$OMP END DO
+    deallocate(data)
+!$OMP END PARALLEL
+  endif
+
+  deallocate(iindex)
+endif
+
+99 continue
+IF (LHOOK) CALL DR_HOOK(KEYSORT_2D_DRHOOKSTR,1,ZHOOK_HANDLE,n*inumkeys)
+END SUBROUTINE
+
+!-----------------------------
+!--   Private subroutines   --
+!-----------------------------
+
+SUBROUTINE DBGPRINT(jj, cdstr, a, index, n, key, k1, k2, kadd)
+character(len=*), intent(in) :: cdstr
+INTEGER(KIND=JPIM), intent(in) :: jj, n, key, k1, k2, kadd
+INTEGER(KIND=JPIM), intent(in) :: index(:)
+DATA_TYPE, intent(in) :: a(:,:)
+INTEGER(KIND=JPIM) :: i,j
+1000 FORMAT(i3,a,5i5)
+1011 FORMAT((5i12)) ! integer*4
+1012 FORMAT(1p,(5g20.12)) ! real*8
+1013 FORMAT(1p,(5g20.12)) ! real*4
+1014 FORMAT((5i12)) ! integer*8
+WRITE(0,1000) jj,cdstr//': n,key,k1,k2,kadd,a(index(k1:k2)+kadd,:)=',&
+     &                     n,key,k1,k2,kadd
+do j=k1,k2
+  i = index(j)+kadd
+  WRITE(0,'(2i6)',advance='no') j,i-kadd
+  WRITE(0,DBGFMTNUM) a(i,:)
+enddo
+END SUBROUTINE
+
+SUBROUTINE HEAPSORT(id, n, a, rc, irev, istride, index)
+INTEGER(KIND=JPIM), intent(in) :: id, n, irev, istride
+DATA_TYPE, intent(in) :: a(:)
+INTEGER(KIND=JPIM), intent(out) :: rc
+INTEGER(KIND=JPIM), intent(inout) :: index(:)
+INTEGER(KIND=JPIM) :: i,j,right,left,idx
+DATA_TYPE :: tmp
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK(HEAPSORT_DRHOOKSTR,0,ZHOOK_HANDLE)
+rc = 0
+if (n <= 0 .or. size(a) <= 0) goto 99
+left  = n/2+1
+right = n
+LOOP: do
+  if (left > 1) then
+    left = left - 1
+    idx  = index(left)
+  else
+    idx = index(right)
+    index(right) = index(1)
+    right = right - 1
+    if (right == 1) then
+      index(1) = idx
+      exit LOOP
+    endif
+  endif
+  tmp = a(idx)
+  i = left
+  j = 2*left
+  do while (j <= right)
+    if (j < right) then
+      if (a(index(j)) < a(index(j+1))) j = j + 1
+    endif
+    if (tmp < a(index(j))) then
+      index(i) = index(j)
+      i = j
+      j = 2*j
+    else
+      j = right + 1
+    endif
+  enddo
+  index(i) = idx
+enddo LOOP
+rc = n
+99 continue
+IF (LHOOK) CALL DR_HOOK(HEAPSORT_DRHOOKSTR,1,ZHOOK_HANDLE)
+END SUBROUTINE
+
+
+
+#ifndef NO_UNDEF
+
+#undef DATA_TYPE
+#undef SIZEOF_ME
+#undef KEYSORT_1D
+#undef KEYSORT_1D_DRHOOKSTR
+#undef KEYSORT_2D
+#undef KEYSORT_2D_DRHOOKSTR
+#undef KEYSORT_NUMBER
+#undef RSORT_DRHOOKSTR
+#undef USE_RSORT64
+#undef QSORTFAST_DRHOOKSTR
+#undef HEAPSORT
+#undef HEAPSORT_DRHOOKSTR
+#undef DBGPRINT
+#undef DBGFMTNUM
+#undef ECQSORT_DRHOOKSTR
+#undef COUNT_DRHOOKSTR
+#undef GNOME_DRHOOKSTR
+
+#endif
Index: LMDZ6/trunk/libf/phylmd/ecrad/getstatm.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/getstatm.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/getstatm.h	(revision 3908)
@@ -0,0 +1,39 @@
+/**
+ * (C) Copyright 2014- ECMWF.
+ *
+ * This software is licensed under the terms of the Apache Licence Version 2.0
+ * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+ *
+ * In applying this licence, ECMWF does not waive the privileges and immunities
+ * granted to it by virtue of its status as an intergovernmental organisation
+ * nor does it submit to any jurisdiction.
+ */
+
+
+/* statm format: (/proc/self/mem under LINUX)
+
+   in units of pages (4096 bytes)
+
+size       total program size
+resident   size of in memory portions
+shared     number of the pages that are shared
+trs        number of pages that are 'code'
+drs        number of pages of data/stack
+lrs        number of pages of library
+dt         number of dirty pages
+
+*/
+
+struct statm
+{
+    int size;
+    int resident;
+    int shared;
+    int trs;
+    int drs;
+    int lrs;
+    int dt;
+};
+
+extern int getstatm(struct statm *sm);
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/intercept_alloc.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/intercept_alloc.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/intercept_alloc.h	(revision 3908)
@@ -0,0 +1,61 @@
+/**
+ * (C) Copyright 2014- ECMWF.
+ *
+ * This software is licensed under the terms of the Apache Licence Version 2.0
+ * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+ *
+ * In applying this licence, ECMWF does not waive the privileges and immunities
+ * granted to it by virtue of its status as an intergovernmental organisation
+ * nor does it submit to any jurisdiction.
+ */
+
+#ifndef _INTERCEPT_ALLOC_H_
+#define _INTERCEPT_ALLOC_H_
+
+/* intercept_alloc.h */
+
+#if defined(INTERCEPT_ALLOC)
+
+#if defined(RS6K) && defined(__64BIT__)
+
+#define EC_free     __free
+#define EC_malloc   __malloc
+#define EC_calloc   __calloc
+#define EC_realloc  __realloc
+#define EC_strdup   __strdup
+
+#elif defined(NECSX)
+/* Do nothing */
+#else
+/* Illegal to have -DINTERCEPT_ALLOC */
+#undef INTERCEPT_ALLOC
+#endif
+
+#endif
+
+#if defined(INTERCEPT_ALLOC)
+
+/* For reference, see also ifsaux/utilities/getcurheap.c */
+
+#define THEmalloc  EC_malloc
+extern void *EC_malloc(long long int size);
+#define THEcalloc  EC_calloc
+extern void *EC_calloc(long long int nelem, long long int elsize);
+#define THErealloc EC_realloc
+extern void *EC_realloc(void *p, long long int size);
+#define THEstrdup  EC_strdup
+extern char *EC_strdup(const char *s);
+#define THEfree    EC_free
+extern void EC_free(void *p);
+
+#else /* i.e. !defined(INTERCEPT_ALLOC) */
+
+#define THEmalloc  malloc
+#define THEcalloc  calloc
+#define THErealloc realloc
+#define THEstrdup  strdup
+#define THEfree    free
+
+#endif
+
+#endif /* _INTERCEPT_ALLOC_H_ */
Index: LMDZ6/trunk/libf/phylmd/ecrad/listing_history
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/listing_history	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/listing_history	(revision 3908)
@@ -0,0 +1,1000 @@
+   36  echo $MPI_HOME
+   37  ls
+   38  cat arch-ifort_CICLAD.env
+   39  ssh rlmd093@jean-zay.idris.fr
+   40  exit
+   41  ssh -CY hakim
+   42  ssh -CY aidel@irene-fr.ccc.cea.fr
+   43  ssh hakim
+   44  ssh -CY hakim
+   45  ssh rlmd093@jean-zay.idris.fr
+   46  ssh -CY hakim
+   47  ssh -CY aidel@irene-fr.ccc.cea.fr
+   48  ssh aidelkad@ciclad.ipsl.jussieu.fr
+   49  ssh -CY hakim
+   50  ssh -CY rlmd093@jean-zay.idris.fr
+   51  ssh -CY aidel@irene-fr.ccc.cea.fr
+   52  ssh aidelkad@ciclad.ipsl.jussieu.fr
+   53  ssh -CY hakim
+   54  ssh -CY rlmd093@jean-zay.idris.fr
+   55  ssh -CY hakim
+   56  ssh -CY hakim
+   57  ssh -CY rlmd093@jean-zay.idris.fr
+   58  ssh aidelkad@ciclad.ipsl.jussieu.fr
+   59  history | grep ssh
+   60  history | grep carey
+   61  ssh hakim -t ssh carey -l lmdz
+   62  ssh -CY hakim
+   63  ssh -CY rlmd093@jean-zay.idris.fr
+   64  ssh hakim -t ssh carey -l lmdz
+   65  ls -trl
+   66  ssh hakim -t ssh carey -l lmdz
+   67  ssh -CY hakim
+   68  ssh -CY rlmd093@jean-zay.idris.fr
+   69  tcsh
+   70  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+   71  tcsh
+   72  ssh hakim -t ssh carey -l lmdz
+   73  ssh -CY hakim
+   74  ssh -CY rlmd093@jean-zay.idris.fr
+   75  ssh -CY hakim
+   76  scp -r /u/lmdz/LMDZCosp/LMDZtrunk/modipsl/modeles/LMDZ/BENCH32x32x39 rlmd093@jean-zay.idris.fr:/gpfsscratch/rech/lmd/rlmd093/RUN_DIR/.
+   77  ssh hakim
+   78   rlmd093@jean-zay.idris.fr:/gpfsscratch/rech/lmd/rlmd093/RUN_DIR/.
+   79  scp -r /u/lmdz/LMDZCosp/LMDZtrunk/modipsl/modeles/LMDZ/BENCH32x32x39 rlmd093@jean-zay.idris.fr:/gpfsscratch/rech/lmd/rlmd093/RUN_DIR/.
+   80  ls -trl /u/lmdz/LMDZCosp/LMDZtrunk/modipsl/modeles/LMDZ/BENCH32x32x39
+   81  ls -trl /u/lmdz/LMDZCosp/LMDZtrunk/
+   82  ls -trl /u/lmdz/LMDZCosp/
+   83  ls -trl /u/lmdz/
+   84  ls -trl /u/lmdz/LMDZCosp/LMDZtrunk/modipsl/modeles/LMDZ/BENCH32x32x39
+   85  ssh hakim -t ssh carey -l lmdz
+   86  ssh -CY hakim
+   87  ssh -CY rlmd093@jean-zay.idris.fr
+   88  ssh -CY hakim
+   89  ssh -CY rlmd093@jean-zay.idris.fr
+   90  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+   91  ssh -CY hakim
+   92  ssh hakim -t ssh carey -l lmdz
+   93  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+   94  ssh -CY hakim
+   95  ssh -CY rlmd093@jean-zay.idris.fr
+   96  ssh -CY aidel@irene-fr.ccc.cea.fr
+   97  ssh -CY hakim
+   98  ssh -CY aidel@irene-fr.ccc.cea.fr
+   99  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  100  ssh -CY hakim
+  101  ssh -CY rlmd093@jean-zay.idris.fr
+  102  ssh hakim -t ssh carey -l lmdz
+  103  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  104  ssh hakim -t ssh carey -l lmdz
+  105  scp aidelkad@ciclad.ipsl.jussieu.fr:/data/aidelkad/INSTALL_LMDZ/script_install/install_lmdz.sh .
+  106  ls -trl
+  107  vi install_lmdz.sh 
+  108  pwd
+  109  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  110  ssh -CY fabric@ciclad.ipsl.jussieu.fr
+  111  ssh -CY hakim
+  112  cp /u/lmdz/Commits_Install/LMDZtrunk/modipsl/modeles/LMDZ/BENCH32x32x39/histdayCOSP.nc .
+  113  ferret
+  114  module load ferret
+  115  ferret
+  116  exit
+  117  ssh -CY mitchell
+  118  exit
+  119  ssh hakim -t ssh carey -l lmdz
+  120  ls -trl
+  121  cp /u/lmdz/Commits_Install/LMDZtrunk/modipsl/modeles/LMDZ/BENCH32x32x39/histdayCOSP.nc .
+  122  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  123  scp histdayCOSP.nc aidelkad@ciclad.ipsl.jussieu.fr:.
+  124  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  125  ssh -CY fabric@ciclad.ipsl.jussieu.fr
+  126  ssh -CY fabric@ciclad.ipsl.jussieu.fr
+  127  ssh -CY hakim
+  128  ssh -CY rlmd093@jean-zay.idris.fr
+  129  ssh -CY hakim
+  130  cd /tmp15/idelkadi/
+  131  scp aidel@irene-fr.ccc.cea.fr:/gpfsscratch/rech/lmd/rlmd093/RUN_DIR/2101633_40414/LMDZcosp06.40414/histdayCOSP.nc .
+  132  scp rlmd093@jean-zay.idris.fr:/gpfsscratch/rech/lmd/rlmd093/RUN_DIR/2101633_40414/LMDZcosp06.40414/histdayCOSP.nc .
+  133  ssh -CY rlmd093@jean-zay.idris.fr
+  134  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  135  ssh -CY hakim
+  136  ssh -CY rlmd093@jean-zay.idris.fr
+  137  ssh -CY hakim
+  138  ssh -CY rlmd093@jean-zay.idris.fr
+  139  ssh -CY hakim
+  140  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  141  ssh hakim -t ssh carey -l lmdz
+  142  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  143  ssh -CY hakim
+  144  ssh -CY rlmd093@jean-zay.idris.fr
+  145  cd $WORK
+  146  ssh -CY rlmd093@jean-zay.idris.fr
+  147  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  148  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  149  ssh -CY hakim
+  150  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  151  ssh -CY fabric@ciclad.ipsl.jussieu.fr
+  152  ssh -CY aidel@irene-fr.ccc.cea.fr
+  153  ssh hakim
+  154  ssh -CY aidel@irene-fr.ccc.cea.fr
+  155  ssh hakim
+  156  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  157  ls Desktop/
+  158  ls Desktop/Paprass/
+  159  ls -trl Desktop/Paprass/
+  160  exit
+  161  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  162  ssh hakim
+  163  ssh -CY aidel@irene-fr.ccc.cea.fr
+  164  exit
+  165  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  166  ssh -CX hakim
+  167  ssh -CY hakim
+  168  cd /tmp15/idelkadi/
+  169  firefox 
+  170  ssh -CY hakim
+  171  ssh -CY aidel@irene-fr.ccc.cea.fr
+  172  ssh -CY rlmd093@jean-zay.idris.fr
+  173  ssh -CY hakim
+  174  ls -trl /gpfswork/rech/ces/rces990/PROGRAM_NEW3/modipsl/config/IPSLCM6/AFtest2
+  175  ls -trl /gpfswork/rech/ces/rces990/PROGRAM_NEW3/modipsl/config/IPSLCM6
+  176  ls -trl /gpfswork/rech/ces/rces990/PROGRAM_NEW3
+  177  ls -trl /gpfswork/rech/ces/rces990
+  178  ssh -CY aidel@irene-fr.ccc.cea.fr
+  179  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  180  ls
+  181  ls /
+  182  ls /tmp15/idelkadi/
+  183  cd /tmp15/idelkadi/
+  184  mkdir T00
+  185  cd T00/
+  186  scp aidelkad@ciclad.ipsl.jussieu.fr:/data/aidelkad/T00/start* .
+  187  scp aidelkad@ciclad.ipsl.jussieu.fr:/data/aidelkad/T00/*start* .
+  188  scp aidelkad@ciclad.ipsl.jussieu.fr:/data/aidelkad/T00/*rest_* .
+  189  scp aidelkad@ciclad.ipsl.jussieu.fr:/data/aidelkad/T00/limit_1994.nc .
+  190  pwd
+  191  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  192  ls /home/afeofilo/zzz/2020_07_30_not_working-3 
+  193  ls /home/afeofilo/zzz/
+  194  ssh -CY hakim
+  195  ssh -CY aidel@irene-fr.ccc.cea.fr
+  196  ssh -CY rlmd093@jean-zay.idris.fr
+  197  ssh -CY aidel@irene-fr.ccc.cea.fr
+  198  scp -r aidel@irene-fr.ccc.cea.fr:.subversion .
+  199  scp -r aidel@irene-fr.ccc.cea.fr:.subversion .subversion.irene
+  200  pwd
+  201  ls -trla
+  202  exit
+  203  ssh -CY hakim
+  204  exit
+  205  ssh -CY hakim
+  206  ssh -CY aidel@irene-fr.ccc.cea.fr
+  207  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  208  ssh -CY hakim
+  209  ssh -CY aidel@irene-fr.ccc.cea.fr
+  210  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  211  cp aidelkad@ciclad.ipsl.jussieu.fr:/data/aidelkad/Cospv2/LMDZtrunk.para_ioipsl/modipsl/modeles/orchidee.tar .
+  212  scp aidelkad@ciclad.ipsl.jussieu.fr:/data/aidelkad/Cospv2/LMDZtrunk.para_ioipsl/modipsl/modeles/orchidee.tar .
+  213  ls -trl
+  214  exit
+  215  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  216  ssh -CY hakim
+  217  ssh -CY aidel@irene-fr.ccc.cea.fr
+  218  ssh -CY hakim
+  219  ssh -CY rlmd093@jean-zay.idris.fr
+  220  ssh -CY hakim
+  221  ssh -CY rlmd093@jean-zay.idris.fr
+  222  ssh -CY aidel@irene-fr.ccc.cea.fr
+  223  ssh -CY rlmd093@jean-zay.idris.fr
+  224  exit
+  225  ssh -CY hakim
+  226  exit
+  227  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  228  thunderbird 
+  229  exit
+  230  ps -aux
+  231  ps -aux | grep idelkadi
+  232  thunderbird 
+  233  exit
+  234  .thunderbird
+  235  ssh -CY mitchell
+  236  exit
+  237  .thunderbird
+  238  thunderbird 
+  239  exit
+  240  thunderbird 
+  241  exit
+  242  ssh -CY hakim
+  243  ssh -CY mitchell
+  244  ssh -CYX mitchell
+  245  exit
+  246  ls -trla
+  247  rm -rf orchidee.tar 
+  248  ls -trl
+  249  rm -f histdayCOSP.nc 
+  250  thunderbird 
+  251  ps -aux | grep thunderbird
+  252  kill -9 6914
+  253  ps -au | grep thunderbird
+  254  kill -9 112832
+  255  thunderbird 
+  256  exit
+  257  ssh -CY mitchell
+  258  thumbnail 
+  259  mail
+  260  mailx
+  261  ssh -CY hakim
+  262  ssh -CY aidel@irene-fr.ccc.cea.fr
+  263  ssh -CY hakim
+  264  ssh -CY rlmd093@jean-zay.idris.fr
+  265  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  266  ssh -CY hakim
+  267  ssh -CY aidel@irene-fr.ccc.cea.fr
+  268  ssh -CY rlmd093@jean-zay.idris.fr
+  269  ssh -CY hakim
+  270  ssh -CY rlmd093@jean-zay.idris.fr
+  271  ssh -CY hakim
+  272  exit
+  273  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  274  ssh -CY hakim
+  275  ssh -CY aidel@irene-fr.ccc.cea.fr
+  276  ssh -CY rlmd093@jean-zay.idris.fr
+  277  ssh -CY hakim
+  278  ssh -CY aidel@irene-fr.ccc.cea.fr
+  279  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  280  ssh -CY hakim
+  281  ssh -CY hakim
+  282  ssh -CY aidel@irene-fr.ccc.cea.fr
+  283  ssh -CY hakim
+  284  ssh -CY rlmd093@jean-zay.idris.fr
+  285  tcsh
+  286  ssh -CY rlmd093@jean-zay.idris.fr
+  287  ssh -CY hakim
+  288  ssh -CY aidel@irene-fr.ccc.cea.fr
+  289  ssh -CY hakim
+  290  ssh -CY hakim
+  291  ssh -CY rlmd093@jean-zay.idris.fr
+  292  ssh -CY hakim
+  293  ssh -CY rlmd093@jean-zay.idris.fr
+  294  ssh -CY hakim
+  295  ssh -CY hakim
+  296  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  297  ssh -CY rlmd093@jean-zay.idris.fr
+  298  scp rlmd093@jean-zay.idris.fr:lmdz_cosp_interface.F90 .
+  299  ls -trl
+  300  exit
+  301  ssh -CY hakim
+  302  exit
+  303  scp rlmd093@jean-zay.idris.fr:/gpfswork/rech/lmd/rlmd093/Cospv2_Cmip6/modipsl/modeles/LMDZ/libf/phylmd/cospv2/lmdz_cosp_subsample_and_optics_mod.F90.modif .
+  304  exit
+  305  ssh -CY hakim
+  306  exit
+  307  cd /tmp15/idelkadi/
+  308  scp -r rlmd093@jean-zay.idris.fr:/gpfswork/rech/lmd/rlmd093/Cospv2_Cmip6/modipsl/modeles/LMDZ/libf/phylmd/cospv2 .
+  309  ls -trl
+  310  pwd
+  311  mv cospv2 ~/.
+  312  cd
+  313  ls -trl
+  314  exit
+  315  rm -rf cospv2
+  316  scp -r rlmd093@jean-zay.idris.fr:/gpfswork/rech/lmd/rlmd093/Cospv2_Cmip6/modipsl/modeles/LMDZ/DefLists .
+  317  ls -trl
+  318  exit
+  319  scp -r rlmd093@jean-zay.idris.fr:/gpfswork/rech/lmd/rlmd093/Cospv2_Cmip6/modipsl/modeles/LMDZ/mekelmdz_fcm
+  320  scp -r rlmd093@jean-zay.idris.fr:/gpfswork/rech/lmd/rlmd093/Cospv2_Cmip6/modipsl/modeles/LMDZ/mekelmdz_fcm .
+  321  scp -r rlmd093@jean-zay.idris.fr:/gpfswork/rech/lmd/rlmd093/Cospv2_Cmip6/modipsl/modeles/LMDZ/makelmdz_fcm .
+  322  exit
+  323  ssh -CY hakim
+  324  ssh -CY rlmd093@jean-zay.idris.fr
+  325  ssh -CY hakim
+  326  scp -r cospv2  aidelkad@ciclad.ipsl.jussieu.fr:/data/aidelkad/Cospv2_FC/TEST/modipsl/modeles/LMDZ/libf/phylmd/.
+  327  ssh hakim
+  328  scp -r DefLists  aidelkad@ciclad.ipsl.jussieu.fr:/data/aidelkad/Cospv2_FC/TEST/modipsl/modeles/LMDZ/.
+  329  ssh hakim
+  330  scp -r makelmdz_fcm  aidelkad@ciclad.ipsl.jussieu.fr:/data/aidelkad/Cospv2_FC/TEST/modipsl/modeles/LMDZ/.
+  331  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  332  ssh hakim
+  333  ssh -CY rlmd093@jean-zay.idris.fr
+  334  ssh hakim
+  335  ssh -CY rlmd093@jean-zay.idris.fr
+  336  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  337  ssh hakim
+  338  scp -r rlmd093@jean-zay.idris.fr:/gpfswork/rech/lmd/rlmd093/Cospv2_Cmip6/modipsl/modeles/LMDZ/libf/phylmd/physiq_mod.F90 .
+  339  scp -r physiq_mod.F90  aidelkad@ciclad.ipsl.jussieu.fr:/data/aidelkad/Cospv2_FC/TEST/modipsl/modeles/LMDZ/libf/phylmd/.
+  340  ssh hakim
+  341  ssh -CY rlmd093@jean-zay.idris.fr
+  342  ssh hakim
+  343  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  344  ssh -CY rlmd093@jean-zay.idris.fr
+  345  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  346  ssh -CY hakim
+  347  ssh hakim
+  348  ssh -CY hakim
+  349  ssh -CY rlmd093@jean-zay.idris.fr
+  350  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  351  ssh -CY hakim
+  352  ssh -CY rlmd093@jean-zay.idris.fr
+  353  ssh -CY hakim
+  354  ssh -CY aidel@irene-fr.ccc.cea.fr
+  355  ls -trl /tmp15/idelkadi/
+  356  ls -trl /tmp15/idelkadi/T00/
+  357  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  358  cd /tmp15/idelkadi/
+  359  scp aidelkad@ciclad.ipsl.jussieu.fr:/data/aidelkad/Cospv2/LMDZtrunk.para_ioipsl/modipsl/modeles/LMDZ/INIT160x90x79-Ma20km/1994/INTERP_NUDGE/*.nc .
+  360  vi ~/.ssh/authorized_keys
+  361  pwd
+  362  ls -trl
+  363  scp u_199401_erai.nc v_199401_erai.nc aidelkadi@simlab-cluster.um6p.ma:/mnt/beegfs/aidelkadi/LmdzOr/Install_mod/LMDZtrunk/modipsl/modeles/LMDZ/BENCH160x90x79Ma/.
+  364  pwd
+  365  exit
+  366  ssh -CY hakim
+  367  exit
+  368  ssh -CY hakim
+  369  ssh -CY aidel@irene-fr.ccc.cea.fr
+  370  ls -trl /tmp15/idelkadi/
+  371  ls -trl /tmp15/idelkadi/T00/
+  372  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  373  mkdir Test_Ciclad_20kmMa
+  374  cd Test_Ciclad_20kmMa/
+  375  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  376  cd /tmp15/idelkadi/
+  377  ls -trl
+  378  cd
+  379  ls -trl
+  380  cd Test_Ciclad_20kmMa/
+  381  scp aidelkad@ciclad.ipsl.jussieu.fr:/data/aidelkad/Cospv2/LMDZtrunk.para_ioipsl/modipsl/modeles/LMDZ/INIT160x90x79-Ma20km/*.def .
+  382  ls -trl
+  383  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  384  ls -trl
+  385  pwd
+  386  exit
+  387  ssh -CY hakim
+  388  ssh -CY rlmd093@jean-zay.idris.fr
+  389  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  390  ssh -CY hakim
+  391  ssh -CY rlmd093@jean-zay.idris.fr
+  392  ssh -CY hakim
+  393  vi .ssh/authorized_keys
+  394  ssh -CY aidel@irene-fr.ccc.cea.fr
+  395  ssh -CY hakim
+  396  ssh -CY aidel@irene-fr.ccc.cea.fr
+  397  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  398  ssh -CY hakim
+  399  ssh -CY rlmd093@jean-zay.idris.fr
+  400  module avail
+  401  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  402  ssh -CY hakim
+  403  ssh -CY aidel@irene-fr.ccc.cea.fr
+  404  ssh -CY rlmd093@jean-zay.idris.fr
+  405  ssh -CY hakim
+  406  history | grep carey
+  407  exit
+  408  cd Grilles_Ma/
+  409  ls -trl /u/lmdz/Tests_Install/LMDZtrunk/modipsl/
+  410  ls -trl /u/lmdz/Tests_Install/LMDZtrunk/modipsl/modeles/LMDZ/INIT160x90x79/grilles_gcm.nc .
+  411  ls -trl
+  412  cd 160x90x79_20km/
+  413  cp /u/lmdz/Tests_Install/LMDZtrunk/modipsl/modeles/LMDZ/INIT160x90x79/grilles_gcm.nc .
+  414  ls -trl
+  415  cd ..
+  416  ls -trl
+  417  mkdir 144x142x79_30x50km
+  418  cd 144x142x79_30x50km/
+  419  ls -trl
+  420  cp /u/lmdz/Tests_Install/LMDZtrunk/modipsl/modeles/LMDZ/INIT14414279/Gross5/grilles_gcm.nc .
+  421  cd ..
+  422  ls -trl
+  423  pwd
+  424  ls -trl  ../WWW/
+  425  ls -trl  ../WWW/ConfigLMDZma/
+  426  ls -trl  ../WWW/ConfigLMDZma/15Km/
+  427  cp   ../WWW/ConfigLMDZma/15Km/grille_shere_reg_maroc.gif grille_15km.gif
+  428  cp   ../WWW/ConfigLMDZma/20Km/grille_shere_reg_maroc.gif grille_15km.gif
+  429  ghostscript ../WWW/ConfigLMDZma/grille_shere_reg_maroc.gif 
+  430  cp ../WWW/ConfigLMDZma/grille_shere_reg_maroc.gif 
+  431  cp ../WWW/ConfigLMDZma/grille_shere_reg_maroc.gif .
+  432  ls -trl
+  433  cp   ../WWW/ConfigLMDZma/20Km/grille_shere_reg_maroc.gif grille_20km.gif
+  434  cp   ../WWW/ConfigLMDZma/15Km/grille_shere_reg_maroc.gif grille_15km.gif
+  435  ls -trl
+  436  ghostscript grille_shere_reg_maroc.gif 
+  437  exit
+  438  pwd
+  439  ls -trl
+  440  mkdir Grilles_Ma
+  441  ls -trl Grille_Ma/
+  442  ls -trl
+  443  cd Grilles_Ma/
+  444  mkdir 160x90x79_20km
+  445  cd 160x90x79_20km/
+  446  cp ssh hakim -t ssh carey -l lmdz
+  447  ssh -CY hakim
+  448  ls -trl
+  449  cd ..
+  450  ls -trl
+  451  ghostscript grille_shere_reg_maroc.gif 
+  452  tcsh
+  453  ls -trl
+  454  cd ..
+  455  ls -trl
+  456  ls -trl LmdzClimatRegional/
+  457  cd LmdzClimatRegional/
+  458  module load netcdf
+  459  pwd
+  460  exit
+  461  ssh hakim
+  462  ssh hakim -t ssh carey -l lmdz
+  463  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  464  ssh -CY hakim
+  465  ssh -CY aidel@irene-fr.ccc.cea.fr
+  466  pwd
+  467  ls -trl
+  468  cd Grilles_Ma/
+  469  pwd
+  470  chmod -R +rx /u/idelkadi/Grilles_Ma
+  471  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  472  ls -trl
+  473  cd TestsGrilleMa/
+  474  ls -trl
+  475  ferret
+  476  tcsh
+  477  module load ferret
+  478  ferret
+  479  vi grid.jnl 
+  480  ferret
+  481  exit
+  482  cd /tmp15/idelkadi/
+  483  cd
+  484  ls -trl *sh
+  485  ls -trl LmdzClimatRegional/*sh
+  486  ls -trl
+  487  mkdir TestsGrilleMa
+  488  cd TestsGrilleMa/
+  489  cp ../grid.jnl .
+  490  ls -trl
+  491  cp /u/lmdz/Tests_Install/LMDZtrunk/modipsl/modeles/LMDZ/INIT14414279/grilles_gcm.nc .
+  492  ferret
+  493  moduel load ferret
+  494  module load ferret
+  495  ksh
+  496  ls -trl
+  497  ferret
+  498  module load ferret
+  499  ksh
+  500  tcsh
+  501  ksh
+  502  ls -trl
+  503  ssh -CY mitchell
+  504  pwd
+  505  exit
+  506  ssh -CY hakim
+  507  exit
+  508  history | grep ssh
+  509  ssh hakim -t ssh carey -l lmdz
+  510  ssh -CY fabric@ciclad.ipsl.jussieu.fr
+  511  ls -trl
+  512  cd TestsGrilleMa/
+  513  ls -trl
+  514  mkdir T0
+  515  mv grilles_gcm.nc grille_shere_reg_maroc.gif T0/
+  516  ls -trl
+  517  pwd
+  518  exit
+  519  ssh -CY fabric@ciclad.ipsl.jussieu.fr
+  520  ssh -CY hakim
+  521  ssh -CY rlmd093@jean-zay.idris.fr
+  522  ssh -CY fabric@ciclad.ipsl.jussieu.fr
+  523  ssh -CY hakim
+  524  ssh -CY rlmd093@jean-zay.idris.fr
+  525  ssh -CY fabric@ciclad.ipsl.jussieu.fr
+  526  ssh -CY hakim
+  527  ssh -CY fabric@ciclad.ipsl.jussieu.fr
+  528  ssh -CY rlmd093@jean-zay.idris.fr
+  529  ssh -CY hakim
+  530  ssh -CY rlmd093@jean-zay.idris.fr
+  531  ssh -CY fabric@ciclad.ipsl.jussieu.fr
+  532  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  533  ssh -CY fabric@ciclad.ipsl.jussieu.fr
+  534  ssh -CY aidel@irene-fr.ccc.cea.fr
+  535  VgVJ8C7Me8wn*n
+  536  ssh -CY aidel@irene-fr.ccc.cea.fr
+  537  liia1@3
+  538  liiamra1
+  539  ssh -CY aidel@irene-fr.ccc.cea.fr
+  540  ssh -CY hakim
+  541  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  542  ssh -CY aidel@irene-fr.ccc.cea.fr
+  543  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  544  ssh -CY hakim
+  545  ssh -CY hakim
+  546  ssh -CY rlmd093@jean-zay.idris.fr
+  547  ssh -CY hakim
+  548  ssh -CY aidel@irene-fr.ccc.cea.fr
+  549  ssh -CY fabrice@ciclad.ipsl.jussieu.fr
+  550  ssh -CY fabric@ciclad.ipsl.jussieu.fr
+  551  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  552  ssh -CY hakim
+  553  ssh -CY rlmd093@jean-zay.idris.fr
+  554  ssh -CY hakim
+  555  ssh -CY aidel@irene-fr.ccc.cea.fr
+  556  ssh -CY hakim
+  557  ssh -CY aidel@irene-fr.ccc.cea.fr
+  558  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  559  ssh -CY fabric@ciclad.ipsl.jussieu.fr
+  560  ssh -CY hakim
+  561  ssh -CY hakim
+  562  ssh -CY fabric@ciclad.ipsl.jussieu.fr
+  563  ssh -CY aidel@irene-fr.ccc.cea.fr
+  564  ssh -CY aidel@irene-fr.ccc.cea.fr
+  565  ssh -CY fabric@ciclad.ipsl.jussieu.fr
+  566  ssh -CY hakim
+  567  ssh -CY hakim
+  568  exit
+  569  ssh -CY hakim
+  570  ssh -CY aidel@irene-fr.ccc.cea.fr
+  571  ssh -CY fabric@ciclad.ipsl.jussieu.fr
+  572  ssh -CY hakim
+  573  ssh -CY hakim
+  574  ssh -CY aidel@irene-fr.ccc.cea.fr
+  575  ssh -CY hakim
+  576  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  577  ssh -CY aidel@irene-fr.ccc.cea.fr
+  578  ssh -CY hakim
+  579  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  580  ssh -CY aidel@irene-fr.ccc.cea.fr
+  581  ssh -CY hakim
+  582  ssh -CY aidel@irene-fr.ccc.cea.fr
+  583  ssh -CY hakim
+  584  ssh -CY fabric@ciclad.ipsl.jussieu.fr
+  585  ssh -CY hakim
+  586  ssh -CY fabric@ciclad.ipsl.jussieu.fr
+  587  ssh -CY aidel@irene-fr.ccc.cea.fr
+  588  scp -r aidel@irene-fr.ccc.cea.fr:/ccc/cont003/home/lmd/aidel/Pour_Arnaud .
+  589  exit
+  590  ssh -CY hakim
+  591  scp -r aidel@irene-fr.ccc.cea.fr:Pour_Arnaud .
+  592  exit
+  593  ssh -CY hakim
+  594  ssh -CY aidel@irene-fr.ccc.cea.fr
+  595  ssh -CY hakim
+  596  ssh -CY aidel@irene-fr.ccc.cea.fr
+  597  ssh -CY rlmd093@jean-zay.idris.fr
+  598  ssh -CY aidel@irene-amd-fr
+  599  ssh -CY aidel@irene-amd-fr.ccc.cea.fr
+  600  ssh -CY hakim
+  601  ssh -CY rlmd093@jean-zay.idris.fr
+  602  ssh -CY aidel@irene-amd-fr.ccc.cea.fr
+  603  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  604  ssh -CY hakim
+  605  ssh -CY aidel@irene-fr.ccc.cea.fr
+  606  ssh -CY hakim
+  607  ssh -CY rlmd093@jean-zay.idris.fr
+  608  ssh -CY hakim
+  609  ssh -CY hakim
+  610  ssh -CY aidel@irene-fr.ccc.cea.fr
+  611  ssh -CY hakim
+  612  ssh -CY rlmd093@jean-zay.idris.fr
+  613  ssh -CY hakim
+  614  ssh -CY aidel@irene-amd-fr.ccc.cea.fr
+  615  scp -r Defs_Simlab rlmd093@jean-zay.idris.fr:/gpfsscratch/rech/lmd/rlmd093/Tests_Saloua/.
+  616  ssh hakim
+  617  scp -r Defs_Simlab rlmd093@jean-zay.idris.fr:/gpfsscratch/rech/lmd/rlmd093/Tests_Saloua/.
+  618  ssh -CY hakim
+  619  ssh -CY rlmd093@jean-zay.idris.fr
+  620  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  621  ssh -CY hakim
+  622  ssh -CY rlmd093@jean-zay.idris.fr
+  623  ls -trl
+  624  ls Test_Ciclad_20kmMa
+  625  vi Test_Ciclad_20kmMa/vert.def 
+  626  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  627  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  628  ssh -CY fabric@ciclad.ipsl.jussieu.fr
+  629  ssh -CY hakim
+  630  ssh -CY aidel@irene-fr.ccc.cea.fr
+  631  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  632  ssh -CY hakim
+  633  ssh -CY rlmd093@jean-zay.idris.fr
+  634  vi .ssh/authorized_keys
+  635  ssh -CY rlmd093@jean-zay.idris.fr
+  636  vi .ssh/id_dsa.pub 
+  637  vi id_rsa.pub 
+  638  ssh -CY rlmd093@jean-zay.idris.fr
+  639  ls ~hourdin/WWW/
+  640  ls -trl  ~hourdin/WWW/
+  641  ls -trl  ~hourdin/WWW/TMP/
+  642  ssh -CY hakim
+  643  ssh -CY rlmd093@jean-zay.idris.fr
+  644  ssh -CY hakim
+  645  ls -trl UTILS/
+  646  ls -trl UTILS/pdf/
+  647  vi UTILS/pdf/README 
+  648  pwd
+  649  cd UTILS/pdf/
+  650  pwd
+  651  exit
+  652  ssh mitchell
+  653  exit
+  654  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  655  ssh -CY rlmd093@jean-zay.idris.fr
+  656  ssh -CY rlmd093@jean-zay.idris.fr
+  657  ssh -CY hakim
+  658  ssh -CY rlmd093@jean-zay.idris.fr
+  659  ssh -CY hakim
+  660  ssh -CY aidel@irene-fr.ccc.cea.fr
+  661  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  662  ssh -CY fabric@ciclad.ipsl.jussieu.fr
+  663  ssh -CY hakim
+  664  ssh -CY aidel@irene-fr.ccc.cea.fr
+  665  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  666  ssh -CY hakim
+  667  ssh -CY rlmd093@jean-zay.idris.fr
+  668  ssh -CY hakim
+  669  ssh -CY aidel@irene-fr.ccc.cea.fr
+  670  ssh -CY hakim
+  671  ssh -CY aidel@irene-fr.ccc.cea.fr
+  672  ssh -CY rlmd093@jean-zay.idris.fr
+  673  ls -trl
+  674  ls -trl Maroc/
+  675  ls -trl Desktop/
+  676  ls -trl Desktop/MouUnivMed6/
+  677  ls -trl Desktop/MouUnivMed6/Documentation/
+  678  ls -trl Desktop/
+  679  ls -trl Desktop/MouUnivMed6/
+  680  ls -trl Desktop/MouUnivMed6/Documentation/
+  681  ls -trl
+  682  cd ..
+  683  ls
+  684  pwd
+  685  cd
+  686  ls
+  687  ls *.odt
+  688  cd Desktop/
+  689  ls
+  690  ls CooperationFrMa/
+  691  ls -trl CooperationFrMa/
+  692  ls -trl *odt
+  693  exit
+  694  cd Desktop/CooperationFrMa/
+  695  ls -trl
+  696  ls -trlcd ..
+  697  ls -trl *odt
+  698  cd ..
+  699  ls -trl *odt
+  700  exit
+  701  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  702  ssh -CY hakim
+  703  ssh -CY hakim
+  704  ssh -CY aidel@irene-fr.ccc.cea.fr
+  705  ssh -CY hakim
+  706  ssh -CY aidel@irene-fr.ccc.cea.fr
+  707  ssh -CY hakim
+  708  ssh -CY rlmd093@jean-zay.idris.fr
+  709  ssh -CY hakim
+  710  mv Montagnes_RessourcesEau_Maroc.pdf WWW/.
+  711  ls -trl
+  712  cd WWW/
+  713  ls -trl
+  714  ssh -CY aidel@irene-fr.ccc.cea.fr
+  715  ssh -CY hakim
+  716  ssh -CY rlmd093@jean-zay.idris.fr
+  717  ssh -CY hakim
+  718  ssh -CY hakim
+  719  ssh -CY rlmd093@jean-zay.idris.fr
+  720  exit
+  721  ssh -CY hakim
+  722  exit
+  723  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  724  ssh -CY hakim
+  725  ssh -CY rlmd093@jean-zay.idris.fr
+  726  ssh -CY hakim
+  727  ssh -CY rlmd093@jean-zay.idris.fr
+  728  ssh -CY aidel@irene-fr.ccc.cea.fr
+  729  ssh -CY hakim
+  730  ssh -CY hakim
+  731  ssh -CY rlmd093@jean-zay.idris.fr
+  732  ssh -CY hakim
+  733  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  734  ssh -CY rlmd093@jean-zay.idris.fr
+  735  ssh -CY hakim
+  736  Abdelmonaim1234@
+  737  ssh -CY rlmd093@jean-zay.idris.fr
+  738  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  739  ssh -CY aidel@irene-fr.ccc.cea.fr
+  740  ssh -CY hakim
+  741  ssh -CY rlmd093@jean-zay.idris.fr
+  742  ssh -CY hakim
+  743  ssh -CY aidel@irene-fr.ccc.cea.fr
+  744  ssh -CY hakim
+  745  ssh -CY aidel@irene-fr.ccc.cea.fr
+  746  cd Desktop/
+  747  ls -trl *odt
+  748  ls -trl ../*odt
+  749  pwd
+  750  cd ..
+  751  ls -trl
+  752  cd Desktop/
+  753  ls -trl
+  754  ls Cosp
+  755  ls */*odt
+  756  ls -trl */*odt
+  757  ssh -CY hakim
+  758  ssh -CY aidel@irene-fr.ccc.cea.fr
+  759  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  760  ssh -CY fabric@ciclad.ipsl.jussieu.fr
+  761  ssh -CY hakim
+  762  ssh -CY mitchell
+  763  cd /d3/idelkadi/
+  764  ls -trl
+  765  mkdir Ecrad
+  766  cd Ecrad/
+  767  wget https://www.lmd.jussieu.fr/~nvillefranque/dephy2ecRad/dephy2ecRad.tar
+  768  ls -trl
+  769  tar xf dephy2ecRad.tar 
+  770  ls -trl
+  771  cd dephy2ecRad/
+  772  ls -trl
+  773  vi make_ecRad_input.sh 
+  774  vi tools/Interface.py 
+  775  ssh -CY hakim
+  776  ssh -CY mitchell
+  777  cd /d3/idelkadi/
+  778  cd Ecrad/
+  779  ls -trl
+  780  cd dephy2ecRad/
+  781  ls -trl
+  782  vi tools/Interface.py 
+  783  ls -trl
+  784  ls inputs/
+  785  ncdump inputs/test_LMDz.nc | more
+  786  ls inputs/
+  787  ncdump inputs/ecrad_meridian.nc | more
+  788  ls -trl
+  789  vi make_ecRad_input.sh 
+  790  ls outputs/
+  791  vi tools/Interface.py 
+  792  ls -trl
+  793  vi namelists/config_all_parameters.nam 
+  794  ls -trl
+  795  ls -trl tools/
+  796  ls -trl prof1D/
+  797  ssh -CY hakim
+  798  ssh -CY mitchell
+  799  cd /d3/idelkadi/Ecrad/
+  800  ls -trl
+  801  cd dephy2ecRad/
+  802  ls -trl
+  803  ncdump inputs/test_LMDz.nc | more
+  804  ncdump inputs/ecrad_meridian.nc | more
+  805  ls -trl
+  806  ls prof1D/
+  807  ls -trl
+  808  vi make_ecRad_input.sh 
+  809  ls -trl
+  810  ls tools/
+  811  vi make_ecRad_input.sh 
+  812  vi tools/Interface.py 
+  813  ls prof1D/
+  814  ls ../
+  815  ls -trl
+  816  ls -trl ../dephy2ecRad
+  817  ssh -CY hakim
+  818  ls -trl
+  819  ssh -CY aidel@irene-fr.ccc.cea.fr
+  820  cd /tmp15/idelkadi/
+  821  scp aidel@irene-fr.ccc.cea.fr:/ccc/scratch/cont003/gencmip6/aidel/TMP/histhf.nc .
+  822  ls -trl
+  823  rm -f NPv6.157973.tar u_199401_erai.nc v_199401_erai.nc histdayCOSP.nc 
+  824  scp aidel@irene-fr.ccc.cea.fr:/ccc/scratch/cont003/gencmip6/aidel/TMP/histhf.nc .
+  825  ls -trl
+  826  pwd
+  827  exit
+  828  ssh -CY hakim
+  829  exit
+  830  ssh -CY hakim
+  831  ssh -CY aidel@irene-fr.ccc.cea.fr
+  832  ssh -CY hakim
+  833  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  834  ssh -CY fabric@ciclad.ipsl.jussieu.fr
+  835  exit
+  836  ssh hakim
+  837  scp ecrad_lmdz.tar aidel@irene-fr.ccc.cea.fr:.
+  838  ssh -CY aidel@irene-fr.ccc.cea.fr
+  839  ssh hakim
+  840  ssh -CY fabric@ciclad.ipsl.jussieu.fr
+  841  ssh hakim
+  842  ssh -CY aidel@irene-fr.ccc.cea.fr
+  843  ssh hakim
+  844  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  845  exit
+  846  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  847  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  848  ssh -CY aidelkadi@ciclad.ipsl.jussieu.fr
+  849  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  850  ssh hakim
+  851  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  852  ssh hakim
+  853  ssh hakim
+  854  ssh -CY aidel@irene-fr.ccc.cea.fr
+  855  ssh hakim
+  856  history | grep ssh
+  857  ssh -CY rlmd093@jean-zay.idris.fr
+  858  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  859  ssh hakim
+  860  ssh -CY rlmd093@jean-zay.idris.fr
+  861  ssh hakim
+  862  ssh -CY rlmd093@jean-zay.idris.fr
+  863  ssh hakim
+  864  ssh -CY aidel@irene-fr.ccc.cea.fr
+  865  ssh hakim
+  866  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  867  ssh -CY fabric@ciclad.ipsl.jussieu.fr
+  868  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  869  ssh hakim
+  870  ssh -CY rlmd093@jean-zay.idris.fr
+  871  ssh hakim
+  872  ssh -CY aidel@irene-fr.ccc.cea.fr
+  873  ssh -CY fabric@ciclad.ipsl.jussieu.fr
+  874  ssh hakim
+  875  ssh -CY aidel@irene-fr.ccc.cea.fr
+  876  ssh hakim
+  877  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  878  ssh hakim
+  879  ssh -CY rlmd093@jean-zay.idris.fr
+  880  scp rlmd093@jean-zay.idris.fr:/gpfswork/rech/lmd/rlmd093/Formation_Xios/xios_training/ .
+  881  pwd
+  882  ls -trl
+  883  exit
+  884  ssh hakim
+  885  exit
+  886  ssh hakim
+  887  ssh -CY rlmd093@jean-zay.idris.fr
+  888  ssh hakim
+  889  ssh -CY rlmd093@jean-zay.idris.fr
+  890  ssh hakim
+  891  ssh -CY rlmd093@jean-zay.idris.fr
+  892  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  893  ssh hakim
+  894  ssh -CY rlmd093@jean-zay.idris.fr
+  895  ssh hakim
+  896  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  897  ssh -CY rlmd093@jean-zay.idris.fr
+  898  ssh hakim
+  899  ssh hakim
+  900  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  901  ssh hakim
+  902  ssh -CY rlmd093@jean-zay.idris.fr
+  903  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  904  ssh -CY fabric@ciclad.ipsl.jussieu.fr
+  905  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  906  ssh -CY rlmd093@jean-zay.idris.fr
+  907  ssh hakim
+  908  ssh -CY rlmd093@jean-zay.idris.fr
+  909  ssh hakim
+  910  ssh hakim
+  911  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  912  ssh -CY rlmd093@jean-zay.idris.fr
+  913  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  914  ssh hakim
+  915  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  916  ssh -CY rlmd093@jean-zay.idris.fr
+  917  ssh hakim
+  918  ssh -CY rlmd093@jean-zay.idris.fr
+  919  ssh hakim
+  920  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  921  ssh hakim
+  922  ssh -CY rlmd093@jean-zay.idris.fr
+  923  ls ~hourdin/
+  924  ls ~hourdin/WWW/
+  925  ls -trl ~hourdin/WWW/
+  926  ls -trl ~hourdin/WWW/TMP/
+  927  ls -trl ~hourdin/WWW/
+  928  ssh hakim
+  929  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  930  ssh hakim
+  931  cd /tmp15/idelkadi/
+  932  ls -trl
+  933  cd Test_AmipMa/
+  934  ls -trl
+  935  cd ATM/
+  936  cd Output/DA/
+  937  ls -trl
+  938  module load netcdf
+  939  ssh mitchell
+  940  cd /tmp15/idelkadi/
+  941  ls -trl
+  942  cd Test_AmipMa/ATM/Output/DA/
+  943  ncdump Tamip00_19780201_19790131_1D_histday.nc | more
+  944  ncdump -v u850 Tamip00_19780201_19790131_1D_histday.nc | more
+  945  ssh hakim
+  946  ssh hakim
+  947  ssh -CY rlmd093@jean-zay.idris.fr
+  948  ssh hakim
+  949  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  950  ls -trl
+  951  ls LMDZ.ecrad 
+  952  ls LMDZ.ecrad/
+  953  ls LMDZ.ecrad
+  954  rm LMDZ.ecrad 
+  955  ls -trl
+  956  mkdir ECRAD
+  957  cd ECRAD/
+  958  pwd
+  959  exit
+  960  ls -trl
+  961  cd ECRAD/
+  962  ls
+  963  ls ecrad/
+  964  rm -rf ecrad
+  965  pwd
+  966  history | grep carey
+  967  ssh hakim -t ssh carey -l lmdz
+  968  ssh hakim
+  969  ssh -CY rlmd093@jean-zay.idris.fr
+  970  ssh -CY aidelkad@ciclad.ipsl.jussieu.fr
+  971  ssh hakim
+  972  cd ECRAD/
+  973  ls
+  974  rm -rf ecrad
+  975  ls -trl
+  976  ls -trl /d3/idelkadi/
+  977  mv data /d3/idelkadi/Ecrad/.
+  978  ssh hakim -t ssh carey -l lmdz
+  979  ssh hakim
+  980  ssh -CY rlmd093@jean-zay.idris.fr
+  981  ssh hakim
+  982  ssh hakim -t ssh carey -l lmdz
+  983  pwd
+  984  ssh hakim
+  985  ssh -CY rlmd093@jean-zay.idris.fr
+  986  cd ECRAD/
+  987  cd ifsrrtm/
+  988  rm *.o
+  989  ls -trl
+  990  rm *.o
+  991  ls -trl
+  992  ssh hakim -t ssh carey -l lmdz
+  993  ssh hakim
+  994  ssh -CY rlmd093@jean-zay.idris.fr
+  995  ssh hakim
+  996  chmod +x /d3/idelkadi/Ecrad/data/*
+  997  ssh hakim -t ssh carey -l lmdz
+  998  cd /d3/idelkadi/
+  999  ls -trl
+ 1000  cd Ecrad/
+ 1001  ls
+ 1002  pwd
+ 1003  ls -trl
+ 1004  git clone https://github.com/ecmwf/ecrad
+ 1005  ls -trl
+ 1006  vi list_commandes_21jan2021 
+ 1007  ls -trl
+ 1008  ./install_lmdz.sh -debug -bench 0 -SCM
+ 1009  ls -trl
+ 1010  vi LMDZ_ECRAD/LISMOI 
+ 1011  cd ecrad/
+ 1012  vi ../list_commandes_21jan2021 
+ 1013  cd ..
+ 1014  ls -trl
+ 1015  cd LMDZtrunk-debug/modipsl/modeles/LMDZ/
+ 1016  mv makelmdz makelmdz.or
+ 1017  mv makelmdz_fcm makelmdz_fcm.or
+ 1018  cp /home/users/lmdz/Tsts_Ecrad/LMDZtrunk3806-debug/modipsl/modeles/LMDZ/makelmdz .
+ 1019  cp /home/users/lmdz/Tsts_Ecrad/LMDZtrunk3806-debug/modipsl/modeles/LMDZ/makelmdz_fcm .
+ 1020  cd libf/phylmd/
+ 1021  mkdir ecrad
+ 1022  cd ecrad/
+ 1023  cp /d3/idelkadi/Ecrad/ecrad/drhook/include/
+ 1024  cp /d3/idelkadi/Ecrad/ecrad/ifsaux/* .
+ 1025  cp /d3/idelkadi/Ecrad/ecrad/ifsrrtm/* .
+ 1026  cp /d3/idelkadi/Ecrad/ecrad/include/* .
+ 1027  cp /d3/idelkadi/Ecrad/ecrad/radiation/* .
+ 1028  cp /d3/idelkadi/Ecrad/ecrad/radsurf/* .
+ 1029  cp /d3/idelkadi/Ecrad/ecrad/utilities/* .
+ 1030  rm -f Makefile*
+ 1031  ls
+ 1032  cp /d3/idelkadi/Ecrad/ecrad/drhook/*F90  .
+ 1033  cp /d3/idelkadi/Ecrad/ecrad/drhook/include/* .
+ 1034  history 
+ 1035  history >> listing_history
Index: LMDZ6/trunk/libf/phylmd/ecrad/malloc_extension_c.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/malloc_extension_c.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/malloc_extension_c.h	(revision 3908)
@@ -0,0 +1,110 @@
+/**
+ * (C) Copyright 2014- ECMWF.
+ *
+ * This software is licensed under the terms of the Apache Licence Version 2.0
+ * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+ *
+ * In applying this licence, ECMWF does not waive the privileges and immunities
+ * granted to it by virtue of its status as an intergovernmental organisation
+ * nor does it submit to any jurisdiction.
+ */
+
+/* Copyright (c) 2008, Google Inc.
+ * All rights reserved.
+ * 
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ * 
+ *     * Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *     * Redistributions in binary form must reproduce the above
+ * copyright notice, this list of conditions and the following disclaimer
+ * in the documentation and/or other materials provided with the
+ * distribution.
+ *     * Neither the name of Google Inc. nor the names of its
+ * contributors may be used to endorse or promote products derived from
+ * this software without specific prior written permission.
+ * 
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * --
+ * Author: Craig Silverstein
+ *
+ * C shims for the C++ malloc_extension.h.  See malloc_extension.h for
+ * details.  Note these C shims always work on
+ * MallocExtension::instance(); it is not possible to have more than
+ * one MallocExtension object in C applications.
+ */
+
+#ifndef _MALLOC_EXTENSION_C_H_
+#define _MALLOC_EXTENSION_C_H_
+
+#include <stddef.h>
+#include <sys/types.h>
+
+/* Annoying stuff for windows -- makes sure clients can import these fns */
+#ifndef PERFTOOLS_DLL_DECL
+# ifdef _WIN32
+#   define PERFTOOLS_DLL_DECL  __declspec(dllimport)
+# else
+#   define PERFTOOLS_DLL_DECL
+# endif
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define kMallocExtensionHistogramSize 64
+
+PERFTOOLS_DLL_DECL int MallocExtension_VerifyAllMemory(void);
+PERFTOOLS_DLL_DECL int MallocExtension_VerifyNewMemory(const void* p);
+PERFTOOLS_DLL_DECL int MallocExtension_VerifyArrayNewMemory(const void* p);
+PERFTOOLS_DLL_DECL int MallocExtension_VerifyMallocMemory(const void* p);
+PERFTOOLS_DLL_DECL int MallocExtension_MallocMemoryStats(int* blocks, size_t* total,
+                                      int histogram[kMallocExtensionHistogramSize]);
+PERFTOOLS_DLL_DECL void MallocExtension_GetStats(char* buffer, int buffer_length);
+
+/* TODO(csilvers): write a C version of these routines, that perhaps
+ * takes a function ptr and a void *.
+ */
+/* void MallocExtension_GetHeapSample(string* result); */
+/* void MallocExtension_GetHeapGrowthStacks(string* result); */
+
+PERFTOOLS_DLL_DECL int MallocExtension_GetNumericProperty(const char* property, size_t* value);
+PERFTOOLS_DLL_DECL int MallocExtension_SetNumericProperty(const char* property, size_t value);
+PERFTOOLS_DLL_DECL void MallocExtension_MarkThreadIdle(void);
+PERFTOOLS_DLL_DECL void MallocExtension_MarkThreadBusy(void);
+PERFTOOLS_DLL_DECL void MallocExtension_ReleaseToSystem(size_t num_bytes);
+PERFTOOLS_DLL_DECL void MallocExtension_ReleaseFreeMemory(void);
+PERFTOOLS_DLL_DECL size_t MallocExtension_GetEstimatedAllocatedSize(size_t size);
+PERFTOOLS_DLL_DECL size_t MallocExtension_GetAllocatedSize(const void* p);
+
+/*
+ * NOTE: These enum values MUST be kept in sync with the version in
+ *       malloc_extension.h
+ */
+typedef enum {
+  MallocExtension_kUnknownOwnership = 0,
+  MallocExtension_kOwned,
+  MallocExtension_kNotOwned
+} MallocExtension_Ownership;
+
+PERFTOOLS_DLL_DECL MallocExtension_Ownership MallocExtension_GetOwnership(const void* p);
+
+#ifdef __cplusplus
+}   // extern "C"
+#endif
+
+#endif /* _MALLOC_EXTENSION_C_H_ */
Index: LMDZ6/trunk/libf/phylmd/ecrad/mpl_module.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/mpl_module.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/mpl_module.F90	(revision 3908)
@@ -0,0 +1,57 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+MODULE MPL_MODULE
+
+USE PARKIND1, ONLY : JPRB
+
+IMPLICIT NONE
+
+PRIVATE
+
+INTERFACE MPL_BROADCAST
+
+  MODULE PROCEDURE MPL_BROADCAST_REAL81, MPL_BROADCAST_REAL82, &
+       &           MPL_BROADCAST_REAL83, MPL_BROADCAST_REAL84
+
+END INTERFACE MPL_BROADCAST
+
+PUBLIC MPL_BROADCAST
+
+CONTAINS
+
+SUBROUTINE MPL_BROADCAST_REAL81(KBUF,KTAG,KROOT,CDSTRING)
+REAL(JPRB)                  :: KBUF(:)
+INTEGER,INTENT(IN)          :: KTAG
+INTEGER,INTENT(IN),OPTIONAL :: KROOT
+CHARACTER*(*),INTENT(IN)    :: CDSTRING
+END SUBROUTINE MPL_BROADCAST_REAL81
+
+SUBROUTINE MPL_BROADCAST_REAL82(KBUF,KTAG,KROOT,CDSTRING)
+REAL(JPRB)                  :: KBUF(:,:)
+INTEGER,INTENT(IN)          :: KTAG
+INTEGER,INTENT(IN),OPTIONAL :: KROOT
+CHARACTER*(*),INTENT(IN)    :: CDSTRING
+END SUBROUTINE MPL_BROADCAST_REAL82
+
+SUBROUTINE MPL_BROADCAST_REAL83(KBUF,KTAG,KROOT,CDSTRING)
+REAL(JPRB)                  :: KBUF(:,:,:)
+INTEGER,INTENT(IN)          :: KTAG
+INTEGER,INTENT(IN),OPTIONAL :: KROOT
+CHARACTER*(*),INTENT(IN)    :: CDSTRING
+END SUBROUTINE MPL_BROADCAST_REAL83
+
+SUBROUTINE MPL_BROADCAST_REAL84(KBUF,KTAG,KROOT,CDSTRING)
+REAL(JPRB)                  :: KBUF(:,:,:,:)
+INTEGER,INTENT(IN)          :: KTAG
+INTEGER,INTENT(IN),OPTIONAL :: KROOT
+CHARACTER*(*),INTENT(IN)    :: CDSTRING
+END SUBROUTINE MPL_BROADCAST_REAL84
+
+END MODULE MPL_MODULE
Index: LMDZ6/trunk/libf/phylmd/ecrad/parkind1.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/parkind1.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/parkind1.F90	(revision 3908)
@@ -0,0 +1,57 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+MODULE PARKIND1
+!
+!     *** Define usual kinds for strong typing ***
+!
+IMPLICIT NONE
+PUBLIC
+SAVE
+!
+!     Integer Kinds
+!     -------------
+!
+INTEGER, PARAMETER :: JPIT = SELECTED_INT_KIND(2)
+INTEGER, PARAMETER :: JPIS = SELECTED_INT_KIND(4)
+INTEGER, PARAMETER :: JPIM = SELECTED_INT_KIND(9)
+INTEGER, PARAMETER :: JPIB = SELECTED_INT_KIND(12)
+
+!Special integer type to be used for sensative adress calculations
+!should be *8 for a machine with 8byte adressing for optimum performance
+#ifdef ADDRESS64
+INTEGER, PARAMETER :: JPIA = JPIB
+#else
+INTEGER, PARAMETER :: JPIA = JPIM
+#endif
+
+!
+!     Real Kinds
+!     ----------
+!
+INTEGER, PARAMETER :: JPRT = SELECTED_REAL_KIND(2,1)
+INTEGER, PARAMETER :: JPRS = SELECTED_REAL_KIND(4,2)
+INTEGER, PARAMETER :: JPRM = SELECTED_REAL_KIND(6,37)
+! This parameter should always be double precision as a few parts of
+! the radiation code require it
+INTEGER, PARAMETER :: JPRD = SELECTED_REAL_KIND(13,300)
+
+! This parameter governs the precision of most of the code
+#ifdef SINGLE_PRECISION
+INTEGER, PARAMETER :: JPRB = JPRM
+#else
+INTEGER, PARAMETER :: JPRB = JPRD
+#endif
+!
+
+! Logical Kinds for RTTOV....
+
+INTEGER, PARAMETER :: JPLM = JPIM   !Standard logical type
+
+END MODULE PARKIND1
Index: LMDZ6/trunk/libf/phylmd/ecrad/parrrtm.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/parrrtm.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/parrrtm.F90	(revision 3908)
@@ -0,0 +1,110 @@
+MODULE PARRRTM
+
+USE PARKIND1  ,ONLY : JPIM
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     ------------------------------------------------------------------
+!     Parameters relevant to AER's RRTM-LW radiation scheme
+
+!     19980714  JJMorcrette
+!     20110322  JJMorcrette : additional comments
+!     20110603  JJMorcrette reduced number of g-points
+!     ------------------------------------------------------------------
+
+!-- basic spectral information unrelated to number of g-points
+! JPG    : maximum possible number of g-points in each band of RRTM_LW
+! JPBAND : number of longwave spectral bands
+! JPXSEC : number of cross-sections for active trace gases
+! JPINPX : maximum dimension of the array of active trace gases 
+! JPGPT  : total number of g-points in the (operational) spectrally-reduced RRTM_LW
+
+INTEGER(KIND=JPIM), PARAMETER :: JPG    = 16
+INTEGER(KIND=JPIM), PARAMETER :: JPBAND = 16
+INTEGER(KIND=JPIM), PARAMETER :: JPXSEC = 4
+INTEGER(KIND=JPIM), PARAMETER :: JPINPX = 35
+INTEGER(KIND=JPIM), PARAMETER :: JPGMAX = 256
+
+!-- configuration for EPS with 70 g-points
+
+!INTEGER(KIND=JPIM), PARAMETER :: JPGPT  = 70
+
+!INTEGER(KIND=JPIM), PARAMETER :: NG1  = 4
+!INTEGER(KIND=JPIM), PARAMETER :: NG2  = 7
+!INTEGER(KIND=JPIM), PARAMETER :: NG3  = 8
+!INTEGER(KIND=JPIM), PARAMETER :: NG4  = 7
+!INTEGER(KIND=JPIM), PARAMETER :: NG5  = 8
+!INTEGER(KIND=JPIM), PARAMETER :: NG6  = 4
+!INTEGER(KIND=JPIM), PARAMETER :: NG7  = 6
+!INTEGER(KIND=JPIM), PARAMETER :: NG8  = 4
+!INTEGER(KIND=JPIM), PARAMETER :: NG9  = 6
+!INTEGER(KIND=JPIM), PARAMETER :: NG10 = 3
+!INTEGER(KIND=JPIM), PARAMETER :: NG11 = 4
+!INTEGER(KIND=JPIM), PARAMETER :: NG12 = 4
+!INTEGER(KIND=JPIM), PARAMETER :: NG13 = 2
+!INTEGER(KIND=JPIM), PARAMETER :: NG14 = 1
+!INTEGER(KIND=JPIM), PARAMETER :: NG15 = 1
+!INTEGER(KIND=JPIM), PARAMETER :: NG16 = 1
+
+!INTEGER(KIND=JPIM), PARAMETER :: NGS1  = 4
+!INTEGER(KIND=JPIM), PARAMETER :: NGS2  = 11
+!INTEGER(KIND=JPIM), PARAMETER :: NGS3  = 19
+!INTEGER(KIND=JPIM), PARAMETER :: NGS4  = 26
+!INTEGER(KIND=JPIM), PARAMETER :: NGS5  = 34
+!INTEGER(KIND=JPIM), PARAMETER :: NGS6  = 38
+!INTEGER(KIND=JPIM), PARAMETER :: NGS7  = 44
+!INTEGER(KIND=JPIM), PARAMETER :: NGS8  = 48
+!INTEGER(KIND=JPIM), PARAMETER :: NGS9  = 54
+!INTEGER(KIND=JPIM), PARAMETER :: NGS10 = 57
+!INTEGER(KIND=JPIM), PARAMETER :: NGS11 = 61
+!INTEGER(KIND=JPIM), PARAMETER :: NGS12 = 65
+!INTEGER(KIND=JPIM), PARAMETER :: NGS13 = 67
+!INTEGER(KIND=JPIM), PARAMETER :: NGS14 = 68
+!INTEGER(KIND=JPIM), PARAMETER :: NGS15 = 69
+
+
+!-- configuration with 140 g-points
+
+!INTEGER(KIND=JPIM), PARAMETER :: JPGPTF = 140
+!INTEGER(KIND=JPIM), PARAMETER :: JPGPTR = 140
+!INTEGER(KIND=JPIM), PARAMETER :: JPGPT  = 140
+
+!INTEGER(KIND=JPIM), PARAMETER :: NG1  = 8
+!INTEGER(KIND=JPIM), PARAMETER :: NG2  = 14
+!INTEGER(KIND=JPIM), PARAMETER :: NG3  = 16
+!INTEGER(KIND=JPIM), PARAMETER :: NG4  = 14
+!INTEGER(KIND=JPIM), PARAMETER :: NG5  = 16
+!INTEGER(KIND=JPIM), PARAMETER :: NG6  = 8
+!INTEGER(KIND=JPIM), PARAMETER :: NG7  = 12
+!INTEGER(KIND=JPIM), PARAMETER :: NG8  = 8
+!INTEGER(KIND=JPIM), PARAMETER :: NG9  = 12
+!INTEGER(KIND=JPIM), PARAMETER :: NG10 = 6
+!INTEGER(KIND=JPIM), PARAMETER :: NG11 = 8
+!INTEGER(KIND=JPIM), PARAMETER :: NG12 = 8
+!INTEGER(KIND=JPIM), PARAMETER :: NG13 = 4
+!INTEGER(KIND=JPIM), PARAMETER :: NG14 = 2
+!INTEGER(KIND=JPIM), PARAMETER :: NG15 = 2
+!INTEGER(KIND=JPIM), PARAMETER :: NG16 = 2
+
+!INTEGER(KIND=JPIM), PARAMETER :: NGS1  = 8
+!INTEGER(KIND=JPIM), PARAMETER :: NGS2  = 22
+!INTEGER(KIND=JPIM), PARAMETER :: NGS3  = 38
+!INTEGER(KIND=JPIM), PARAMETER :: NGS4  = 52
+!INTEGER(KIND=JPIM), PARAMETER :: NGS5  = 68
+!INTEGER(KIND=JPIM), PARAMETER :: NGS6  = 76
+!INTEGER(KIND=JPIM), PARAMETER :: NGS7  = 88
+!INTEGER(KIND=JPIM), PARAMETER :: NGS8  = 96
+!INTEGER(KIND=JPIM), PARAMETER :: NGS9  = 108
+!INTEGER(KIND=JPIM), PARAMETER :: NGS10 = 114
+!INTEGER(KIND=JPIM), PARAMETER :: NGS11 = 122
+!INTEGER(KIND=JPIM), PARAMETER :: NGS12 = 130
+!INTEGER(KIND=JPIM), PARAMETER :: NGS13 = 134
+!INTEGER(KIND=JPIM), PARAMETER :: NGS14 = 136
+!INTEGER(KIND=JPIM), PARAMETER :: NGS15 = 138
+
+!     ------------------------------------------------------------------
+END MODULE PARRRTM
Index: LMDZ6/trunk/libf/phylmd/ecrad/parsrtm.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/parsrtm.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/parsrtm.F90	(revision 3908)
@@ -0,0 +1,131 @@
+MODULE PARSRTM
+
+USE PARKIND1  ,ONLY : JPIM
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     ------------------------------------------------------------------
+!     Parameters relevant to AER's RRTM-SW radiation scheme
+
+!     030224  JJMorcrette
+
+!     Modified for g-point reduction from 224 to 112.  
+!     Swap code below to restore 224 g-point set. 
+!     Mar2004 MJIacono, AER
+!     20110322 JJMorcrette : additional comments
+!     20110603 JJMorcrette reduced number of g-points
+!     ------------------------------------------------------------------
+
+!-- basic spectral information unrelated to number of g-points
+! JPG     : INTEGER : maximum number of g-points in a given spectral band
+! JPBAND  : INTEGER : total number of spectral bands 
+! JPSW    : INTEGER : total number of shortwave spectral bands
+! JPB1    : INTEGER : starting index of shortwave spectrum
+! JPB2    : INTEGER : end index of shortwave spectrum
+
+INTEGER(KIND=JPIM), PARAMETER :: JPG    = 16
+INTEGER(KIND=JPIM), PARAMETER :: JPBAND = 29
+INTEGER(KIND=JPIM), PARAMETER :: JPSW   = 14
+INTEGER(KIND=JPIM), PARAMETER :: JPB1   = 16
+INTEGER(KIND=JPIM), PARAMETER :: JPB2   = 29
+INTEGER(KIND=JPIM), PARAMETER :: JPGMAX = 224
+
+!-- other information that could be relevant for RRTM_SW
+!-- NB: The following parameters are unused within the ECMWF IFS. 
+!       They relate to the description of the optical properties 
+!       in the original cloud model embedded in RRTM_SW
+!INTEGER(KIND=JPIM), PARAMETER :: JMCMU  = 32
+!INTEGER(KIND=JPIM), PARAMETER :: JMUMU  = 32
+!INTEGER(KIND=JPIM), PARAMETER :: JMPHI  = 3
+!INTEGER(KIND=JPIM), PARAMETER :: JMXANG = 4
+!INTEGER(KIND=JPIM), PARAMETER :: JMXSTR = 16
+
+!-- original spectral grid before spectral averaging
+!-- original from AER, Inc with 224 g-points
+INTEGER(KIND=JPIM), PARAMETER :: NGS16 = 0
+INTEGER(KIND=JPIM), PARAMETER :: NGS17 = 16
+INTEGER(KIND=JPIM), PARAMETER :: NGS18 = 32
+INTEGER(KIND=JPIM), PARAMETER :: NGS19 = 48
+INTEGER(KIND=JPIM), PARAMETER :: NGS20 = 64
+INTEGER(KIND=JPIM), PARAMETER :: NGS21 = 80
+INTEGER(KIND=JPIM), PARAMETER :: NGS22 = 96
+INTEGER(KIND=JPIM), PARAMETER :: NGS23 = 112
+INTEGER(KIND=JPIM), PARAMETER :: NGS24 = 128
+INTEGER(KIND=JPIM), PARAMETER :: NGS25 = 144
+INTEGER(KIND=JPIM), PARAMETER :: NGS26 = 160
+INTEGER(KIND=JPIM), PARAMETER :: NGS27 = 176
+INTEGER(KIND=JPIM), PARAMETER :: NGS28 = 192
+INTEGER(KIND=JPIM), PARAMETER :: NGS29 = 208
+
+!-------------------------------------------------------------------------------
+!-- NGnn : number of g-points in bands nn=16 to 29
+!- as used in the Ng g-points version of RRTM_SW
+!-------------------------------------------------------------------------------
+!-- configuration with 14 spectral intervals
+!   and a total of 56 g-points (14xvariable number)
+
+!INTEGER(KIND=JPIM), PARAMETER :: JPGPT  = 56
+!
+!INTEGER(KIND=JPIM), PARAMETER :: NG16 = 3
+!INTEGER(KIND=JPIM), PARAMETER :: NG17 = 6
+!INTEGER(KIND=JPIM), PARAMETER :: NG18 = 4
+!INTEGER(KIND=JPIM), PARAMETER :: NG19 = 4
+!INTEGER(KIND=JPIM), PARAMETER :: NG20 = 5
+!INTEGER(KIND=JPIM), PARAMETER :: NG21 = 5
+!INTEGER(KIND=JPIM), PARAMETER :: NG22 = 1
+!INTEGER(KIND=JPIM), PARAMETER :: NG23 = 5
+!INTEGER(KIND=JPIM), PARAMETER :: NG24 = 4
+!INTEGER(KIND=JPIM), PARAMETER :: NG25 = 3
+!INTEGER(KIND=JPIM), PARAMETER :: NG26 = 3
+!INTEGER(KIND=JPIM), PARAMETER :: NG27 = 4
+!INTEGER(KIND=JPIM), PARAMETER :: NG28 = 3
+!INTEGER(KIND=JPIM), PARAMETER :: NG29 = 6
+!-------------------------------------------------------------------------------
+!-- configuration with 14 spectral intervals
+!   and a total of 112 g-points (14xvariable number)
+!
+!INTEGER(KIND=JPIM), PARAMETER :: JPGPT  = 112
+!
+!INTEGER(KIND=JPIM), PARAMETER :: NG16 = 6
+!INTEGER(KIND=JPIM), PARAMETER :: NG17 = 12
+!INTEGER(KIND=JPIM), PARAMETER :: NG18 = 8
+!INTEGER(KIND=JPIM), PARAMETER :: NG19 = 8
+!INTEGER(KIND=JPIM), PARAMETER :: NG20 = 10
+!INTEGER(KIND=JPIM), PARAMETER :: NG21 = 10
+!INTEGER(KIND=JPIM), PARAMETER :: NG22 = 2
+!INTEGER(KIND=JPIM), PARAMETER :: NG23 = 10
+!INTEGER(KIND=JPIM), PARAMETER :: NG24 = 8
+!INTEGER(KIND=JPIM), PARAMETER :: NG25 = 6
+!INTEGER(KIND=JPIM), PARAMETER :: NG26 = 6
+!INTEGER(KIND=JPIM), PARAMETER :: NG27 = 8
+!INTEGER(KIND=JPIM), PARAMETER :: NG28 = 6
+!INTEGER(KIND=JPIM), PARAMETER :: NG29 = 12
+
+!-------------------------------------------------------------------------------
+!-- configuration with 14 spectral intervals 
+!   and a total of 224 g-points (14x16)
+! 
+!INTEGER(KIND=JPIM), PARAMETER :: JPGPT  = 224
+
+!INTEGER(KIND=JPIM), PARAMETER :: NG16 = 16
+!INTEGER(KIND=JPIM), PARAMETER :: NG17 = 16
+!INTEGER(KIND=JPIM), PARAMETER :: NG18 = 16
+!INTEGER(KIND=JPIM), PARAMETER :: NG19 = 16
+!INTEGER(KIND=JPIM), PARAMETER :: NG20 = 16
+!INTEGER(KIND=JPIM), PARAMETER :: NG21 = 16
+!INTEGER(KIND=JPIM), PARAMETER :: NG22 = 16
+!INTEGER(KIND=JPIM), PARAMETER :: NG23 = 16
+!INTEGER(KIND=JPIM), PARAMETER :: NG24 = 16
+!INTEGER(KIND=JPIM), PARAMETER :: NG25 = 16
+!INTEGER(KIND=JPIM), PARAMETER :: NG26 = 16
+!INTEGER(KIND=JPIM), PARAMETER :: NG27 = 16
+!INTEGER(KIND=JPIM), PARAMETER :: NG28 = 16
+!INTEGER(KIND=JPIM), PARAMETER :: NG29 = 16
+
+!     ------------------------------------------------------------------
+END MODULE PARSRTM
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/privpub.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/privpub.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/privpub.h	(revision 3908)
@@ -0,0 +1,649 @@
+/**
+ * (C) Copyright 2014- ECMWF.
+ *
+ * This software is licensed under the terms of the Apache Licence Version 2.0
+ * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+ *
+ * In applying this licence, ECMWF does not waive the privileges and immunities
+ * granted to it by virtue of its status as an intergovernmental organisation
+ * nor does it submit to any jurisdiction.
+ */
+
+
+/* privpub.h */
+
+#ifndef _PRIVPUB_H_
+#define _PRIVPUB_H_
+
+#include <stdio.h>
+#include <stdbool.h>
+#include <string.h>
+#include <errno.h>
+#include <signal.h>
+#include <unistd.h>
+#include <sys/types.h>
+
+#if !defined(IO_BUFSIZE_DEFAULT)
+/* The default I/O-buffer size = 4MBytes (unless overridden through ioassign) */
+#define IO_BUFSIZE_DEFAULT 4194304
+#endif
+
+#define NIL "(nil)"
+
+#define PERROR(msg) \
+fprintf(stderr,"%s: %s (in %s:%d) : errno#%d\n",msg?msg:NIL,strerror(errno),__FILE__, __LINE__,errno)
+
+#if defined(VPP5000) || defined(VPP)
+/* Fujitsu VPP doesn't have snprintf, so we created one in file ifsaux/support/endian.c */
+/* For ODB/SQL compiler the same code sits in odb/compiler/odb98.c */
+extern int snprintf(char *str, size_t size, const char *format, ...);
+#endif
+
+#if defined(NO_TRUNC) || defined(VPP) || defined(SV2)
+/* For systems without trunc() -function [an extension of ANSI-C, but usually available] */
+#define trunc(x) ((x) - fmod((x),1))
+#else
+#if !defined(__cplusplus)
+  extern double trunc(double d);
+#endif
+#endif
+
+#define PRIVATE static
+#define PUBLIC
+
+/* fprintf even if "fp" was NULL */
+extern int ODB_fprintf(FILE *fp, const char *format, ...);
+
+/* Fortran90 compatible NINT-function */
+
+#define F90nint(x) ( ((x) > 0) ? (int)((x) + 0.5) : (int)((x) - 0.5) )
+
+/* Pi related stuff */
+
+#define pi ((double)3.14159265358979323844e0)
+#define half_pi           (pi / 2)
+#define two_pi            (2 * pi)
+#define four_pi           (4 * pi)
+#define pi_over_180       (pi/180)
+#define recip_pi_over_180 (180/pi)
+
+/* Radians to degrees & degrees to radians (formerly in odb.h) */
+
+#define R2D(x) ( (180/pi) * ( ((x) >  pi) ? ((x) - 2*pi) : (x) ) )
+#define D2R(x) ( (pi/180) * ( ((x) > 180) ? ((x) -  360) : (x) ) )
+
+/* Radius of the Earth both in meters and kilometres (formerly in odb.h) */
+
+#define R_Earth    ((double)6371000e0)
+#define R_Earth_km ((double)6371e0)
+
+/* Some common things ... */
+
+#undef MIN
+#define MIN(a,b) ( ((a) < (b)) ? (a) :  (b) )
+
+#undef MAX
+#define MAX(a,b) ( ((a) > (b)) ? (a) :  (b) )
+
+#undef ABS
+#define ABS(x)   ( ((x) >= 0)  ? (x) : -(x) )
+
+#undef RNDUP_DIV
+#define RNDUP_DIV(i,n) (( (i) + (n) - 1 ) / (n))
+
+#undef RNDUP
+#define RNDUP(i,n) ( RNDUP_DIV(i,n) * (n))
+
+#define STRLEN(x)  (((const char *)(x)) ? (int)strlen(x) : (int)0)
+
+#define _POOLNO  "$pool#"
+#define _NPOOLS  "$npools#"
+#define _NTABLES "$ntables#"
+#define _UNIQNUM "$uniq#"
+#define _ROWNUM  "$row#"
+#define _COLNUM  "$col#"
+#define _NROWS   "$nrows#"
+#define _NCOLS   "$ncols#"
+
+#define IS_BSNUM(s)  ((s) && *(s) == '\\' && STRLEN(s) >= 2 && isdigit((s)[1]))
+#define IS_HASH(s)   ((s) && *(s) == '#')
+#define IS_DOLLAR(s) ((s) && *(s) == '$')
+#define IS_TABLE(s) ((s) && (s)[0] == '@')
+
+#define IS_POOLNO(s) ((s) && (((s)[0] == '$' && (s)[1] == '#')|| strequ(s,_POOLNO)))
+#define IS_(sym,s) strequ(s,_##sym)
+#define IS_USDHASH(s) ((s) && (s)[0] == '$' && (s)[STRLEN(s)-1] == '#')
+#define IS_USDDOTHASH(s) (IS_USDHASH(s) && strchr(s,'.') && (strchr(s,'.') == strrchr(s,'.')))
+
+static const char ODB_OFFSET_CHAR[] = "#";
+#define GET_OFFSET(s) ((!(s) || IS_DOLLAR(s) || IS_HASH(s) || IS_USDHASH(s)) ? NULL : strrchr(s,*ODB_OFFSET_CHAR))
+
+/* Timers */
+
+extern double util_cputime_();
+extern double util_walltime_();
+
+#ifdef RS6K
+extern void xl__trbk_();
+#else
+#define xl__trbk_()
+#endif
+
+extern void abor1fl_(const char *filename, const int *linenum, 
+		     const char *s, 
+		     int filenamelen, int slen);
+extern void abor1_(const char *s, int slen);
+
+#define ABOR1(txt) { \
+  const char *t = (txt); \
+  xl__trbk_(); t ? abor1_(t, strlen(t)) : abor1_("",0); }
+
+#define ABOR1FL(txt) { \
+  const char *t = (txt); \
+  int linenum=__LINE__; \
+  t ? abor1fl_(__FILE__, &linenum,  t, sizeof(__FILE__)-1, strlen(t)) \
+    : abor1fl_(__FILE__, &linenum, "", sizeof(__FILE__)-1, 0); \
+  _exit(1); /* Should never end up here */ }
+
+#define RAISE(x) { \
+  xl__trbk_(); \
+  if ((x) == SIGABRT) { \
+    const char *txt = "*** Fatal error; aborting (SIGABRT) ..."; \
+    ABOR1FL(txt); \
+    _exit(1); /* Should never end up here */ \
+  } \
+  else raise(x); \
+}
+
+/* No. of bits for "int" */
+#define MAXBITS 32
+
+/* No. of bits per 1-byte */
+#define BITS_PER_BYTE 8
+
+#ifndef O_LOCK_DONE
+#define O_LOCK_DONE
+
+/* OpenMP/ODB lock type */
+/* Keep consistent with "ifsaux/include/drhook.h" */
+/* Be ALSO consistent with OML_LOCK_KIND in ifsaux/module/oml_mod.F90 */
+
+typedef long long int o_lock_t; /* i.e. 64-bit integer */
+
+#define INIT_LOCKID_WITH_NAME(mylock, lockname) \
+  coml_init_lockid_with_name_(mylock, lockname, strlen(lockname))
+
+extern void coml_set_debug_(const int *konoff, int *kret);
+extern void coml_init_lock_();
+extern void coml_init_lockid_(o_lock_t *mylock);
+extern void coml_init_lockid_with_name_(o_lock_t *mylock, const char *name, int name_len);
+extern void coml_set_lock_();
+extern void coml_set_lockid_(o_lock_t *mylock);
+extern void coml_unset_lock_();
+extern void coml_unset_lockid_(o_lock_t *mylock);
+extern void coml_test_lock_(int *is_set);
+extern void coml_test_lockid_(int *is_set, o_lock_t *mylock);
+extern void coml_in_parallel_(int *is_parallel_region);
+
+#endif /* #ifndef O_LOCK_DONE */
+
+/* OpenMP-stuff */
+
+/* My thread-id [1 .. $OMP_NUM_THREADS] as in ifsaux/module/oml_mod.F90 */
+extern int
+get_thread_id_(); /* From "ifsaux/utilities/get_thread_id.F90" */
+
+/* Static number of threads allocated i.e. $OMP_NUM_THREADS */
+extern int
+get_max_threads_(); /* From "ifsaux/utilities/get_max_threads.F90" */
+
+/* The current number of threads allocated <= $OMP_NUM_THREADS */
+extern int
+get_num_threads_(); /* From "ifsaux/utilities/get_num_threads.F90" */
+
+#define DEF_IT    int it = get_thread_id_()
+#define IT        (it-1)
+#define DEF_INUMT int inumt = get_max_threads_()
+
+/* 0 (zero) Celsius in Kelvin */
+
+#define ZERO_POINT ((double)273.15e0)
+
+/* Aggregate function flags */
+
+#define ODB_AGGR_NONE            0x0000000
+
+#define ODB_AGGRMASK_DISTINCT    0x0100000
+#define ODB_AGGRMASK_BOOLEAN     0x1000000
+
+#define ODB_AGGR_COUNT           0x0000001
+#define ODB_AGGR_COUNT_DISTINCT  (ODB_AGGRMASK_DISTINCT | ODB_AGGR_COUNT)
+
+#define ODB_AGGR_BCOUNT          (ODB_AGGRMASK_BOOLEAN | ODB_AGGR_COUNT)
+#define ODB_AGGR_BCOUNT_DISTINCT (ODB_AGGRMASK_BOOLEAN | ODB_AGGR_COUNT_DISTINCT)
+
+#define ODB_AGGR_MIN             0x0000002
+#define ODB_AGGR_MAX             0x0000004
+
+#define ODB_AGGR_SUM             0x0000008
+#define ODB_AGGR_SUM_DISTINCT    (ODB_AGGRMASK_DISTINCT | ODB_AGGR_SUM)
+
+#define ODB_AGGR_AVG             0x0000010
+#define ODB_AGGR_AVG_DISTINCT    (ODB_AGGRMASK_DISTINCT | ODB_AGGR_AVG)
+
+#define ODB_AGGR_STDEV           0x0000020
+#define ODB_AGGR_STDEV_DISTINCT  (ODB_AGGRMASK_DISTINCT | ODB_AGGR_STDEV)
+
+#define ODB_AGGR_RMS             0x0000040
+#define ODB_AGGR_RMS_DISTINCT    (ODB_AGGRMASK_DISTINCT | ODB_AGGR_RMS)
+
+#define ODB_AGGR_DOTP            0x0000080
+#define ODB_AGGR_DOTP_DISTINCT   (ODB_AGGRMASK_DISTINCT | ODB_AGGR_DOTP)
+
+#define ODB_AGGR_NORM            0x0000100
+#define ODB_AGGR_NORM_DISTINCT   (ODB_AGGRMASK_DISTINCT | ODB_AGGR_NORM)
+
+#define ODB_AGGR_VAR             0x0000200
+#define ODB_AGGR_VAR_DISTINCT    (ODB_AGGRMASK_DISTINCT | ODB_AGGR_VAR)
+
+#define ODB_AGGR_COVAR           0x0000400
+#define ODB_AGGR_CORR            0x0000800
+
+#define ODB_AGGR_LINREGR_A       0x0001000
+#define ODB_AGGR_LINREGR_B       0x0002000
+
+#define ODB_AGGR_MEDIAN          0x0010000
+#define ODB_AGGR_MEDIAN_DISTINCT (ODB_AGGRMASK_DISTINCT | ODB_AGGR_MEDIAN)
+
+#define ODB_AGGR_MINLOC          0x0020000
+#define ODB_AGGR_MAXLOC          0x0040000
+
+#define ODB_AGGR_DENSITY         0x0080000
+
+#define ODB_tag_delim ";"
+
+
+#ifdef __cplusplus
+    typedef bool Bool;
+#else
+/*  typedef enum { false=0, true=1 } Bool; */
+    typedef _Bool Bool; /* Std on C99 */
+#endif
+
+/* char : Normally occupies 1 byte */
+
+typedef unsigned int  boolean;
+
+typedef boolean Boolean;
+
+typedef unsigned char  byte;
+typedef byte           byte1;
+#if !defined(RS6K)
+typedef unsigned char uchar;
+#endif
+typedef char            integer1;
+typedef unsigned char  uinteger1;
+
+/* short : Normally occupies 2 bytes */
+
+typedef short           integer2;
+#if !defined(RS6K) && !defined(LINUX) && !defined(HPPA) && !defined(VPP) && !defined(SUN4) && !defined(NECSX) && !defined(SV2)
+typedef unsigned short int ushort;
+#endif
+typedef unsigned short uinteger2;
+
+/* int : Normally occupies 4 bytes */
+
+/* typedef unsigned int uint; (defined via system include files) */
+typedef int             integer4;
+typedef unsigned int   uinteger4;
+
+/* typedef unsigned long ulong; (defined via system include files) */
+
+/* long long: A non-standard way to access 8 byte integer(s) */
+
+typedef          long long int  longlong;
+typedef          long long int  ll_t;
+typedef unsigned long long int ulonglong;
+typedef unsigned long long int u_ll_t;
+typedef          long long int  integer8;
+typedef unsigned long long int uinteger8;
+
+/* float : 32-bit flp (normally IEEE-754), 4 bytes */
+
+typedef float           real4;
+
+/* double : 64-bit flp (normally IEEE-754), 8 bytes */
+
+typedef double          real8;
+
+/* Formula alias double : For use by SELECT-expressions (29-Jun-2006/SS) */
+
+typedef double          Formula;
+
+/* Supported data types */
+/* Moved here from odb.h on 7-Jan-2004/SS */
+
+typedef int number;
+typedef int pk1int;
+typedef int pk2int;
+typedef int pk3int;
+typedef int pk4int;
+typedef int pk5int;
+typedef int pk9int;
+
+typedef pk1int linkoffset_t; /* also follows packing#1 */
+typedef pk1int linklen_t;    /* also follows packing#1 */
+
+/* 
+   typedef unsigned int Bitfield;
+   typedef unsigned int hex4;
+
+   We can't have (at least the above) unsigned ints since the following 
+   substitution for unsigned int u and double d gets incorrect on RS6K,
+   when d < 0 [... the IBM-s.o.b. RS6K sets the result to zero !!]
+
+   u = d ;
+
+   what appears to be working is, but very weird is:
+   u = (int)d;
+
+   but we don't want to use this cast-operator, since its introduction 
+   would add even more confusion
+
+   ==> lets make Bitfield and hex4 signed ints (29-May-2002/SS)
+
+*/
+
+typedef int Bitfield;
+typedef int hex4;
+
+typedef hex4 bufr;
+typedef hex4 grib;
+
+typedef integer4 integer;
+
+/* These inherit corresponding packing method */
+
+typedef pk1int yyyymmdd;
+typedef pk1int hhmmss;
+
+typedef double pk2real;
+typedef double pk3real;
+typedef double pk4real;
+typedef double pk5real;
+typedef double pk9real;
+typedef pk3real string;
+/* typedef double string; */
+
+typedef double pk11real;
+typedef double pk12real;
+typedef double pk13real;
+typedef double pk14real;
+typedef double pk15real;
+typedef double pk16real;
+typedef double pk17real;
+typedef double pk18real;
+typedef double pk19real;
+
+typedef double pk21real;
+typedef double pk22real;
+typedef double pk23real;
+typedef double pk24real;
+typedef double pk25real;
+typedef double pk26real;
+typedef double pk27real;
+typedef double pk28real;
+typedef double pk29real;
+
+typedef double pk31real;
+typedef double pk32real;
+typedef double pk33real;
+typedef double pk34real;
+typedef double pk35real;
+typedef double pk36real;
+typedef double pk37real;
+typedef double pk38real;
+typedef double pk39real;
+
+typedef real8 real;
+
+/* S2D-business */
+
+#define S2D     "S2D_"
+#define S2DLEN  (sizeof(S2D)-1) /* i.e. strlen(S2D) */
+
+#define S2Dlc     "s2d_"
+#define S2DlcLEN  (sizeof(S2Dlc)-1) /* i.e. strlen(S2Dlc) */
+
+#define S2D_all_blanks (0x2020202020202020ull)
+
+typedef union {
+  double dval;
+  u_ll_t llu;
+  uint ival[2];
+  char str[9];
+  char *saddr;
+} S2D_Union;
+
+typedef struct {
+  uint ival[2];
+} S2D_Type;
+
+#define MASK_0           0U  /*                                 0 */
+#define MASK_1           1U  /*                                 1 */
+#define MASK_2           3U  /*                                11 */
+#define MASK_3           7U  /*                               111 */
+#define MASK_4          15U  /*                              1111 */
+#define MASK_5          31U  /*                             11111 */
+#define MASK_6          63U  /*                            111111 */
+#define MASK_7         127U  /*                           1111111 */
+#define MASK_8         255U  /*                          11111111 */
+#define MASK_9         511U  /*                         111111111 */
+#define MASK_10       1023U  /*                        1111111111 */
+#define MASK_11       2047U  /*                       11111111111 */
+#define MASK_12       4095U  /*                      111111111111 */
+#define MASK_13       8191U  /*                     1111111111111 */
+#define MASK_14      16383U  /*                    11111111111111 */
+#define MASK_15      32767U  /*                   111111111111111 */
+#define MASK_16      65535U  /*                  1111111111111111 */
+#define MASK_17     131071U  /*                 11111111111111111 */
+#define MASK_18     262143U  /*                111111111111111111 */
+#define MASK_19     524287U  /*               1111111111111111111 */
+#define MASK_20    1048575U  /*              11111111111111111111 */
+#define MASK_21    2097151U  /*             111111111111111111111 */
+#define MASK_22    4194303U  /*            1111111111111111111111 */
+#define MASK_23    8388607U  /*           11111111111111111111111 */
+#define MASK_24   16777215U  /*          111111111111111111111111 */
+#define MASK_25   33554431U  /*         1111111111111111111111111 */
+#define MASK_26   67108863U  /*        11111111111111111111111111 */
+#define MASK_27  134217727U  /*       111111111111111111111111111 */
+#define MASK_28  268435455U  /*      1111111111111111111111111111 */
+#define MASK_29  536870911U  /*     11111111111111111111111111111 */
+#define MASK_30 1073741823U  /*    111111111111111111111111111111 */
+#define MASK_31 2147483647U  /*   1111111111111111111111111111111 */
+#define MASK_32 4294967295U  /*  11111111111111111111111111111111 */
+
+#define MASK(n) MASK_##n
+
+#define IOR(x,y)   ((x) | (y))
+#define IAND(x,y)  ((x) & (y))
+
+#define ISHFTL(x,n) ((x) << (n))
+#define ISHFTR(x,n) ((x) >> (n))
+
+#define GET_BITS(x, pos, len)      IAND(ISHFTR((int)(x), pos), MASK(len))
+
+#define PUT_BITS(to, x, pos, len) \
+  to = IOR(IAND(to, ~(ISHFTL(MASK(len), pos))), \
+           IAND((int)(x), ISHFTL(MASK(len), pos)))
+
+#define BYTESIZE(x) (x##len * sizeof(*x))
+#define BYTESIZE2(x,elemsize) (x##len * (elemsize))
+
+typedef struct {
+#ifdef LITTLE
+  unsigned int pmethod:8; /* Value 0 .. 255 ; 
+			     0 means not packed;
+			     1,2,3,5,9,11-19,21-29 methods implemented
+			     255 means not really packed, but PCMA-header exists for MDI's */
+
+  unsigned int signbit:1;  /* signed = 1, unsigned = 0 */
+
+  unsigned int byte_swappable:1; /* byte swapping applicable = 1, N/A i.e. raw data = 0 */
+
+  unsigned int precision_bits:6; /* power of 2 for length of data; range = [0..63] bits */
+
+  unsigned int base_type:2; /* other = 0, int = 1, flp = 2, complex flp = 3 
+			       notes: 
+			       - if other, look for other_type
+			       - precion_bits used for length as 2^precision_bits
+			       - if int, check also signed/unsigned part
+			    */
+  
+  unsigned int other_type:14; /* used when base_type == 0 ; currently defined
+				 undefined   = 00 000 000 000 000 =     0 = 0x0
+				 Bitfield    = 00 000 000 000 001 =     1 = 0x1
+				 (note: also precision_bits must be 5 i.e. 2^5 == 32; 
+				 preferably unsigned)
+				 string      = 00 000 000 000 010 =     2 = 0x2 
+				 (note: alias to char(8); 
+				 also precision_bits should be 3 i.e. 2^3 == 8 bytes;
+				 byte_swappable must be == 0 i.e. raw)
+				 yyyymmdd    = 00 000 000 000 100 =     4 = 0x4
+				 (note: preferably unsigned)
+				 hhmmss      = 00 000 000 001 000 =     8 = 0x8
+				 (note: preferably unsigned)
+				 linkoffset_t = 00 000 000 010 000 =    16 = 0x10
+				 (note: preferably unsigned)
+				 linklen_t    = 00 000 000 100 000 =    32 = 0x20
+				 (note: preferably unsigned)
+				 bufr-data   = 00 000 001 000 000 =    64 = 0x40
+				 (note: also byte_swappable must be == 0 i.e. raw;
+				 also precision_bits must be 5 i.e. 2^5 == 32)
+				 grib-data   = 00 000 010 000 000 =   128 = 0x80
+				 (note: also byte_swappable must be == 0 i.e. raw;
+				 also precision_bits must be 5 i.e. 2^5 == 32)
+				 blob        = 00 000 100 000 000 =   256 = 0x100
+				 (note: precision_bits used for length; up to 2^16 bytes; enough ?;
+				 byte_swappable must be == 0 i.e. raw)
+				 long blob   = 00 001 000 000 000 =  512 = 0x200
+				 (note: precision_bits used for length; up to 2^31 bytes; enough ?;
+				 byte_swappable must be == 0 i.e. raw)
+				 char        = 00 010 000 000 000 =  1024 = 0x400
+				 (note: precision_bits used for length;
+				 byte_swappable must be == 0 i.e. raw)
+				 varchar     = 00 100 000 000 000 =  2048 = 0x800
+				 (note: precision_bits used for maximum length;
+				 byte_swappable must be == 0 i.e. raw)
+				 reserved_1  = 01 000 000 000 000 =  4096 = 0x1000
+				 reserved_2  = 10 000 000 000 000 =  8192 = 0x2000
+			      */ 
+#else /* Big endian */
+  unsigned int other_type:14;
+  unsigned int base_type:2;
+  unsigned int precision_bits:6;
+  unsigned int byte_swappable:1;
+  unsigned int signbit:1;
+  unsigned int pmethod:8;
+#endif
+} odb_types_t;
+
+PUBLIC uint get_dtnum(const char *dt);
+PUBLIC  int get_dtsize(const char *dt);
+
+#define EXTRACT_PMETHOD(x)   GET_BITS(x,0,8)
+#define EXTRACT_DATATYPE(x)  GET_BITS(x,8,24)
+#define EXTRACT_SIGNBIT(x)   GET_BITS(x,8,1)
+#define EXTRACT_SWAPPABLE(x) GET_BITS(x,9,1)
+#define EXTRACT_PRECISION(x) GET_BITS(x,10,6)
+#define EXTRACT_BASETYPE(x)  GET_BITS(x,16,2)
+#define EXTRACT_OTHERTYPE(x) GET_BITS(x,18,14)
+
+/* The following is a product of ../tools/typebits.c -program output */
+
+/* signbit=0, byte_swappable=0, precision_bits=0, base_type=0, other_type=0x0 (0) */
+#define DATATYPE_UNDEF                0x0          /* (0 dec) undef */
+
+/* signbit=0, byte_swappable=0, precision_bits=0, base_type=1, other_type=0x0 (0) */
+#define DATATYPE_BIT                  0x100        /* (256 dec) bit : 1 bits, 0 bytes */
+
+/* signbit=1, byte_swappable=1, precision_bits=3, base_type=1, other_type=0x0 (0) */
+#define DATATYPE_INT1                 0x10f        /* (271 dec) char : 8 bits, 1 bytes */
+
+/* signbit=1, byte_swappable=1, precision_bits=4, base_type=1, other_type=0x0 (0) */
+#define DATATYPE_INT2                 0x113        /* (275 dec) short : 16 bits, 2 bytes */
+
+/* signbit=1, byte_swappable=1, precision_bits=5, base_type=1, other_type=0x0 (0) */
+#define DATATYPE_INT4                 0x117        /* (279 dec) int : 32 bits, 4 bytes */
+
+/* signbit=1, byte_swappable=1, precision_bits=6, base_type=1, other_type=0x0 (0) */
+#define DATATYPE_INT8                 0x11b        /* (283 dec) long long : 64 bits, 8 bytes */
+
+/* signbit=0, byte_swappable=1, precision_bits=3, base_type=1, other_type=0x0 (0) */
+#define DATATYPE_UINT1                0x10e        /* (270 dec) uchar : 8 bits, 1 bytes */
+
+/* signbit=0, byte_swappable=1, precision_bits=4, base_type=1, other_type=0x0 (0) */
+#define DATATYPE_UINT2                0x112        /* (274 dec) ushort : 16 bits, 2 bytes */
+
+/* signbit=0, byte_swappable=1, precision_bits=5, base_type=1, other_type=0x0 (0) */
+#define DATATYPE_UINT4                0x116        /* (278 dec) uint : 32 bits, 4 bytes */
+
+/* signbit=0, byte_swappable=1, precision_bits=6, base_type=1, other_type=0x0 (0) */
+#define DATATYPE_UINT8                0x11a        /* (282 dec) ulonglong : 64 bits, 8 bytes */
+
+/* signbit=0, byte_swappable=1, precision_bits=5, base_type=2, other_type=0x0 (0) */
+#define DATATYPE_REAL4                0x216        /* (534 dec) float : 32 bits, 4 bytes */
+
+/* signbit=0, byte_swappable=1, precision_bits=6, base_type=2, other_type=0x0 (0) */
+#define DATATYPE_REAL8                0x21a        /* (538 dec) double : 64 bits, 8 bytes */
+
+/* signbit=0, byte_swappable=1, precision_bits=7, base_type=2, other_type=0x0 (0) */
+#define DATATYPE_REAL16               0x21e        /* (542 dec) long double : 128 bits, 16 bytes */
+
+/* signbit=0, byte_swappable=1, precision_bits=6, base_type=3, other_type=0x0 (0) */
+#define DATATYPE_CMPLX4               0x31a        /* (794 dec) complex4 : 64 bits, 8 bytes */
+
+/* signbit=0, byte_swappable=1, precision_bits=7, base_type=3, other_type=0x0 (0) */
+#define DATATYPE_CMPLX8               0x31e        /* (798 dec) complex8 : 128 bits, 16 bytes */
+
+/* signbit=0, byte_swappable=1, precision_bits=8, base_type=3, other_type=0x0 (0) */
+#define DATATYPE_CMPLX16              0x322        /* (802 dec) complex16 : 256 bits, 32 bytes */
+
+/* signbit=0, byte_swappable=1, precision_bits=5, base_type=0, other_type=0x1 (1) */
+#define DATATYPE_BITFIELD             0x416        /* (1046 dec) Bitfield : 32 bits, 4 bytes */
+
+/* signbit=0, byte_swappable=0, precision_bits=6, base_type=0, other_type=0x2 (2) */
+#define DATATYPE_STRING               0x818        /* (2072 dec) string : 64 bits, 8 bytes */
+
+/* signbit=0, byte_swappable=1, precision_bits=5, base_type=0, other_type=0x4 (4) */
+#define DATATYPE_YYYYMMDD             0x1016       /* (4118 dec) yyyymmdd : 32 bits, 4 bytes */
+
+/* signbit=0, byte_swappable=1, precision_bits=5, base_type=0, other_type=0x8 (8) */
+#define DATATYPE_HHMMSS               0x2016       /* (8214 dec) hhmmss : 32 bits, 4 bytes */
+
+/* signbit=1, byte_swappable=1, precision_bits=5, base_type=0, other_type=0x10 (16) */
+#define DATATYPE_LINKOFFSET           0x4017       /* (16407 dec) linkoffset_t : 32 bits, 4 bytes */
+
+/* signbit=1, byte_swappable=1, precision_bits=5, base_type=0, other_type=0x20 (32) */
+#define DATATYPE_LINKLEN              0x8017       /* (32791 dec) linklen_t : 32 bits, 4 bytes */
+
+/* signbit=0, byte_swappable=1, precision_bits=5, base_type=0, other_type=0x40 (64) */
+#define DATATYPE_BUFR                 0x10016      /* (65558 dec) bufr : 32 bits, 4 bytes */
+
+/* signbit=0, byte_swappable=1, precision_bits=5, base_type=0, other_type=0x80 (128) */
+#define DATATYPE_GRIB                 0x20016      /* (131094 dec) grib : 32 bits, 4 bytes */
+
+/* signbit=0, byte_swappable=0, precision_bits=19, base_type=0, other_type=0x100 (256) */
+#define DATATYPE_BLOB                 0x4004c      /* (262220 dec) blob64kB : 65536 bytes */
+
+/* signbit=0, byte_swappable=0, precision_bits=34, base_type=0, other_type=0x200 (512) */
+#define DATATYPE_LONGBLOB             0x80088      /* (524424 dec) blob2GB : 2147483648 bytes */
+
+/* signbit=0, byte_swappable=0, precision_bits=11, base_type=0, other_type=0x400 (1024) */
+#define DATATYPE_CHAR                 0x10002c     /* (1048620 dec) char(1:255) : 256 bytes */
+
+/* signbit=0, byte_swappable=0, precision_bits=11, base_type=0, other_type=0x800 (2048) */
+#define DATATYPE_VARCHAR              0x20002c     /* (2097196 dec) varchar(1:255) : 256 bytes */
+
+#endif
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_adding_ica_lw.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_adding_ica_lw.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_adding_ica_lw.F90	(revision 3908)
@@ -0,0 +1,326 @@
+! radiation_adding_ica_lw.F90 - Longwave adding method in independent column approximation
+!
+! (C) Copyright 2015- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2017-04-11  R. Hogan  Receive emission/albedo rather than planck/emissivity
+!   2017-07-12  R. Hogan  Fast adding method for if only clouds scatter
+!   2017-10-23  R. Hogan  Renamed single-character variables
+
+module radiation_adding_ica_lw
+
+  public
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Use the scalar "adding" method to compute longwave flux profiles,
+  ! including scattering, by successively adding the contribution of
+  ! layers starting from the surface to compute the total albedo and
+  ! total upward emission of the increasingly larger block of
+  ! atmospheric layers.
+  subroutine adding_ica_lw(ncol, nlev, &
+       &  reflectance, transmittance, source_up, source_dn, emission_surf, albedo_surf, &
+       &  flux_up, flux_dn)
+
+    use parkind1, only           : jprb
+    use yomhook,  only           : lhook, dr_hook
+
+    implicit none
+
+    ! Inputs
+    integer, intent(in) :: ncol ! number of columns (may be spectral intervals)
+    integer, intent(in) :: nlev ! number of levels
+
+    ! Surface emission (W m-2) and albedo
+    real(jprb), intent(in),  dimension(ncol) :: emission_surf, albedo_surf
+
+    ! Diffuse reflectance and transmittance of each layer
+    real(jprb), intent(in),  dimension(ncol, nlev)   :: reflectance, transmittance
+
+    ! Emission from each layer in an upward and downward direction
+    real(jprb), intent(in),  dimension(ncol, nlev)   :: source_up, source_dn
+
+    ! Resulting fluxes (W m-2) at half-levels: diffuse upwelling and
+    ! downwelling
+    real(jprb), intent(out), dimension(ncol, nlev+1) :: flux_up, flux_dn
+    
+    ! Albedo of the entire earth/atmosphere system below each half
+    ! level
+    real(jprb), dimension(ncol, nlev+1) :: albedo
+
+    ! Upwelling radiation at each half-level due to emission below
+    ! that half-level (W m-2)
+    real(jprb), dimension(ncol, nlev+1) :: source
+
+    ! Equal to 1/(1-albedo*reflectance)
+    real(jprb), dimension(ncol, nlev)   :: inv_denominator
+
+    ! Loop index for model level and column
+    integer :: jlev, jcol
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_adding_ica_lw:adding_ica_lw',0,hook_handle)
+
+    albedo(:,nlev+1) = albedo_surf
+
+    ! At the surface, the source is thermal emission
+    source(:,nlev+1) = emission_surf
+
+    ! Work back up through the atmosphere and compute the albedo of
+    ! the entire earth/atmosphere system below that half-level, and
+    ! also the "source", which is the upwelling flux due to emission
+    ! below that level
+    do jlev = nlev,1,-1
+      ! Next loop over columns. We could do this by indexing the
+      ! entire inner dimension as follows, e.g. for the first line:
+      !   inv_denominator(:,jlev) = 1.0_jprb / (1.0_jprb-albedo(:,jlev+1)*reflectance(:,jlev))
+      ! and similarly for subsequent lines, but this slows down the
+      ! routine by a factor of 2!  Rather, we do it with an explicit
+      ! loop.
+      do jcol = 1,ncol
+        ! Lacis and Hansen (1974) Eq 33, Shonk & Hogan (2008) Eq 10:
+        inv_denominator(jcol,jlev) = 1.0_jprb &
+             &  / (1.0_jprb-albedo(jcol,jlev+1)*reflectance(jcol,jlev))
+        ! Shonk & Hogan (2008) Eq 9, Petty (2006) Eq 13.81:
+        albedo(jcol,jlev) = reflectance(jcol,jlev) + transmittance(jcol,jlev)*transmittance(jcol,jlev) &
+             &  * albedo(jcol,jlev+1) * inv_denominator(jcol,jlev)
+        ! Shonk & Hogan (2008) Eq 11:
+        source(jcol,jlev) = source_up(jcol,jlev) &
+             &  + transmittance(jcol,jlev) * (source(jcol,jlev+1) &
+             &                    + albedo(jcol,jlev+1)*source_dn(jcol,jlev)) &
+             &                   * inv_denominator(jcol,jlev)
+      end do
+    end do
+
+    ! At top-of-atmosphere there is no diffuse downwelling radiation
+    flux_dn(:,1) = 0.0_jprb
+
+    ! At top-of-atmosphere, all upwelling radiation is due to emission
+    ! below that level
+    flux_up(:,1) = source(:,1)
+
+    ! Work back down through the atmosphere computing the fluxes at
+    ! each half-level
+    do jlev = 1,nlev
+      do jcol = 1,ncol
+        ! Shonk & Hogan (2008) Eq 14 (after simplification):
+        flux_dn(jcol,jlev+1) &
+             &  = (transmittance(jcol,jlev)*flux_dn(jcol,jlev) &
+             &     + reflectance(jcol,jlev)*source(jcol,jlev+1) &
+             &     + source_dn(jcol,jlev)) * inv_denominator(jcol,jlev)
+        ! Shonk & Hogan (2008) Eq 12:
+        flux_up(jcol,jlev+1) = albedo(jcol,jlev+1)*flux_dn(jcol,jlev+1) &
+             &            + source(jcol,jlev+1)
+      end do
+    end do
+
+    if (lhook) call dr_hook('radiation_adding_ica_lw:adding_ica_lw',1,hook_handle)
+
+  end subroutine adding_ica_lw
+
+
+  !---------------------------------------------------------------------
+  ! Use the scalar "adding" method to compute longwave flux profiles,
+  ! including scattering in cloudy layers only.
+  subroutine fast_adding_ica_lw(ncol, nlev, &
+       &  reflectance, transmittance, source_up, source_dn, emission_surf, albedo_surf, &
+       &  is_clear_sky_layer, i_cloud_top, flux_dn_clear, &
+       &  flux_up, flux_dn)
+
+    use parkind1, only           : jprb
+    use yomhook,  only           : lhook, dr_hook
+
+    implicit none
+
+    ! Inputs
+    integer, intent(in) :: ncol ! number of columns (may be spectral intervals)
+    integer, intent(in) :: nlev ! number of levels
+
+    ! Surface emission (W m-2) and albedo
+    real(jprb), intent(in),  dimension(ncol) :: emission_surf, albedo_surf
+
+    ! Diffuse reflectance and transmittance of each layer
+    real(jprb), intent(in),  dimension(ncol, nlev)   :: reflectance, transmittance
+
+    ! Emission from each layer in an upward and downward direction
+    real(jprb), intent(in),  dimension(ncol, nlev)   :: source_up, source_dn
+
+    ! Determine which layers are cloud-free
+    logical, intent(in) :: is_clear_sky_layer(nlev)
+
+    ! Index to highest cloudy layer
+    integer, intent(in) :: i_cloud_top
+
+    ! Pre-computed clear-sky downwelling fluxes (W m-2) at half-levels
+    real(jprb), intent(in), dimension(ncol, nlev+1)  :: flux_dn_clear
+
+    ! Resulting fluxes (W m-2) at half-levels: diffuse upwelling and
+    ! downwelling
+    real(jprb), intent(out), dimension(ncol, nlev+1) :: flux_up, flux_dn
+    
+    ! Albedo of the entire earth/atmosphere system below each half
+    ! level
+    real(jprb), dimension(ncol, nlev+1) :: albedo
+
+    ! Upwelling radiation at each half-level due to emission below
+    ! that half-level (W m-2)
+    real(jprb), dimension(ncol, nlev+1) :: source
+
+    ! Equal to 1/(1-albedo*reflectance)
+    real(jprb), dimension(ncol, nlev)   :: inv_denominator
+
+    ! Loop index for model level and column
+    integer :: jlev, jcol
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_adding_ica_lw:fast_adding_ica_lw',0,hook_handle)
+
+    ! Copy over downwelling fluxes above cloud from clear sky
+    flux_dn(:,1:i_cloud_top) = flux_dn_clear(:,1:i_cloud_top)
+
+    albedo(:,nlev+1) = albedo_surf
+    
+    ! At the surface, the source is thermal emission
+    source(:,nlev+1) = emission_surf
+
+    ! Work back up through the atmosphere and compute the albedo of
+    ! the entire earth/atmosphere system below that half-level, and
+    ! also the "source", which is the upwelling flux due to emission
+    ! below that level
+    do jlev = nlev,i_cloud_top,-1
+      if (is_clear_sky_layer(jlev)) then
+        ! Reflectance of this layer is zero, simplifying the expression
+        do jcol = 1,ncol
+          albedo(jcol,jlev) = transmittance(jcol,jlev)*transmittance(jcol,jlev)*albedo(jcol,jlev+1)
+          source(jcol,jlev) = source_up(jcol,jlev) &
+               &  + transmittance(jcol,jlev) * (source(jcol,jlev+1) &
+               &                    + albedo(jcol,jlev+1)*source_dn(jcol,jlev))
+        end do
+      else
+        ! Loop over columns; explicit loop seems to be faster
+        do jcol = 1,ncol
+          ! Lacis and Hansen (1974) Eq 33, Shonk & Hogan (2008) Eq 10:
+          inv_denominator(jcol,jlev) = 1.0_jprb &
+               &  / (1.0_jprb-albedo(jcol,jlev+1)*reflectance(jcol,jlev))
+          ! Shonk & Hogan (2008) Eq 9, Petty (2006) Eq 13.81:
+          albedo(jcol,jlev) = reflectance(jcol,jlev) + transmittance(jcol,jlev)*transmittance(jcol,jlev) &
+               &  * albedo(jcol,jlev+1) * inv_denominator(jcol,jlev)
+          ! Shonk & Hogan (2008) Eq 11:
+          source(jcol,jlev) = source_up(jcol,jlev) &
+               &  + transmittance(jcol,jlev) * (source(jcol,jlev+1) &
+               &                    + albedo(jcol,jlev+1)*source_dn(jcol,jlev)) &
+               &                   * inv_denominator(jcol,jlev)
+        end do
+      end if
+    end do
+
+    ! Compute the fluxes above the highest cloud
+    flux_up(:,i_cloud_top) = source(:,i_cloud_top) &
+         &                 + albedo(:,i_cloud_top)*flux_dn(:,i_cloud_top)
+    do jlev = i_cloud_top-1,1,-1
+      flux_up(:,jlev) = transmittance(:,jlev)*flux_up(:,jlev+1) + source_up(:,jlev)
+    end do
+
+    ! Work back down through the atmosphere from cloud top computing
+    ! the fluxes at each half-level
+    do jlev = i_cloud_top,nlev
+      if (is_clear_sky_layer(jlev)) then
+        do jcol = 1,ncol
+          flux_dn(jcol,jlev+1) = transmittance(jcol,jlev)*flux_dn(jcol,jlev) &
+               &               + source_dn(jcol,jlev)
+          flux_up(jcol,jlev+1) = albedo(jcol,jlev+1)*flux_dn(jcol,jlev+1) &
+               &               + source(jcol,jlev+1)
+        end do
+      else
+        do jcol = 1,ncol
+          ! Shonk & Hogan (2008) Eq 14 (after simplification):
+          flux_dn(jcol,jlev+1) &
+               &  = (transmittance(jcol,jlev)*flux_dn(jcol,jlev) &
+               &     + reflectance(jcol,jlev)*source(jcol,jlev+1) &
+               &     + source_dn(jcol,jlev)) * inv_denominator(jcol,jlev)
+          ! Shonk & Hogan (2008) Eq 12:
+          flux_up(jcol,jlev+1) = albedo(jcol,jlev+1)*flux_dn(jcol,jlev+1) &
+               &               + source(jcol,jlev+1)
+        end do
+      end if
+    end do
+
+    if (lhook) call dr_hook('radiation_adding_ica_lw:fast_adding_ica_lw',1,hook_handle)
+
+  end subroutine fast_adding_ica_lw
+
+
+  !---------------------------------------------------------------------
+  ! If there is no scattering then fluxes may be computed simply by
+  ! passing down through the atmosphere computing the downwelling
+  ! fluxes from the transmission and emission of each layer, and then
+  ! passing back up through the atmosphere to compute the upwelling
+  ! fluxes in the same way.
+  subroutine calc_fluxes_no_scattering_lw(ncol, nlev, &
+       &  transmittance, source_up, source_dn, emission_surf, albedo_surf, flux_up, flux_dn)
+
+    use parkind1, only           : jprb
+    use yomhook,  only           : lhook, dr_hook
+
+    implicit none
+
+    ! Inputs
+    integer, intent(in) :: ncol ! number of columns (may be spectral intervals)
+    integer, intent(in) :: nlev ! number of levels
+
+    ! Surface emission (W m-2) and albedo
+    real(jprb), intent(in),  dimension(ncol) :: emission_surf, albedo_surf
+
+    ! Diffuse reflectance and transmittance of each layer
+    real(jprb), intent(in),  dimension(ncol, nlev)   :: transmittance
+
+    ! Emission from each layer in an upward and downward direction
+    real(jprb), intent(in),  dimension(ncol, nlev)   :: source_up, source_dn
+
+    ! Resulting fluxes (W m-2) at half-levels: diffuse upwelling and
+    ! downwelling
+    real(jprb), intent(out), dimension(ncol, nlev+1) :: flux_up, flux_dn
+    
+    ! Loop index for model level
+    integer :: jlev
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_adding_ica_lw:calc_fluxes_no_scattering_lw',0,hook_handle)
+
+    ! At top-of-atmosphere there is no diffuse downwelling radiation
+    flux_dn(:,1) = 0.0_jprb
+
+    ! Work down through the atmosphere computing the downward fluxes
+    ! at each half-level
+    do jlev = 1,nlev
+      flux_dn(:,jlev+1) = transmittance(:,jlev)*flux_dn(:,jlev) + source_dn(:,jlev)
+    end do
+
+    ! Surface reflection and emission
+    flux_up(:,nlev+1) = emission_surf + albedo_surf * flux_dn(:,nlev+1)
+
+    ! Work back up through the atmosphere computing the upward fluxes
+    ! at each half-level
+    do jlev = nlev,1,-1
+      flux_up(:,jlev) = transmittance(:,jlev)*flux_up(:,jlev+1) + source_up(:,jlev)
+    end do
+    
+    if (lhook) call dr_hook('radiation_adding_ica_lw:calc_fluxes_no_scattering_lw',1,hook_handle)
+
+  end subroutine calc_fluxes_no_scattering_lw
+
+end module radiation_adding_ica_lw
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_adding_ica_sw.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_adding_ica_sw.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_adding_ica_sw.F90	(revision 3908)
@@ -0,0 +1,149 @@
+! radiation_adding_ica_sw.F90 - Shortwave adding method in independent column approximation
+!
+! (C) Copyright 2015- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2017-10-23  R. Hogan  Renamed single-character variables
+
+module radiation_adding_ica_sw
+
+  public
+
+contains
+
+  subroutine adding_ica_sw(ncol, nlev, incoming_toa, &
+       &  albedo_surf_diffuse, albedo_surf_direct, cos_sza, &
+       &  reflectance, transmittance, ref_dir, trans_dir_diff, trans_dir_dir, &
+       &  flux_up, flux_dn_diffuse, flux_dn_direct)
+
+    use parkind1, only           : jprb
+    use yomhook,  only           : lhook, dr_hook
+
+    implicit none
+
+    ! Inputs
+    integer, intent(in) :: ncol ! number of columns (may be spectral intervals)
+    integer, intent(in) :: nlev ! number of levels
+
+    ! Incoming downwelling solar radiation at top-of-atmosphere (W m-2)
+    real(jprb), intent(in),  dimension(ncol)         :: incoming_toa
+
+    ! Surface albedo to diffuse and direct radiation
+    real(jprb), intent(in),  dimension(ncol)         :: albedo_surf_diffuse, &
+         &                                              albedo_surf_direct
+
+    ! Cosine of the solar zenith angle
+    real(jprb), intent(in),  dimension(ncol)         :: cos_sza
+
+    ! Diffuse reflectance and transmittance of each layer
+    real(jprb), intent(in),  dimension(ncol, nlev)   :: reflectance, transmittance
+
+    ! Fraction of direct-beam solar radiation entering the top of a
+    ! layer that is reflected back up or scattered forward into the
+    ! diffuse stream at the base of the layer
+    real(jprb), intent(in),  dimension(ncol, nlev)   :: ref_dir, trans_dir_diff
+
+    ! Direct transmittance, i.e. fraction of direct beam that
+    ! penetrates a layer without being scattered or absorbed
+    real(jprb), intent(in),  dimension(ncol, nlev)   :: trans_dir_dir
+
+    ! Resulting fluxes (W m-2) at half-levels: diffuse upwelling,
+    ! diffuse downwelling and direct downwelling
+    real(jprb), intent(out), dimension(ncol, nlev+1) :: flux_up, flux_dn_diffuse, &
+         &                                              flux_dn_direct
+    
+    ! Albedo of the entire earth/atmosphere system below each half
+    ! level
+    real(jprb), dimension(ncol, nlev+1) :: albedo
+
+    ! Upwelling radiation at each half-level due to scattering of the
+    ! direct beam below that half-level (W m-2)
+    real(jprb), dimension(ncol, nlev+1) :: source
+
+    ! Equal to 1/(1-albedo*reflectance)
+    real(jprb), dimension(ncol, nlev)   :: inv_denominator
+
+    ! Loop index for model level and column
+    integer :: jlev, jcol
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_adding_ica_sw:adding_ica_sw',0,hook_handle)
+
+    ! Compute profile of direct (unscattered) solar fluxes at each
+    ! half-level by working down through the atmosphere
+    flux_dn_direct(:,1) = incoming_toa
+    do jlev = 1,nlev
+      flux_dn_direct(:,jlev+1) = flux_dn_direct(:,jlev)*trans_dir_dir(:,jlev)
+    end do
+
+    albedo(:,nlev+1) = albedo_surf_diffuse
+
+    ! At the surface, the direct solar beam is reflected back into the
+    ! diffuse stream
+    source(:,nlev+1) = albedo_surf_direct * flux_dn_direct(:,nlev+1) * cos_sza
+
+    ! Work back up through the atmosphere and compute the albedo of
+    ! the entire earth/atmosphere system below that half-level, and
+    ! also the "source", which is the upwelling flux due to direct
+    ! radiation that is scattered below that level
+    do jlev = nlev,1,-1
+      ! Next loop over columns. We could do this by indexing the
+      ! entire inner dimension as follows, e.g. for the first line:
+      !   inv_denominator(:,jlev) = 1.0_jprb / (1.0_jprb-albedo(:,jlev+1)*reflectance(:,jlev))
+      ! and similarly for subsequent lines, but this slows down the
+      ! routine by a factor of 2!  Rather, we do it with an explicit
+      ! loop.
+      do jcol = 1,ncol
+        ! Lacis and Hansen (1974) Eq 33, Shonk & Hogan (2008) Eq 10:
+        inv_denominator(jcol,jlev) = 1.0_jprb / (1.0_jprb-albedo(jcol,jlev+1)*reflectance(jcol,jlev))
+        ! Shonk & Hogan (2008) Eq 9, Petty (2006) Eq 13.81:
+        albedo(jcol,jlev) = reflectance(jcol,jlev) + transmittance(jcol,jlev) * transmittance(jcol,jlev) &
+             &                                     * albedo(jcol,jlev+1) * inv_denominator(jcol,jlev)
+        ! Shonk & Hogan (2008) Eq 11:
+        source(jcol,jlev) = ref_dir(jcol,jlev)*flux_dn_direct(jcol,jlev) &
+             &  + transmittance(jcol,jlev)*(source(jcol,jlev+1) &
+             &        + albedo(jcol,jlev+1)*trans_dir_diff(jcol,jlev)*flux_dn_direct(jcol,jlev)) &
+             &  * inv_denominator(jcol,jlev)
+      end do
+    end do
+
+    ! At top-of-atmosphere there is no diffuse downwelling radiation
+    flux_dn_diffuse(:,1) = 0.0_jprb
+
+    ! At top-of-atmosphere, all upwelling radiation is due to
+    ! scattering by the direct beam below that level
+    flux_up(:,1) = source(:,1)
+
+    ! Work back down through the atmosphere computing the fluxes at
+    ! each half-level
+    do jlev = 1,nlev
+      do jcol = 1,ncol
+        ! Shonk & Hogan (2008) Eq 14 (after simplification):
+        flux_dn_diffuse(jcol,jlev+1) &
+             &  = (transmittance(jcol,jlev)*flux_dn_diffuse(jcol,jlev) &
+             &     + reflectance(jcol,jlev)*source(jcol,jlev+1) &
+             &     + trans_dir_diff(jcol,jlev)*flux_dn_direct(jcol,jlev)) * inv_denominator(jcol,jlev)
+        ! Shonk & Hogan (2008) Eq 12:
+        flux_up(jcol,jlev+1) = albedo(jcol,jlev+1)*flux_dn_diffuse(jcol,jlev+1) &
+             &            + source(jcol,jlev+1)
+        flux_dn_direct(jcol,jlev) = flux_dn_direct(jcol,jlev)*cos_sza(jcol)
+      end do
+    end do
+    flux_dn_direct(:,nlev+1) = flux_dn_direct(:,nlev+1)*cos_sza
+
+    if (lhook) call dr_hook('radiation_adding_ica_sw:adding_ica_sw',1,hook_handle)
+
+  end subroutine adding_ica_sw
+
+end module radiation_adding_ica_sw
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_aerosol.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_aerosol.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_aerosol.F90	(revision 3908)
@@ -0,0 +1,198 @@
+! radiation_aerosol.F90 - Derived type describing aerosol
+!
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2018-04-15  R. Hogan  Add "direct" option
+!   2019-01-14  R. Hogan  Added out_of_physical_bounds routine
+
+module radiation_aerosol
+
+  use parkind1, only : jprb
+
+  implicit none
+  public
+
+  !---------------------------------------------------------------------
+  ! Type describing the aerosol content in the atmosphere
+  type aerosol_type
+     ! The mass mixing ratio of config%n_aerosol_types different
+     ! aerosol types dimensioned
+     ! (ncol,istartlev:iendlev,config%n_aerosol_types), where ncol is
+     ! the number of columns, istartlev:iendlev is the range of model
+     ! levels where aerosols are present
+     real(jprb), allocatable, dimension(:,:,:) :: &
+          &  mixing_ratio  ! mass mixing ratio (kg/kg)
+
+     ! Alternatively, if is_direct=true, the optical properties are
+     ! provided directly and are dimensioned
+     ! (nband,istartlev:iendlev,ncol)
+     real(jprb), allocatable, dimension(:,:,:) :: &
+          &  od_sw, ssa_sw, g_sw, & ! Shortwave optical properties
+          &  od_lw, ssa_lw, g_lw    ! Longwave optical properties
+
+     ! Range of levels in which the aerosol properties are provided
+     integer :: istartlev, iendlev
+
+     ! Are the optical properties going to be provided directly by the
+     ! user?
+     logical :: is_direct = .false.
+
+   contains
+     procedure :: allocate        => allocate_aerosol_arrays
+     procedure :: allocate_direct => allocate_aerosol_arrays_direct
+     procedure :: deallocate      => deallocate_aerosol_arrays
+     procedure :: out_of_physical_bounds
+  end type aerosol_type
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Allocate array for describing aerosols, although in the offline
+  ! code these are allocated when they are read from the NetCDF file
+  subroutine allocate_aerosol_arrays(this, ncol, istartlev, iendlev, ntype)
+
+    use yomhook,     only : lhook, dr_hook
+
+    class(aerosol_type), intent(inout) :: this
+    integer, intent(in)                :: ncol  ! Number of columns
+    integer, intent(in)                :: istartlev, iendlev ! Level range
+    integer, intent(in)                :: ntype ! Number of aerosol types
+    real(jprb)                         :: hook_handle
+
+    if (lhook) call dr_hook('radiation_aerosol:allocate',0,hook_handle)
+
+    allocate(this%mixing_ratio(ncol,istartlev:iendlev,ntype))
+    this%is_direct = .false.
+    this%istartlev = istartlev
+    this%iendlev   = iendlev
+
+    if (lhook) call dr_hook('radiation_aerosol:allocate',1,hook_handle)
+
+  end subroutine allocate_aerosol_arrays
+
+
+  !---------------------------------------------------------------------
+  ! Allocate arrays for describing aerosol optical properties
+  subroutine allocate_aerosol_arrays_direct(this, config, &
+       &                                    ncol, istartlev, iendlev)
+
+    use yomhook,          only : lhook, dr_hook
+    use radiation_config, only : config_type
+
+    class(aerosol_type), intent(inout) :: this
+    type(config_type),   intent(in)    :: config
+    integer, intent(in)                :: ncol  ! Number of columns
+    integer, intent(in)                :: istartlev, iendlev ! Level range
+
+    real(jprb)                         :: hook_handle
+
+    if (lhook) call dr_hook('radiation_aerosol:allocate_direct',0,hook_handle)
+
+    this%is_direct = .true.
+    this%istartlev = istartlev
+    this%iendlev   = iendlev
+
+    if (config%do_sw) then
+      allocate(this%od_sw (config%n_bands_sw,istartlev:iendlev,ncol))
+      allocate(this%ssa_sw(config%n_bands_sw,istartlev:iendlev,ncol))
+      allocate(this%g_sw  (config%n_bands_sw,istartlev:iendlev,ncol))
+    end if
+
+    if (config%do_lw) then
+      allocate(this%od_lw (config%n_bands_lw,istartlev:iendlev,ncol))
+      allocate(this%ssa_lw(config%n_bands_lw,istartlev:iendlev,ncol))
+      allocate(this%g_lw  (config%n_bands_lw,istartlev:iendlev,ncol))
+      ! If longwave scattering by aerosol is not to be represented,
+      ! then the user may wish to just provide absorption optical deth
+      ! in od_lw, in which case we must set the following two
+      ! variables to zero
+      this%ssa_lw = 0.0_jprb
+      this%g_lw = 0.0_jprb
+    end if
+
+    if (lhook) call dr_hook('radiation_aerosol:allocate_direct',1,hook_handle)
+
+  end subroutine allocate_aerosol_arrays_direct
+
+
+  !---------------------------------------------------------------------
+  ! Deallocate array
+  subroutine deallocate_aerosol_arrays(this)
+
+    use yomhook,     only : lhook, dr_hook
+
+    class(aerosol_type), intent(inout) :: this
+
+    real(jprb)                         :: hook_handle
+
+    if (lhook) call dr_hook('radiation_aerosol:deallocate',0,hook_handle)
+
+    if (allocated(this%mixing_ratio)) deallocate(this%mixing_ratio)
+    if (allocated(this%od_sw))        deallocate(this%od_sw)
+    if (allocated(this%ssa_sw))       deallocate(this%ssa_sw)
+    if (allocated(this%g_sw))         deallocate(this%g_sw)
+    if (allocated(this%od_lw))        deallocate(this%od_lw)
+    if (allocated(this%ssa_lw))       deallocate(this%ssa_lw)
+    if (allocated(this%g_lw))         deallocate(this%g_lw)
+ 
+    if (lhook) call dr_hook('radiation_aerosol:deallocate',1,hook_handle)
+
+  end subroutine deallocate_aerosol_arrays
+
+
+  !---------------------------------------------------------------------
+  ! Return .true. if variables are out of a physically sensible range,
+  ! optionally only considering columns between istartcol and iendcol
+  function out_of_physical_bounds(this, istartcol, iendcol, do_fix) result(is_bad)
+
+    use yomhook,          only : lhook, dr_hook
+    use radiation_config, only : out_of_bounds_3d
+
+    class(aerosol_type),   intent(inout) :: this
+    integer,      optional,intent(in) :: istartcol, iendcol
+    logical,      optional,intent(in) :: do_fix
+    logical                           :: is_bad
+
+    logical    :: do_fix_local
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_aerosol:out_of_physical_bounds',0,hook_handle)
+
+    if (present(do_fix)) then
+      do_fix_local = do_fix
+    else
+      do_fix_local = .false.
+    end if
+
+    is_bad =    out_of_bounds_3d(this%mixing_ratio, 'aerosol%mixing_ratio', &
+         &                       0.0_jprb, 1.0_jprb, do_fix_local, i1=istartcol, i2=iendcol) &
+         & .or. out_of_bounds_3d(this%od_sw, 'aerosol%od_sw', &
+         &                       0.0_jprb, 100.0_jprb, do_fix_local, k1=istartcol, k2=iendcol) &
+         & .or. out_of_bounds_3d(this%od_lw, 'aerosol%od_lw', &
+         &                       0.0_jprb, 100.0_jprb, do_fix_local, k1=istartcol, k2=iendcol) &
+         & .or. out_of_bounds_3d(this%ssa_sw, 'aerosol%ssa_sw', &
+         &                       0.0_jprb, 1.0_jprb, do_fix_local, k1=istartcol, k2=iendcol) &
+         & .or. out_of_bounds_3d(this%ssa_lw, 'aerosol%ssa_lw', &
+         &                       0.0_jprb, 1.0_jprb, do_fix_local, k1=istartcol, k2=iendcol) &
+         & .or. out_of_bounds_3d(this%g_sw, 'aerosol%g_sw', &
+         &                       0.0_jprb, 1.0_jprb, do_fix_local, k1=istartcol, k2=iendcol) &
+         & .or. out_of_bounds_3d(this%g_lw, 'aerosol%g_lw', &
+         &                       0.0_jprb, 1.0_jprb, do_fix_local, k1=istartcol, k2=iendcol)
+
+    if (lhook) call dr_hook('radiation_aerosol:out_of_physical_bounds',1,hook_handle)
+
+  end function out_of_physical_bounds
+  
+end module radiation_aerosol
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_aerosol_optics.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_aerosol_optics.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_aerosol_optics.F90	(revision 3908)
@@ -0,0 +1,640 @@
+! radiation_aerosol_optics.F90 - Computing aerosol optical properties
+!
+! (C) Copyright 2015- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2018-04-15  R Hogan  Add "direct" option
+
+module radiation_aerosol_optics
+
+  implicit none
+  public
+
+contains
+
+  ! Provides the elemental function "delta_eddington_extensive"
+#include "radiation_delta_eddington.h"
+
+  !---------------------------------------------------------------------
+  ! Load aerosol scattering data; this subroutine delegates to one
+  ! in radiation_aerosol_optics_data.F90
+  subroutine setup_aerosol_optics(config)
+
+    use parkind1,                      only : jprb
+    use yomhook,                       only : lhook, dr_hook
+    use radiation_config,              only : config_type
+    use radiation_aerosol_optics_data, only : aerosol_optics_type
+    use radiation_io,                  only : nulerr, radiation_abort
+
+    type(config_type), intent(inout) :: config
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_aerosol_optics:setup_aerosol_optics',0,hook_handle)
+
+    if (config%n_aerosol_types > 0) then
+      ! Load data from file and prepare to map config%n_aerosol_types
+      ! aerosol types
+      call config%aerosol_optics%setup(trim(config%aerosol_optics_file_name), &
+           &                        config%n_aerosol_types, iverbose=config%iverbosesetup)
+
+      ! Check agreement in number of bands
+      if (config%n_bands_lw /= config%aerosol_optics%n_bands_lw) then
+        write(nulerr,'(a)') '*** Error: number of longwave bands does not match aerosol optics look-up table'
+        call radiation_abort()
+      end if
+      if (config%n_bands_sw /= config%aerosol_optics%n_bands_sw) then
+        write(nulerr,'(a)') '*** Error: number of shortwave bands does not match aerosol optics look-up table'
+        call radiation_abort()
+      end if
+
+      ! Map aerosol types to those loaded from the data file
+      call config%aerosol_optics%set_types(config%i_aerosol_type_map(1:config%n_aerosol_types))
+    end if
+
+    call config%aerosol_optics%print_description(config%i_aerosol_type_map(1:config%n_aerosol_types))
+
+    if (lhook) call dr_hook('radiation_aerosol_optics:setup_aerosol_optics',1,hook_handle)
+
+  end subroutine setup_aerosol_optics
+
+
+  !---------------------------------------------------------------------
+  ! Compute aerosol optical properties and add to existing gas optical
+  ! depth and scattering properties
+  subroutine add_aerosol_optics(nlev,istartcol,iendcol, &
+       &  config, thermodynamics, gas, aerosol, & 
+       &  od_lw, ssa_lw, g_lw, od_sw, ssa_sw, g_sw)
+
+    use parkind1,                      only : jprb
+    use radiation_io,                  only : nulout, nulerr, radiation_abort
+    use yomhook,                       only : lhook, dr_hook
+    use radiation_config,              only : config_type
+    use radiation_thermodynamics,      only : thermodynamics_type
+    use radiation_gas,                 only : gas_type, IH2O, IMassMixingRatio
+    use radiation_aerosol,             only : aerosol_type
+    use radiation_constants,           only : AccelDueToGravity
+    use radiation_aerosol_optics_data, only : aerosol_optics_type, &
+         &  IAerosolClassUndefined,   IAerosolClassIgnored, &
+         &  IAerosolClassHydrophobic, IAerosolClassHydrophilic
+
+    integer, intent(in) :: nlev               ! number of model levels
+    integer, intent(in) :: istartcol, iendcol ! range of columns to process
+    type(config_type), intent(in), target :: config
+    type(thermodynamics_type),intent(in)  :: thermodynamics
+    type(gas_type),           intent(in)  :: gas
+    type(aerosol_type),       intent(in)  :: aerosol
+    ! Optical depth, single scattering albedo and asymmetry factor of
+    ! the atmosphere (gases on input, gases and aerosols on output)
+    ! for each g point. Note that longwave ssa and asymmetry and
+    ! shortwave asymmetry are all zero for gases, so are not yet
+    ! defined on input and are therefore intent(out).
+    real(jprb), dimension(config%n_g_lw,nlev,istartcol:iendcol), &
+         &   intent(inout) :: od_lw
+    real(jprb), dimension(config%n_g_lw_if_scattering,nlev,istartcol:iendcol), &
+         &   intent(out)   :: ssa_lw, g_lw
+    real(jprb), dimension(config%n_g_sw,nlev,istartcol:iendcol), &
+         &   intent(inout) :: od_sw, ssa_sw
+    real(jprb), dimension(config%n_g_sw,nlev,istartcol:iendcol), &
+         &   intent(out)   :: g_sw
+
+    ! Extinction optical depth, scattering optical depth and
+    ! asymmetry-times-scattering-optical-depth for all the aerosols at
+    ! a point in space for each spectral band of the shortwave and
+    ! longwave spectrum
+    real(jprb), dimension(config%n_bands_sw) &
+         & :: od_sw_aerosol, scat_sw_aerosol, scat_g_sw_aerosol, local_od_sw
+    real(jprb), dimension(config%n_bands_lw) :: od_lw_aerosol, local_od_lw
+    real(jprb), dimension(config%n_bands_lw_if_scattering) &
+         & :: scat_lw_aerosol, scat_g_lw_aerosol
+
+    real(jprb) :: h2o_mmr(istartcol:iendcol,nlev)
+
+    real(jprb) :: rh ! Relative humidity with respect to liquid water
+
+    ! Factor (kg m-2) to convert mixing ratio (kg kg-1) to mass in
+    ! path (kg m-2)
+    real(jprb) :: factor
+
+    ! Temporary extinction and scattering optical depths of aerosol
+    ! plus gas
+    real(jprb) :: local_od, local_scat
+
+    ! Loop indices for column, level, g point, band and aerosol type
+    integer :: jcol, jlev, jg, jtype
+
+    ! Range of levels over which aerosols are present
+    integer :: istartlev, iendlev
+
+    ! Indices to spectral band and relative humidity look-up table
+    integer :: iband, irh
+
+    ! Pointer to the aerosol optics coefficients for brevity of access
+    type(aerosol_optics_type), pointer :: ao
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_aerosol_optics:add_aerosol_optics',0,hook_handle)
+
+    if (aerosol%is_direct) then
+      ! Aerosol optical properties have been provided in each band
+      ! directly by the user
+      call add_aerosol_optics_direct(nlev,istartcol,iendcol, &
+           &  config, aerosol, & 
+           &  od_lw, ssa_lw, g_lw, od_sw, ssa_sw, g_sw)
+    else
+      ! Aerosol mixing ratios have been provided
+
+      do jtype = 1,config%n_aerosol_types
+        if (config%aerosol_optics%iclass(jtype) == IAerosolClassUndefined) then
+          write(nulerr,'(a)') '*** Error: not all aerosol types are defined'
+          call radiation_abort()
+        end if
+      end do
+
+      if (config%iverbose >= 2) then
+        write(nulout,'(a)') 'Computing aerosol absorption/scattering properties'
+      end if
+
+      ao => config%aerosol_optics
+
+      istartlev = lbound(aerosol%mixing_ratio,2)
+      iendlev   = ubound(aerosol%mixing_ratio,2)
+
+      if (ubound(aerosol%mixing_ratio,3) /= config%n_aerosol_types) then
+        write(nulerr,'(a,i0,a,i0)') '*** Error: aerosol%mixing_ratio contains ', &
+             &  ubound(aerosol%mixing_ratio,3), ' aerosol types, expected ', &
+             &  config%n_aerosol_types
+        call radiation_abort()
+      end if
+
+      ! Set variables to zero that may not have been previously
+      g_sw = 0.0_jprb
+      if (config%do_lw_aerosol_scattering) then
+        ssa_lw = 0.0_jprb
+        g_lw   = 0.0_jprb
+      end if
+
+      call gas%get(IH2O, IMassMixingRatio, h2o_mmr, istartcol=istartcol)
+
+      ! Loop over position
+      do jlev = istartlev,iendlev
+        do jcol = istartcol,iendcol
+          ! Compute relative humidity with respect to liquid
+          ! saturation and the index to the relative-humidity index of
+          ! hydrophilic-aerosol data
+          rh  = h2o_mmr(jcol,jlev) / thermodynamics%h2o_sat_liq(jcol,jlev)
+          irh = ao%calc_rh_index(rh)
+
+          factor = ( thermodynamics%pressure_hl(jcol,jlev+1) &
+               &    -thermodynamics%pressure_hl(jcol,jlev  )  ) &
+               &   / AccelDueToGravity  
+
+          ! Reset temporary arrays
+          od_sw_aerosol     = 0.0_jprb
+          scat_sw_aerosol   = 0.0_jprb
+          scat_g_sw_aerosol = 0.0_jprb
+          od_lw_aerosol     = 0.0_jprb
+          scat_lw_aerosol   = 0.0_jprb
+          scat_g_lw_aerosol = 0.0_jprb
+
+          do jtype = 1,config%n_aerosol_types
+            ! Add the optical depth, scattering optical depth and
+            ! scattering optical depth-weighted asymmetry factor for
+            ! this aerosol type to the total for all aerosols.  Note
+            ! that the following expressions are array-wise, the
+            ! dimension being spectral band.
+            if (ao%iclass(jtype) == IAerosolClassHydrophobic) then
+              local_od_sw = factor * aerosol%mixing_ratio(jcol,jlev,jtype) &
+                   &  * ao%mass_ext_sw_phobic(:,ao%itype(jtype))
+              od_sw_aerosol = od_sw_aerosol + local_od_sw
+              scat_sw_aerosol = scat_sw_aerosol &
+                   &  + local_od_sw * ao%ssa_sw_phobic(:,ao%itype(jtype))
+              scat_g_sw_aerosol = scat_g_sw_aerosol &
+                   &  + local_od_sw * ao%ssa_sw_phobic(:,ao%itype(jtype)) &
+                   &  * ao%g_sw_phobic(:,ao%itype(jtype))
+              if (config%do_lw_aerosol_scattering) then
+                local_od_lw = factor * aerosol%mixing_ratio(jcol,jlev,jtype) &
+                     &  * ao%mass_ext_lw_phobic(:,ao%itype(jtype))
+                od_lw_aerosol = od_lw_aerosol + local_od_lw
+                scat_lw_aerosol = scat_lw_aerosol &
+                     &  + local_od_lw * ao%ssa_lw_phobic(:,ao%itype(jtype))
+                scat_g_lw_aerosol = scat_g_lw_aerosol &
+                     &  + local_od_lw * ao%ssa_lw_phobic(:,ao%itype(jtype)) &
+                     &  * ao%g_lw_phobic(:,ao%itype(jtype))
+              else
+                ! If aerosol longwave scattering is not included then we
+                ! weight the optical depth by the single scattering
+                ! co-albedo
+                od_lw_aerosol = od_lw_aerosol &
+                     &  + factor * aerosol%mixing_ratio(jcol,jlev,jtype) &
+                     &  * ao%mass_ext_lw_phobic(:,ao%itype(jtype)) &
+                     &  * (1.0_jprb - ao%ssa_lw_phobic(:,ao%itype(jtype)))
+              end if
+            else if (ao%iclass(jtype) == IAerosolClassHydrophilic) then
+              ! Hydrophilic aerosols require the look-up tables to
+              ! be indexed with irh
+              local_od_sw = factor * aerosol%mixing_ratio(jcol,jlev,jtype) &
+                   &  * ao%mass_ext_sw_philic(:,irh,ao%itype(jtype))
+              od_sw_aerosol = od_sw_aerosol + local_od_sw
+              scat_sw_aerosol = scat_sw_aerosol &
+                   &  + local_od_sw * ao%ssa_sw_philic(:,irh,ao%itype(jtype))
+              scat_g_sw_aerosol = scat_g_sw_aerosol &
+                   &  + local_od_sw * ao%ssa_sw_philic(:,irh,ao%itype(jtype)) &
+                   &  * ao%g_sw_philic(:,irh,ao%itype(jtype))
+              if (config%do_lw_aerosol_scattering) then
+                local_od_lw = factor * aerosol%mixing_ratio(jcol,jlev,jtype) &
+                     &  * ao%mass_ext_lw_philic(:,irh,ao%itype(jtype))
+                od_lw_aerosol = od_lw_aerosol + local_od_lw
+                scat_lw_aerosol = scat_lw_aerosol &
+                     &  + local_od_lw * ao%ssa_lw_philic(:,irh,ao%itype(jtype))
+                scat_g_lw_aerosol = scat_g_lw_aerosol &
+                     &  + local_od_lw * ao%ssa_lw_philic(:,irh,ao%itype(jtype)) &
+                     &  * ao%g_lw_philic(:,irh,ao%itype(jtype))
+              else
+                ! If aerosol longwave scattering is not included then we
+                ! weight the optical depth by the single scattering
+                ! co-albedo
+                od_lw_aerosol = od_lw_aerosol &
+                     &  + factor * aerosol%mixing_ratio(jcol,jlev,jtype) &
+                     &  * ao%mass_ext_lw_philic(:,irh,ao%itype(jtype)) &
+                     &  * (1.0_jprb - ao%ssa_lw_philic(:,irh,ao%itype(jtype)))
+              end if
+            end if
+            ! Implicitly, if ao%iclass(jtype) == IAerosolClassNone, then
+            ! no aerosol scattering properties are added
+
+          end do ! Loop over aerosol type
+
+          if (.not. config%do_sw_delta_scaling_with_gases) then
+            ! Delta-Eddington scaling on aerosol only.  Note that if
+            ! do_sw_delta_scaling_with_gases==.true. then the delta
+            ! scaling is done to the cloud-aerosol-gas mixture inside
+            ! the solver
+            call delta_eddington_extensive(od_sw_aerosol, scat_sw_aerosol, &
+                 &                         scat_g_sw_aerosol)
+          end if
+
+          ! Combine aerosol shortwave scattering properties with gas
+          ! properties (noting that any gas scattering will have an
+          ! asymmetry factor of zero)
+          if (od_sw_aerosol(1) > 0.0_jprb) then
+            do jg = 1,config%n_g_sw
+              iband = config%i_band_from_reordered_g_sw(jg)
+              local_od = od_sw(jg,jlev,jcol) + od_sw_aerosol(iband)
+              local_scat = ssa_sw(jg,jlev,jcol) * od_sw(jg,jlev,jcol) &
+                   &  + scat_sw_aerosol(iband)
+              ! Note that asymmetry_sw of gases is zero so the following
+              ! simply weights the aerosol asymmetry by the scattering
+              ! optical depth
+              g_sw(jg,jlev,jcol) = scat_g_sw_aerosol(iband) / local_scat
+              ssa_sw(jg,jlev,jcol) = local_scat / local_od
+              od_sw (jg,jlev,jcol) = local_od
+            end do
+          end if
+
+          ! Combine aerosol longwave scattering properties with gas
+          ! properties, noting that in the longwave, gases do not
+          ! scatter at all
+          if (config%do_lw_aerosol_scattering) then
+
+            call delta_eddington_extensive(od_lw_aerosol, scat_lw_aerosol, &
+                 &                         scat_g_lw_aerosol)  
+
+            do jg = 1,config%n_g_lw
+              iband = config%i_band_from_reordered_g_lw(jg)
+              if (od_lw_aerosol(iband) > 0.0_jprb) then
+                ! All scattering is due to aerosols, therefore the
+                ! asymmetry factor is equal to the value for aerosols
+                if (scat_lw_aerosol(iband) > 0.0_jprb) then
+                  g_lw(jg,jlev,jcol) = scat_g_lw_aerosol(iband) &
+                       &  / scat_lw_aerosol(iband)
+                else
+                  g_lw(jg,jlev,jcol) = 0.0_jprb
+                end if
+                local_od = od_lw(jg,jlev,jcol) + od_lw_aerosol(iband)
+                ssa_lw(jg,jlev,jcol) = scat_lw_aerosol(iband) / local_od
+                od_lw (jg,jlev,jcol) = local_od
+              end if
+            end do
+          else
+            do jg = 1,config%n_g_lw
+              od_lw(jg,jlev,jcol) = od_lw(jg,jlev,jcol) &
+                   &  + od_lw_aerosol(config%i_band_from_reordered_g_lw(jg))
+            end do
+          end if
+
+        end do ! Loop over column
+      end do ! Loop over level
+
+    end if
+
+    if (lhook) call dr_hook('radiation_aerosol_optics:add_aerosol_optics',1,hook_handle)
+
+  end subroutine add_aerosol_optics
+
+
+  !---------------------------------------------------------------------
+  ! Add precomputed optical properties to gas optical depth and
+  ! scattering properties
+  subroutine add_aerosol_optics_direct(nlev,istartcol,iendcol, &
+       &  config, aerosol, & 
+       &  od_lw, ssa_lw, g_lw, od_sw, ssa_sw, g_sw)
+
+    use parkind1,                      only : jprb
+    use radiation_io,                  only : nulerr, radiation_abort
+    use yomhook,                       only : lhook, dr_hook
+    use radiation_config,              only : config_type
+    use radiation_aerosol,             only : aerosol_type
+
+    integer, intent(in) :: nlev               ! number of model levels
+    integer, intent(in) :: istartcol, iendcol ! range of columns to process
+    type(config_type), intent(in), target :: config
+    type(aerosol_type),       intent(in)  :: aerosol
+    ! Optical depth, single scattering albedo and asymmetry factor of
+    ! the atmosphere (gases on input, gases and aerosols on output)
+    ! for each g point. Note that longwave ssa and asymmetry and
+    ! shortwave asymmetry are all zero for gases, so are not yet
+    ! defined on input and are therefore intent(out).
+    real(jprb), dimension(config%n_g_lw,nlev,istartcol:iendcol), &
+         &   intent(inout) :: od_lw
+    real(jprb), dimension(config%n_g_lw_if_scattering,nlev,istartcol:iendcol), &
+         &   intent(out)   :: ssa_lw, g_lw
+    real(jprb), dimension(config%n_g_sw,nlev,istartcol:iendcol), &
+         &   intent(inout) :: od_sw, ssa_sw
+    real(jprb), dimension(config%n_g_sw,nlev,istartcol:iendcol), &
+         &   intent(out)   :: g_sw
+
+    ! Temporary extinction and scattering optical depths of aerosol
+    ! plus gas
+    real(jprb) :: local_od, local_scat
+
+    ! Extinction optical depth, scattering optical depth and
+    ! asymmetry-times-scattering-optical-depth for all the aerosols at
+    ! a point in space for each spectral band of the shortwave and
+    ! longwave spectrum
+    real(jprb), dimension(config%n_bands_sw) &
+         & :: od_sw_aerosol, scat_sw_aerosol, scat_g_sw_aerosol
+    real(jprb), dimension(config%n_bands_lw) :: od_lw_aerosol
+    real(jprb), dimension(config%n_bands_lw_if_scattering) &
+         & :: scat_lw_aerosol, scat_g_lw_aerosol
+
+    ! Loop indices for column, level, g point and band
+    integer :: jcol, jlev, jg
+
+    ! Range of levels over which aerosols are present
+    integer :: istartlev, iendlev
+
+    ! Indices to spectral band
+    integer :: iband
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_aerosol_optics:add_aerosol_optics_direct',0,hook_handle)
+
+    if (config%do_sw) then
+      ! Check array dimensions
+      if (ubound(aerosol%od_sw,1) /= config%n_bands_sw) then
+        write(nulerr,'(a,i0,a,i0)') '*** Error: aerosol%od_sw contains ', &
+           &  ubound(aerosol%od_sw,1), ' band, expected ', &
+           &  config%n_bands_sw
+        call radiation_abort()
+      end if
+
+      istartlev = lbound(aerosol%od_sw,2)
+      iendlev   = ubound(aerosol%od_sw,2)
+
+      ! Set variables to zero that may not have been previously
+      g_sw = 0.0_jprb
+
+      ! Loop over position
+      do jcol = istartcol,iendcol
+        do jlev = istartlev,iendlev
+          od_sw_aerosol = aerosol%od_sw(:,jlev,jcol)
+          scat_sw_aerosol = aerosol%ssa_sw(:,jlev,jcol) * od_sw_aerosol
+          scat_g_sw_aerosol = aerosol%g_sw(:,jlev,jcol) * scat_sw_aerosol
+
+          if (.not. config%do_sw_delta_scaling_with_gases) then
+            ! Delta-Eddington scaling on aerosol only.  Note that if
+            ! do_sw_delta_scaling_with_gases==.true. then the delta
+            ! scaling is done to the cloud-aerosol-gas mixture inside
+            ! the solver
+            call delta_eddington_extensive(od_sw_aerosol, scat_sw_aerosol, &
+                 &                         scat_g_sw_aerosol)
+          end if
+
+          ! Combine aerosol shortwave scattering properties with gas
+          ! properties (noting that any gas scattering will have an
+          ! asymmetry factor of zero)
+          if (od_sw_aerosol(1) > 0.0_jprb) then
+            do jg = 1,config%n_g_sw
+              iband = config%i_band_from_reordered_g_sw(jg)
+              local_od = od_sw(jg,jlev,jcol) + od_sw_aerosol(iband)
+              local_scat = ssa_sw(jg,jlev,jcol) * od_sw(jg,jlev,jcol) &
+                   &  + scat_sw_aerosol(iband)
+              ! Note that asymmetry_sw of gases is zero so the following
+              ! simply weights the aerosol asymmetry by the scattering
+              ! optical depth
+              g_sw(jg,jlev,jcol) = scat_g_sw_aerosol(iband) / local_scat
+              ssa_sw(jg,jlev,jcol) = local_scat / local_od
+              od_sw (jg,jlev,jcol) = local_od
+            end do
+          end if
+        end do
+      end do
+
+    end if
+
+    if (config%do_lw) then
+
+      if (ubound(aerosol%od_lw,1) /= config%n_bands_lw) then
+        write(nulerr,'(a,i0,a,i0)') '*** Error: aerosol%od_lw contains ', &
+           &  ubound(aerosol%od_lw,1), ' band, expected ', &
+           &  config%n_bands_lw
+        call radiation_abort()
+      end if
+
+      istartlev = lbound(aerosol%od_lw,2)
+      iendlev   = ubound(aerosol%od_lw,2)
+
+      if (config%do_lw_aerosol_scattering) then
+        ssa_lw = 0.0_jprb
+        g_lw   = 0.0_jprb
+ 
+        ! Loop over position
+        do jcol = istartcol,iendcol
+          do jlev = istartlev,iendlev
+            od_lw_aerosol = aerosol%od_lw(:,jlev,jcol)
+            scat_lw_aerosol = aerosol%ssa_lw(:,jlev,jcol) * od_lw_aerosol
+            scat_g_lw_aerosol = aerosol%g_lw(:,jlev,jcol) * scat_lw_aerosol
+            
+            call delta_eddington_extensive(od_lw_aerosol, scat_lw_aerosol, &
+                 &                         scat_g_lw_aerosol)
+            
+            do jg = 1,config%n_g_lw
+              iband = config%i_band_from_reordered_g_lw(jg)
+              if (od_lw_aerosol(iband) > 0.0_jprb) then
+                ! All scattering is due to aerosols, therefore the
+                ! asymmetry factor is equal to the value for aerosols
+                if (scat_lw_aerosol(iband) > 0.0_jprb) then
+                  g_lw(jg,jlev,jcol) = scat_g_lw_aerosol(iband) &
+                       &  / scat_lw_aerosol(iband)
+                else
+                  g_lw(jg,jlev,jcol) = 0.0_jprb
+                end if
+                local_od = od_lw(jg,jlev,jcol) + od_lw_aerosol(iband)
+                ssa_lw(jg,jlev,jcol) = scat_lw_aerosol(iband) / local_od
+                od_lw (jg,jlev,jcol) = local_od
+              end if
+            end do
+          end do
+        end do
+
+      else ! No longwave scattering
+
+        ! Loop over position
+        do jcol = istartcol,iendcol
+          do jlev = istartlev,iendlev
+            ! If aerosol longwave scattering is not included then we
+            ! weight the optical depth by the single scattering
+            ! co-albedo
+            od_lw_aerosol = aerosol%od_lw(:,jlev,jcol) &
+                 &  * (1.0_jprb - aerosol%ssa_lw(:,jlev,jcol))
+            do jg = 1,config%n_g_lw
+              od_lw(jg,jlev,jcol) = od_lw(jg,jlev,jcol) &
+                   &  + od_lw_aerosol(config%i_band_from_reordered_g_lw(jg))
+            end do
+          end do
+        end do
+
+      end if
+    end if
+
+
+    if (lhook) call dr_hook('radiation_aerosol_optics:add_aerosol_optics_direct',1,hook_handle)
+
+  end subroutine add_aerosol_optics_direct
+ 
+
+  !---------------------------------------------------------------------
+  ! Sometimes it is useful to specify aerosol in terms of its optical
+  ! depth at a particular wavelength.  This function returns the dry
+  ! shortwave mass-extinction coefficient, i.e. the extinction cross
+  ! section per unit mass, for aerosol of type "itype" at shortwave
+  ! band "iband". For hydrophilic types, the value at the first
+  ! relative humidity bin is taken.
+  function dry_aerosol_sw_mass_extinction(config, itype, iband)
+
+    use parkind1,                      only : jprb
+    use radiation_config,              only : config_type
+    use radiation_aerosol_optics_data, only : aerosol_optics_type, &
+         &  IAerosolClassUndefined,   IAerosolClassIgnored, &
+         &  IAerosolClassHydrophobic, IAerosolClassHydrophilic
+
+    type(config_type), intent(in), target :: config
+
+    ! Aerosol type and shortwave band as indices to the array
+    integer, intent(in) :: itype, iband
+    
+    real(jprb) dry_aerosol_sw_mass_extinction
+
+    ! Pointer to the aerosol optics coefficients for brevity of access
+    type(aerosol_optics_type), pointer :: ao
+
+    ao => config%aerosol_optics
+
+    if (ao%iclass(itype) == IAerosolClassHydrophobic) then
+      dry_aerosol_sw_mass_extinction = ao%mass_ext_sw_phobic(iband,ao%itype(itype))
+    else if (ao%iclass(itype) == IAerosolClassHydrophilic) then
+      ! Take the value at the first relative-humidity bin for the
+      ! "dry" aerosol value
+      dry_aerosol_sw_mass_extinction = ao%mass_ext_sw_philic(iband,1,ao%itype(itype))
+    else
+      dry_aerosol_sw_mass_extinction = 0.0_jprb
+    end if
+
+  end function dry_aerosol_sw_mass_extinction
+
+
+  !---------------------------------------------------------------------
+  ! Compute aerosol extinction coefficient at a particular shortwave
+  ! band and a single height - this is useful for visibility
+  ! diagnostics
+  subroutine aerosol_sw_extinction(ncol,istartcol,iendcol, &
+       &  config, iband, mixing_ratio, relative_humidity, extinction)
+
+    use parkind1,                      only : jprb
+    use yomhook,                       only : lhook, dr_hook
+    use radiation_io,                  only : nulerr, radiation_abort
+    use radiation_config,              only : config_type
+    use radiation_aerosol_optics_data, only : aerosol_optics_type, &
+         &  IAerosolClassUndefined,   IAerosolClassIgnored, &
+         &  IAerosolClassHydrophobic, IAerosolClassHydrophilic
+
+    integer, intent(in) :: ncol               ! number of columns
+    integer, intent(in) :: istartcol, iendcol ! range of columns to process
+    type(config_type), intent(in), target :: config
+    integer, intent(in)     :: iband ! Index of required spectral band
+    real(jprb), intent(in)  :: mixing_ratio(ncol,config%n_aerosol_types)
+    real(jprb), intent(in)  :: relative_humidity(ncol)
+    real(jprb), intent(out) :: extinction(ncol)
+
+    ! Local aerosol extinction
+    real(jprb) :: ext
+
+    ! Pointer to the aerosol optics coefficients for brevity of access
+    type(aerosol_optics_type), pointer :: ao
+    
+    ! Loop indices for column and aerosol type
+    integer :: jcol, jtype
+
+    ! Relative humidity index
+    integer :: irh
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_aerosol_optics:aerosol_sw_extinction',0,hook_handle)
+
+    do jtype = 1,config%n_aerosol_types
+      if (config%aerosol_optics%iclass(jtype) == IAerosolClassUndefined) then
+        write(nulerr,'(a)') '*** Error: not all aerosol types are defined'
+        call radiation_abort()
+      end if
+    end do
+
+    ao => config%aerosol_optics
+
+    ! Loop over position
+    do jcol = istartcol,iendcol
+      ext = 0.0_jprb
+      ! Get relative-humidity index
+      irh = ao%calc_rh_index(relative_humidity(jcol))
+      ! Add extinction coefficients from each aerosol type
+      do jtype = 1,config%n_aerosol_types
+        if (ao%iclass(jtype) == IAerosolClassHydrophobic) then
+          ext = ext + mixing_ratio(jcol,jtype) &
+               &    * ao%mass_ext_sw_phobic(iband,ao%itype(jtype))
+        else if (ao%iclass(jtype) == IAerosolClassHydrophilic) then
+          ext = ext + mixing_ratio(jcol,jtype) &
+               &    * ao%mass_ext_sw_philic(iband,irh,ao%itype(jtype))
+        end if
+      end do
+
+      extinction(jcol) = ext
+    end do
+
+    if (lhook) call dr_hook('radiation_aerosol_optics:aerosol_sw_extinction',1,hook_handle)
+
+  end subroutine aerosol_sw_extinction
+
+end module radiation_aerosol_optics
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_aerosol_optics_data.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_aerosol_optics_data.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_aerosol_optics_data.F90	(revision 3908)
@@ -0,0 +1,507 @@
+! radiation_aerosol_optics_data.F90 - Type to store aerosol optical properties
+!
+! (C) Copyright 2015- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2017-10-23  R. Hogan  Renamed single-character variables
+!   2018-04-20  A. Bozzo  Read optical properties at selected wavelengths
+
+
+module radiation_aerosol_optics_data
+
+  use parkind1,      only : jprb
+  use radiation_io,  only : nulerr, radiation_abort
+
+  implicit none
+  public
+
+  private :: get_line
+
+  ! The following provide possible values for
+  ! aerosol_optics_type%iclass, which is used to map the user's type
+  ! index to the hydrophobic or hydrophilic types loaded from the
+  ! aerosol optics file. Initially iclass is equal to
+  ! AerosolClassUndefined, which will throw an error if ever the user
+  ! tries to use this aerosol type. The user may specify that an
+  ! aerosol type is to be ignored in the radiation calculation, in
+  ! which case iclass will be set equal to AerosolClassIgnored.
+  enum, bind(c) 
+     enumerator IAerosolClassUndefined,   IAerosolClassIgnored, &
+          &     IAerosolClassHydrophobic, IAerosolClassHydrophilic
+  end enum
+
+  integer, parameter :: NMaxStringLength = 2000
+  integer, parameter :: NMaxLineLength   = 200
+
+  !---------------------------------------------------------------------
+  ! This type holds the configuration information to compute
+  ! aerosol optical properties
+  type aerosol_optics_type
+     ! A vector of length ntype, iclass maps user-defined types on to
+     ! the hydrophilic or hydrophobic aerosol classes using the
+     ! enumerators above
+     integer, allocatable, dimension(:) :: iclass
+
+     ! Also a vector of length ntype, itype maps user-defined types on
+     ! to specific hydrophilic or hydrophobic aerosol types
+     integer, allocatable, dimension(:) :: itype
+
+     ! Scattering properties are provided separately in the shortwave
+     ! and longwave for hydrophobic and hydrophilic aerosols.
+     ! Hydrophobic aerosols are dimensioned (nband,n_type_phobic):
+     real(jprb), allocatable, dimension(:,:) :: &
+          &  mass_ext_sw_phobic, & ! Mass-extinction coefficient (m2 kg-1)
+          &  ssa_sw_phobic,      & ! Single scattering albedo
+          &  g_sw_phobic,        & ! Asymmetry factor
+          &  mass_ext_lw_phobic, & ! Mass-extinction coefficient (m2 kg-1)
+          &  ssa_lw_phobic,      & ! Single scattering albedo
+          &  g_lw_phobic           ! Asymmetry factor
+
+     ! Hydrophilic aerosols are dimensioned (nband, nrh, n_type_philic):
+     real(jprb), allocatable, dimension(:,:,:) :: &
+          &  mass_ext_sw_philic, & ! Mass-extinction coefficient (m2 kg-1)
+          &  ssa_sw_philic,      & ! Single scattering albedo
+          &  g_sw_philic,        & ! Asymmetry factor
+          &  mass_ext_lw_philic, & ! Mass-extinction coefficient (m2 kg-1)
+          &  ssa_lw_philic,      & ! Single scattering albedo
+          &  g_lw_philic           ! Asymmetry factor
+
+     ! Scattering properties at selected wavelengths
+     ! (n_mono_wl,n_type_phobic/philic)
+     real(jprb), allocatable, dimension(:,:) :: &
+          &  mass_ext_mono_phobic, & ! Mass-extinction coefficient (m2 kg-1)
+          &  ssa_mono_phobic,      & ! Single scattering albedo
+          &  g_mono_phobic,        & ! Asymmetry factor
+          &  lidar_ratio_mono_phobic ! Lidar Ratio
+     real(jprb), allocatable, dimension(:,:,:) :: &
+          &  mass_ext_mono_philic, & ! Mass-extinction coefficient (m2 kg-1)
+          &  ssa_mono_philic,      & ! Single scattering albedo
+          &  g_mono_philic,        & ! Asymmetry factor
+          &  lidar_ratio_mono_philic ! Lidar Ratio
+
+     ! For hydrophilic aerosols, the lower bounds of the relative
+     ! humidity bins is a vector of length nrh:
+     real(jprb), allocatable, dimension(:) :: &
+          &  rh_lower    ! Dimensionless (1.0 = 100% humidity)
+
+     ! Strings describing the aerosol types
+     character(len=NMaxStringLength) :: description_phobic_str = ' '
+     character(len=NMaxStringLength) :: description_philic_str = ' '
+
+     ! The number of user-defined aerosol types
+     integer :: ntype
+
+     ! The number of hydrophobic and hydrophilic types read from the
+     ! aerosol optics file
+     integer :: n_type_phobic, n_type_philic
+
+     ! Number of relative humidity bins
+     integer :: nrh
+
+     ! Number of longwave and shortwave bands of the data in the file,
+     ! and monochromatic wavelengths
+     integer :: n_bands_lw = 0, n_bands_sw = 0, n_mono_wl = 0
+
+     ! Do we have any hydrophilic types?
+     logical :: use_hydrophilic = .true.
+
+     ! Do we have monochromatic optical properties
+     logical :: use_monochromatic = .false.
+
+   contains
+     procedure :: setup => setup_aerosol_optics
+     procedure :: set_hydrophobic_type
+     procedure :: set_hydrophilic_type
+     procedure :: set_empty_type
+     procedure :: set_types
+     procedure :: calc_rh_index
+     procedure :: print_description
+
+  end type aerosol_optics_type
+
+contains
+
+
+  !---------------------------------------------------------------------
+  ! Setup aerosol optics coefficients by reading them from a file
+  subroutine setup_aerosol_optics(this, file_name, ntype, iverbose)
+
+    use yomhook,              only : lhook, dr_hook
+    use easy_netcdf,          only : netcdf_file
+    use radiation_io,         only : nulerr, radiation_abort
+
+    class(aerosol_optics_type), intent(inout) :: this
+    character(len=*), intent(in)              :: file_name
+    integer, intent(in)                       :: ntype
+    integer, intent(in), optional             :: iverbose
+
+    ! The NetCDF file containing the aerosol optics data
+    type(netcdf_file)  :: file
+    integer            :: iverb
+    real(jprb)         :: hook_handle
+
+    if (lhook) call dr_hook('radiation_aerosol_optics_data:setup',0,hook_handle)
+
+    if (present(iverbose)) then
+       iverb = iverbose
+    else
+       iverb = 2
+    end if
+
+    ! Open the aerosol scattering file and configure the way it is
+    ! read
+    call file%open(trim(file_name), iverbose=iverb)
+
+    if (file%exists('mass_ext_sw_hydrophilic')) then
+      this%use_hydrophilic = .true.
+    else
+      this%use_hydrophilic = .false.
+    end if
+
+    ! Read the raw scattering data
+    call file%get('mass_ext_sw_hydrophobic', this%mass_ext_sw_phobic)
+    call file%get('ssa_sw_hydrophobic',      this%ssa_sw_phobic)
+    call file%get('asymmetry_sw_hydrophobic',this%g_sw_phobic)
+    call file%get('mass_ext_lw_hydrophobic', this%mass_ext_lw_phobic)
+    call file%get('ssa_lw_hydrophobic',      this%ssa_lw_phobic)
+    call file%get('asymmetry_lw_hydrophobic',this%g_lw_phobic)
+
+    call file%get_global_attribute('description_hydrophobic', &
+         &                         this%description_phobic_str)
+
+    if (this%use_hydrophilic) then
+      call file%get('mass_ext_sw_hydrophilic', this%mass_ext_sw_philic)
+      call file%get('ssa_sw_hydrophilic',      this%ssa_sw_philic)
+      call file%get('asymmetry_sw_hydrophilic',this%g_sw_philic)
+      call file%get('mass_ext_lw_hydrophilic', this%mass_ext_lw_philic)
+      call file%get('ssa_lw_hydrophilic',      this%ssa_lw_philic)
+      call file%get('asymmetry_lw_hydrophilic',this%g_lw_philic)
+
+      call file%get('relative_humidity1',      this%rh_lower)
+
+      call file%get_global_attribute('description_hydrophilic', &
+           &                         this%description_philic_str)
+    end if
+
+    ! Read the raw scattering data at selected wavelengths if
+    ! available in the input file
+    if (file%exists('mass_ext_mono_hydrophobic')) then
+      this%use_monochromatic = .true.
+      call file%get('mass_ext_mono_hydrophobic', this%mass_ext_mono_phobic)
+      call file%get('ssa_mono_hydrophobic',      this%ssa_mono_phobic)
+      call file%get('asymmetry_mono_hydrophobic',this%g_mono_phobic)
+      call file%get('lidar_ratio_mono_hydrophobic',this%lidar_ratio_mono_phobic)
+      if (this%use_hydrophilic) then
+        call file%get('mass_ext_mono_hydrophilic', this%mass_ext_mono_philic)
+        call file%get('ssa_mono_hydrophilic',      this%ssa_mono_philic)
+        call file%get('asymmetry_mono_hydrophilic',this%g_mono_philic)
+        call file%get('lidar_ratio_mono_hydrophilic',this%lidar_ratio_mono_philic)
+      end if
+    else
+      this%use_monochromatic = .false.
+    end if
+
+    ! Close aerosol scattering file
+    call file%close()
+
+    ! Get array sizes
+    this%n_bands_lw    = size(this%mass_ext_lw_phobic, 1)
+    this%n_bands_sw    = size(this%mass_ext_sw_phobic, 1)
+    if (this%use_monochromatic) then
+      this%n_mono_wl   = size(this%mass_ext_mono_phobic, 1)
+    else
+      this%n_mono_wl   = 0
+    end if
+    this%n_type_phobic = size(this%mass_ext_lw_phobic, 2)
+
+    if (this%use_hydrophilic) then
+      this%n_type_philic = size(this%mass_ext_lw_philic, 3)
+      this%nrh           = size(this%mass_ext_lw_philic, 2)
+
+      ! Check agreement of dimensions
+      if (size(this%mass_ext_lw_philic,1) /= this%n_bands_lw) then
+        write(nulerr,'(a,a)') '*** Error: mass extinction for hydrophilic and hydrophobic ', &
+             &                'aerosol have different numbers of longwave bands'
+        call radiation_abort()
+      end if
+      if (size(this%mass_ext_sw_philic,1) /= this%n_bands_sw) then
+        write(nulerr,'(a,a)') '*** Error: mass extinction for hydrophilic and hydrophobic ', &
+             &                'aerosol have different numbers of shortwave bands'
+        call radiation_abort()
+      end if
+      if (size(this%rh_lower) /= this%nrh) then
+        write(nulerr,'(a)') '*** Error: size(relative_humidity1) /= size(mass_ext_sw_hydrophilic,2)'
+        call radiation_abort()
+      end if
+
+    else
+      this%n_type_philic = 0
+      this%nrh           = 0
+    end if
+
+    ! Allocate memory for mapping arrays
+    this%ntype = ntype
+    allocate(this%iclass(ntype))
+    allocate(this%itype(ntype))
+
+    this%iclass = IAerosolClassUndefined
+    this%itype  = 0
+
+    if (lhook) call dr_hook('radiation_aerosol_optics_data:setup',1,hook_handle)
+
+  end subroutine setup_aerosol_optics
+
+
+  !---------------------------------------------------------------------
+  ! Map user type "itype" onto stored hydrophobic type "i_type_phobic"
+  subroutine set_hydrophobic_type(this, itype, i_type_phobic)
+
+    use yomhook,     only : lhook, dr_hook
+
+    class(aerosol_optics_type), intent(inout) :: this
+    integer, intent(in)                       :: itype, i_type_phobic
+    real(jprb)                                :: hook_handle
+
+    if (lhook) call dr_hook('radiation_aerosol_optics_data:set_hydrophobic_type',0,hook_handle)
+
+    if (itype < 1 .or. itype > this%ntype) then
+      write(nulerr,'(a,i0)') '*** Error: aerosol type must be in the range 1 to ', &
+           &                  this%ntype
+       call radiation_abort('Error setting up aerosols')
+    end if
+    if (i_type_phobic < 1 .or. i_type_phobic > this%n_type_phobic) then
+      write(nulerr,'(a,i0)') '*** Error: hydrophobic type must be in the range 1 to ', &
+           &                  this%n_type_phobic
+      call radiation_abort('Error setting up aerosols')
+    end if
+
+    this%iclass(itype) = IAerosolClassHydrophobic
+    this%itype (itype) = i_type_phobic
+
+    if (lhook) call dr_hook('radiation_aerosol_optics_data:set_hydrophobic_type',1,hook_handle)
+
+  end subroutine set_hydrophobic_type
+
+
+  !---------------------------------------------------------------------
+  ! Map user type "itype" onto stored hydrophilic type "i_type_philic"
+  subroutine set_hydrophilic_type(this, itype, i_type_philic)
+
+    use yomhook,     only : lhook, dr_hook
+
+    class(aerosol_optics_type), intent(inout) :: this
+    integer, intent(in)                       :: itype, i_type_philic
+    real(jprb)                                :: hook_handle
+
+    if (lhook) call dr_hook('radiation_aerosol_optics_data:set_hydrophilic_type',0,hook_handle)
+
+    if (.not. this%use_hydrophilic) then
+      write(nulerr,'(a)') '*** Error: attempt to set hydrophilic aerosol type when no such types present'
+      call radiation_abort('Error setting up aerosols')      
+    end if
+
+    if (itype < 1 .or. itype > this%ntype) then
+      write(nulerr,'(a,i0)') '*** Error: aerosol type must be in the range 1 to ', &
+            &          this%ntype
+      call radiation_abort('Error setting up aerosols')
+    end if
+    if (i_type_philic < 1 .or. i_type_philic > this%n_type_philic) then
+      write(nulerr,'(a,i0)') '*** Error: hydrophilic type must be in the range 1 to ', &
+           &                 this%n_type_philic
+      call radiation_abort('Error setting up aerosols')
+    end if
+
+    this%iclass(itype) = IAerosolClassHydrophilic
+    this%itype (itype) = i_type_philic
+
+    if (lhook) call dr_hook('radiation_aerosol_optics_data:set_hydrophilic_type',1,hook_handle)
+
+  end subroutine set_hydrophilic_type
+
+
+  !---------------------------------------------------------------------
+  ! Set a user type "itype" to be ignored in the radiation scheme
+  subroutine set_empty_type(this, itype)
+
+    use yomhook,     only : lhook, dr_hook
+
+    class(aerosol_optics_type), intent(inout) :: this
+    integer, intent(in)                       :: itype
+    real(jprb)                                :: hook_handle
+
+    if (lhook) call dr_hook('radiation_aerosol_optics_data:set_empty_type',0,hook_handle)
+
+    if (itype < 1 .or. itype > this%ntype) then
+      write(nulerr,'(a,i0)') '*** Error: aerosol type must be in the range 1 to ', &
+           &                 this%ntype
+      call radiation_abort('Error setting up aerosols')
+    end if
+
+    this%iclass(itype) = IAerosolClassIgnored
+
+    if (lhook) call dr_hook('radiation_aerosol_optics_data:set_empty_type',1,hook_handle)
+
+  end subroutine set_empty_type
+
+
+  !---------------------------------------------------------------------
+  ! Set user types "itypes" to map onto the stored hydrophobic and
+  ! hydrophilic types according to its sign and value, with a value of
+  ! 0 indicating that this type is to be ignored.  Thus if itypes=(/
+  ! 3, 4, -6, 0 /) then user types 1 and 2 map on to hydrophobic types
+  ! 3 and 4, user type 3 maps on to hydrophilic type 6 and user type 4
+  ! is ignored.
+  subroutine set_types(this, itypes)
+
+    use yomhook,     only : lhook, dr_hook
+
+    class(aerosol_optics_type), intent(inout) :: this
+    integer, dimension(:), intent(in)         :: itypes
+
+    integer :: jtype
+    integer :: istart, iend
+    real(jprb)                                :: hook_handle
+
+    if (lhook) call dr_hook('radiation_aerosol_optics_data:set_types',0,hook_handle)
+
+    istart = lbound(itypes,1)
+    iend   = ubound(itypes,1)
+
+    do jtype = istart, iend
+      if (itypes(jtype) == 0) then
+        call this%set_empty_type(jtype)
+      else if (itypes(jtype) > 0) then
+        call this%set_hydrophobic_type(jtype, itypes(jtype))
+      else
+        call this%set_hydrophilic_type(jtype, -itypes(jtype))
+      end if
+    end do
+
+    if (lhook) call dr_hook('radiation_aerosol_optics_data:set_types',1,hook_handle)
+
+  end subroutine set_types
+
+
+  !---------------------------------------------------------------------
+  ! Return an index to the relative-humdity array, or zero if no
+  ! hydrophilic types are present. This function does so little that
+  ! it is best to remove the Dr Hook call.
+  function calc_rh_index(this, rh)
+
+    !use yomhook,     only : lhook, dr_hook
+
+    class(aerosol_optics_type), intent(inout) :: this
+    real(jprb),                 intent(in)    :: rh
+    integer                                   :: calc_rh_index
+    !real(jprb)                                :: hook_handle
+
+    !if (lhook) call dr_hook('radiation_aerosol_optics_data:calc_rh_index',0,hook_handle)
+
+    if (.not. this%use_hydrophilic) then
+      calc_rh_index = 0
+    else if (rh > this%rh_lower(this%nrh)) then
+      calc_rh_index = this%nrh
+    else
+      calc_rh_index = 1
+      do while (rh > this%rh_lower(calc_rh_index + 1))
+        calc_rh_index = calc_rh_index + 1
+      end do
+    end if
+
+    !if (lhook) call dr_hook('radiation_aerosol_optics_data:calc_rh_index',1,hook_handle)
+
+  end function calc_rh_index
+
+
+  !---------------------------------------------------------------------
+  ! Print a description of the aerosol types to nulout
+  subroutine print_description(this, i_type_map)
+
+    use radiation_io, only : nulout
+
+    class(aerosol_optics_type), intent(in) :: this
+    integer,                    intent(in) :: i_type_map(:)
+
+    integer :: jtype
+
+    if (size(i_type_map) > 0) then
+      write(nulout,'(a)') 'Aerosol mapping:'
+    else
+      write(nulout,'(a)') 'No aerosol types in radiation scheme'
+    end if
+
+    do jtype = 1,size(i_type_map)
+      if (i_type_map(jtype) > 0) then
+        write(nulout,'(i4,a,a)') jtype, ' -> hydrophobic type ', &
+             &  trim(get_line(this%description_phobic_str, i_type_map(jtype)))
+      else if (i_type_map(jtype) < 0) then
+        write(nulout,'(i4,a,a)') jtype, ' -> hydrophilic type ', &
+             &  trim(get_line(this%description_philic_str, -i_type_map(jtype)))
+      else
+        write(nulout,'(i4,a)') jtype, ' is unused'
+      end if
+    end do
+    
+  end subroutine print_description
+
+
+  !---------------------------------------------------------------------
+  ! Private helper function for print_description
+  pure function get_line(str,iline) result(line_str)
+    character(len=*), intent(in)  :: str
+    integer,          intent(in)  :: iline
+    character(len=NMaxLineLength) :: line_str
+    
+    integer :: istart, iend, i_start_new, ioffset, ilength, i_line_current
+    logical :: is_fail
+    
+    i_line_current = 1
+    istart = 1
+    iend = len(str)
+    is_fail = .false.
+    line_str = ' '
+
+    ! Find index of first character
+    do while (i_line_current < iline)
+      i_start_new = scan(str(istart:iend), new_line(' '))
+      if (i_start_new == 0) then
+        is_fail = .true.
+        cycle
+      else
+        istart = istart + i_start_new
+      end if
+      i_line_current = i_line_current + 1
+    end do
+    
+    if (.not. is_fail) then
+      ! Find index of last character
+      ioffset = scan(str(istart:iend), new_line(' '))
+      if (ioffset == 0) then
+        ilength = len(trim(str(istart:iend)))
+      else
+        ilength = ioffset - 1
+      end if
+      
+      if (ilength > NMaxLineLength) then
+        ilength = NMaxLineLength
+      end if
+      iend = istart + ilength - 1
+      
+      line_str = str(istart:iend)
+    else
+      write(line_str,'(i0,a)') iline, ': <unknown>'
+    end if
+    
+  end function get_line
+  
+end module radiation_aerosol_optics_data
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloud.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloud.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloud.F90	(revision 3908)
@@ -0,0 +1,656 @@
+! radiation_cloud.F90 - Derived type to store cloud/precip properties
+!
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2019-01-14  R. Hogan  Added inv_inhom_effective_size variable
+!   2019-01-14  R. Hogan  Added out_of_physical_bounds routine
+
+module radiation_cloud
+
+  use parkind1, only : jprb
+
+  implicit none
+  public
+
+  !---------------------------------------------------------------------
+  ! The intention is that all variables describing clouds and
+  ! radiatively-active precipitation are contained in this derived
+  ! type, and if cloud variables are to be added in future, they can
+  ! be added to this type without requiring extra variables to be
+  ! passed between subroutines elsewhere in the program.
+  type cloud_type
+    ! For maximum flexibility, an arbitrary number "ntype" of
+    ! cloud types could be stored, as follows:
+    !     integer :: ntype     ! number of cloud types
+    !     integer :: nfraction ! number of cloud fractions
+    !     real(jprb), allocatable, dimension(:,:,:) :: &
+    !          mixing_ratio, & ! (ncol,nwetlev,ntype) mass mixing ratio (kg/kg)
+    !          particle_size,& ! (ncol,nwetlev,ntype) effective radius/size (m)
+    !          fraction        ! (ncol,nwetlev,nfraction) areal (i.e. cloud) fraction
+    ! However, for practical purposes at the moment we consider two
+    ! cloud types, liquid cloud droplets and ice cloud
+    ! particles.  The following variables are dimensioned (ncol,nlev)
+    real(jprb), allocatable, dimension(:,:) :: &
+         &  q_liq,  q_ice,  & ! mass mixing ratio (kg/kg)
+         &  re_liq, re_ice, & ! effective radius (m)
+         &  fraction          ! (0-1) Assume liq & ice completely mixed
+
+    ! The fractional standard deviation of cloud optical depth in the
+    ! cloudy part of the gridbox.  In the Tripleclouds representation
+    ! of cloud inhomogeneity, this is implemented by splitting the
+    ! cloudy part of the gridbox into two equal-area regions, one
+    ! with the cloud optical depth scaled by 1+fractional_std and the
+    ! other scaled by 1-fractional_std. This variable is dimensioned
+    ! (ncol,nlev)
+    real(jprb), allocatable, dimension(:,:) :: fractional_std
+
+    ! The inverse of the effective horizontal size of the clouds in
+    ! the gridbox, used to compute the cloud edge length per unit
+    ! gridbox area for use in representing 3D effects. This variable
+    ! is dimensioned (ncol,nlev).
+    real(jprb), allocatable, dimension(:,:) :: inv_cloud_effective_size ! m-1
+
+    ! Similarly for the in-cloud heterogeneities, used to compute the
+    ! edge length between the optically thin and thick cloudy regions
+    ! of the gridbox.
+    real(jprb), allocatable, dimension(:,:) :: inv_inhom_effective_size ! m-1
+
+    ! The following variable describes the overlap of cloud boundaries
+    ! in adjacent layers, with dimensions (ncol,nlev-1): 1 corresponds
+    ! to maximum overlap and 0 to random overlap. Depending on the
+    ! ecRad configuration, it may be the "alpha" overlap parameter of
+    ! Hogan and Illingworth (2000) or the "beta" overlap parameter of
+    ! Shonk et al. (2010).
+    real(jprb), allocatable, dimension(:,:) :: overlap_param
+
+  contains
+    procedure :: allocate   => allocate_cloud_arrays
+    procedure :: deallocate => deallocate_cloud_arrays
+    procedure :: set_overlap_param
+    procedure :: set_overlap_param_approx
+    procedure :: create_fractional_std
+    procedure :: create_inv_cloud_effective_size
+    procedure :: create_inv_cloud_effective_size_eta
+    procedure :: param_cloud_effective_separation_eta
+    procedure :: crop_cloud_fraction
+    procedure :: out_of_physical_bounds
+
+  end type cloud_type
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Allocate arrays for describing clouds and precipitation, although
+  ! in the offline code these are allocated when they are read from
+  ! the NetCDF file
+  subroutine allocate_cloud_arrays(this, ncol, nlev, use_inhom_effective_size)
+
+    use yomhook,     only : lhook, dr_hook
+
+    class(cloud_type), intent(inout) :: this
+    integer, intent(in)              :: ncol  ! Number of columns
+    integer, intent(in)              :: nlev  ! Number of levels
+    logical, intent(in), optional    :: use_inhom_effective_size
+
+    real(jprb)                       :: hook_handle
+
+    if (lhook) call dr_hook('radiation_cloud:allocate',0,hook_handle)
+
+    allocate(this%q_liq(ncol,nlev))
+    allocate(this%re_liq(ncol,nlev))
+    allocate(this%q_ice(ncol,nlev))
+    allocate(this%re_ice(ncol,nlev))
+    allocate(this%fraction(ncol,nlev))
+    allocate(this%overlap_param(ncol,nlev-1))
+    allocate(this%fractional_std(ncol,nlev))
+    allocate(this%inv_cloud_effective_size(ncol,nlev))
+
+    if (present(use_inhom_effective_size)) then
+      if (use_inhom_effective_size) then
+        allocate(this%inv_inhom_effective_size(ncol,nlev))
+      end if
+    end if
+
+    if (lhook) call dr_hook('radiation_cloud:allocate',1,hook_handle)
+
+  end subroutine allocate_cloud_arrays
+
+
+  !---------------------------------------------------------------------
+  ! Deallocate arrays
+  subroutine deallocate_cloud_arrays(this)
+
+    use yomhook,     only : lhook, dr_hook
+
+    class(cloud_type), intent(inout) :: this
+
+    real(jprb)                       :: hook_handle
+
+    if (lhook) call dr_hook('radiation_cloud:deallocate',0,hook_handle)
+
+    if (allocated(this%q_liq))    deallocate(this%q_liq)
+    if (allocated(this%re_liq))   deallocate(this%re_liq)
+    if (allocated(this%q_ice))    deallocate(this%q_ice)
+    if (allocated(this%re_ice))   deallocate(this%re_ice)
+    if (allocated(this%fraction)) deallocate(this%fraction)
+    if (allocated(this%overlap_param))  deallocate(this%overlap_param)
+    if (allocated(this%fractional_std)) deallocate(this%fractional_std)
+    if (allocated(this%inv_cloud_effective_size)) &
+         &  deallocate(this%inv_cloud_effective_size)
+    if (allocated(this%inv_inhom_effective_size)) &
+         &  deallocate(this%inv_inhom_effective_size)
+
+    if (lhook) call dr_hook('radiation_cloud:deallocate',1,hook_handle)
+
+  end subroutine deallocate_cloud_arrays
+
+
+  !---------------------------------------------------------------------
+  ! Compute and store the overlap parameter from the provided overlap
+  ! decorrelation length (in metres).  If istartcol and/or iendcol are
+  ! provided then only columns in this range are computed.  If the
+  ! overlap_param array has not been allocated then it will be
+  ! allocated to be of the correct size relative to the pressure
+  ! field. 
+  subroutine set_overlap_param(this, thermodynamics, decorrelation_length, &
+       &  istartcol, iendcol)
+
+    use yomhook,                  only : lhook, dr_hook
+    use radiation_thermodynamics, only : thermodynamics_type
+    use radiation_constants,      only : GasConstantDryAir, AccelDueToGravity
+
+    class(cloud_type),         intent(inout) :: this
+    type(thermodynamics_type), intent(in)    :: thermodynamics
+    real(jprb),                intent(in)    :: decorrelation_length ! m
+    integer,         optional, intent(in)    :: istartcol, iendcol
+
+    ! Ratio of gas constant for dry air to acceleration due to gravity
+    real(jprb), parameter :: R_over_g = GasConstantDryAir / AccelDueToGravity
+
+    ! Process only columns i1 to i2, which will be istartcol to
+    ! iendcol if they were provided
+    integer :: i1, i2
+
+    integer :: ncol, nlev
+
+    integer :: jlev
+
+    real(jprb)        :: hook_handle
+
+    if (lhook) call dr_hook('radiation_cloud:set_overlap_param',0,hook_handle)
+
+    ! Pressure at half-levels, pressure_hl, is defined at nlev+1
+    ! points
+    ncol = size(thermodynamics%pressure_hl,dim=1)
+    nlev = size(thermodynamics%pressure_hl,dim=2)-1
+
+    if (present(istartcol)) then
+      i1 = istartcol
+    else
+      i1 = 1
+    end if
+
+    if (present(iendcol)) then
+      i2 = iendcol
+    else
+      i2 = ncol
+    end if
+
+    if (.not. allocated(this%overlap_param)) then
+      ! If pressure is of size (ncol,nlev+1) then overlap_param is of
+      ! size (ncol,nlev-1), since overlap parameter is only defined here
+      ! for interfaces between model layers, not for the interface to
+      ! space or the surface
+      allocate(this%overlap_param(ncol, nlev-1))
+    end if
+
+    if (thermodynamics%pressure_hl(i1,2) > thermodynamics%pressure_hl(i1,1)) then
+      ! Pressure is increasing with index (order of layers is
+      ! top-of-atmosphere to surface). In case pressure_hl(:,1)=0, we
+      ! don't take the logarithm of the first pressure in each column.
+      this%overlap_param(i1:i2,1) = exp(-(R_over_g/decorrelation_length) &
+           &                            * thermodynamics%temperature_hl(i1:i2,2) &
+           &                            *log(thermodynamics%pressure_hl(i1:i2,3) &
+           &                                /thermodynamics%pressure_hl(i1:i2,2)))
+
+      do jlev = 2,nlev-1
+        this%overlap_param(i1:i2,jlev) = exp(-(0.5_jprb*R_over_g/decorrelation_length) &
+             &                            * thermodynamics%temperature_hl(i1:i2,jlev+1) &
+             &                            *log(thermodynamics%pressure_hl(i1:i2,jlev+2) &
+             &                                /thermodynamics%pressure_hl(i1:i2,jlev)))
+      end do
+
+    else
+       ! Pressure is decreasing with index (order of layers is surface
+       ! to top-of-atmosphere).  In case pressure_hl(:,nlev+1)=0, we
+       ! don't take the logarithm of the last pressure in each column.
+      do jlev = 1,nlev-2
+        this%overlap_param(i1:i2,jlev) = exp(-(0.5_jprb*R_over_g/decorrelation_length) &
+             &                            * thermodynamics%temperature_hl(i1:i2,jlev+1) &
+             &                            *log(thermodynamics%pressure_hl(i1:i2,jlev) &
+             &                                /thermodynamics%pressure_hl(i1:i2,jlev+2)))
+      end do
+      this%overlap_param(i1:i2,nlev-1) = exp(-(R_over_g/decorrelation_length) &
+           &                            * thermodynamics%temperature_hl(i1:i2,nlev) &
+           &                            *log(thermodynamics%pressure_hl(i1:i2,nlev-1) &
+           &                                /thermodynamics%pressure_hl(i1:i2,nlev)))
+
+    end if
+
+    if (lhook) call dr_hook('radiation_cloud:set_overlap_param',1,hook_handle)
+
+  end subroutine set_overlap_param
+
+
+  !---------------------------------------------------------------------
+  ! Compute and store the overlap parameter from the provided overlap
+  ! decorrelation length (in metres).  If istartcol and/or iendcol are
+  ! provided then only columns in this range are computed.  If the
+  ! overlap_param array has not been allocated then it will be
+  ! allocated to be of the correct size relative to the pressure
+  ! field. This is the APPROXIMATE method as it assumes a fixed
+  ! atmospheric scale height, which leads to differences particularly
+  ! in low cloud.
+  subroutine set_overlap_param_approx(this, thermodynamics, decorrelation_length, &
+       &  istartcol, iendcol)
+
+    use yomhook,                  only : lhook, dr_hook
+    use radiation_thermodynamics, only : thermodynamics_type
+
+    class(cloud_type),         intent(inout) :: this
+    type(thermodynamics_type), intent(in)    :: thermodynamics
+    real(jprb),                intent(in)    :: decorrelation_length ! m
+    integer,         optional, intent(in)    :: istartcol, iendcol
+
+    ! To convert decorrelation length (m) to overlap parameter between
+    ! layers, we need an estimate for the thickness of the layer. This
+    ! is found using the pressure difference between the edges of the
+    ! layer, along with the approximate scale height of the atmosphere
+    ! (m) given here:
+    real(jprb), parameter :: scale_height = 8000.0_jprb
+
+    ! Process only columns i1 to i2, which will be istartcol to
+    ! iendcol if they were provided
+    integer :: i1, i2
+
+    integer :: ncol, nlev
+
+    real(jprb)        :: hook_handle
+
+    if (lhook) call dr_hook('radiation_cloud:set_overlap_param_approx',0,hook_handle)
+
+    ! Pressure at half-levels, pressure_hl, is defined at nlev+1
+    ! points
+    ncol = size(thermodynamics%pressure_hl,dim=1)
+    nlev = size(thermodynamics%pressure_hl,dim=2)-1
+
+    if (present(istartcol)) then
+      i1 = istartcol
+    else
+      i1 = 1
+    end if
+
+    if (present(iendcol)) then
+      i2 = iendcol
+    else
+      i2 = ncol
+    end if
+
+    if (.not. allocated(this%overlap_param)) then
+      ! If pressure is of size (ncol,nlev+1) then overlap_param is of
+      ! size (ncol,nlev-1), since overlap parameter is only defined here
+      ! for interfaces between model layers, not for the interface to
+      ! space or the surface
+      allocate(this%overlap_param(ncol, nlev-1))
+    end if
+
+    if (thermodynamics%pressure_hl(i1,2) > thermodynamics%pressure_hl(i1,1)) then
+       ! Pressure is increasing with index (order of layers is
+       ! top-of-atmosphere to surface). In case pressure_hl(:,1)=0, we
+       ! don't take the logarithm of the first pressure in each
+       ! column.
+       this%overlap_param(i1:i2,:) = exp(-(scale_height/decorrelation_length) &
+            &  * ( log(thermodynamics%pressure_hl(i1:i2,3:nlev+1) &
+            &         /thermodynamics%pressure_hl(i1:i2,2:nlev  )) ) )
+    else
+       ! Pressure is decreasing with index (order of layers is surface
+       ! to top-of-atmosphere).  In case pressure_hl(:,nlev+1)=0, we
+       ! don't take the logarithm of the last pressure in each column.
+       this%overlap_param(i1:i2,:) = exp(-(scale_height/decorrelation_length) &
+            &  * ( log(thermodynamics%pressure_hl(i1:i2,1:nlev-1) &
+            &         /thermodynamics%pressure_hl(i1:i2,2:nlev  )) ) )
+    end if
+
+    if (lhook) call dr_hook('radiation_cloud:set_overlap_param_approx',1,hook_handle)
+
+  end subroutine set_overlap_param_approx
+
+
+  !---------------------------------------------------------------------
+  ! Create a matrix of constant fractional standard deviations
+  ! (dimensionless)
+  subroutine create_fractional_std(this, ncol, nlev, frac_std)
+
+    use yomhook,                  only : lhook, dr_hook
+
+    class(cloud_type), intent(inout) :: this
+    integer,           intent(in)    :: ncol, nlev
+    real(jprb),        intent(in)    :: frac_std
+
+    real(jprb)             :: hook_handle
+
+    if (lhook) call dr_hook('radiation_cloud:create_fractional_std',0,hook_handle)
+
+    if (allocated(this%fractional_std)) then
+       deallocate(this%fractional_std)
+    end if
+    
+    allocate(this%fractional_std(ncol, nlev))
+
+    this%fractional_std = frac_std
+
+    if (lhook) call dr_hook('radiation_cloud:create_fractional_std',1,hook_handle)
+
+  end subroutine create_fractional_std
+
+
+  !---------------------------------------------------------------------
+  ! Create a matrix of constant inverse cloud effective size (m-1)
+  subroutine create_inv_cloud_effective_size(this, ncol, nlev, inv_eff_size)
+
+    use yomhook,                  only : lhook, dr_hook
+
+    class(cloud_type), intent(inout) :: this
+    integer,           intent(in)    :: ncol, nlev
+    real(jprb),        intent(in)    :: inv_eff_size
+
+    real(jprb)             :: hook_handle
+
+    if (lhook) call dr_hook('radiation_cloud:create_inv_cloud_effective_size',0,hook_handle)
+
+    if (allocated(this%inv_cloud_effective_size)) then
+       deallocate(this%inv_cloud_effective_size)
+    end if
+    
+    allocate(this%inv_cloud_effective_size(ncol, nlev))
+
+    this%inv_cloud_effective_size = inv_eff_size
+
+    if (lhook) call dr_hook('radiation_cloud:create_inv_cloud_effective_size',1,hook_handle)
+
+  end subroutine create_inv_cloud_effective_size
+
+
+  !---------------------------------------------------------------------
+  ! Create a matrix of inverse cloud effective size (m-1) according to
+  ! the value of eta (=pressure divided by surface pressure)
+  subroutine create_inv_cloud_effective_size_eta(this, ncol, nlev, &
+       &  pressure_hl, inv_eff_size_low, inv_eff_size_mid, inv_eff_size_high, &
+       &  eta_low_mid, eta_mid_high, istartcol, iendcol)
+
+    use yomhook,                  only : lhook, dr_hook
+
+    class(cloud_type), intent(inout) :: this
+    integer,           intent(in)    :: ncol, nlev
+    ! Pressure on half levels (Pa)
+    real(jprb),        intent(in)    :: pressure_hl(:,:)
+    ! Inverse effective size for low, mid and high cloud (m-1)
+    real(jprb),        intent(in)    :: inv_eff_size_low
+    real(jprb),        intent(in)    :: inv_eff_size_mid
+    real(jprb),        intent(in)    :: inv_eff_size_high
+    ! Eta values at low-mid and mid-high interfaces
+    real(jprb),        intent(in)    :: eta_low_mid, eta_mid_high
+    integer, optional, intent(in)    :: istartcol, iendcol
+
+    ! Ratio of layer midpoint pressure to surface pressure
+    real(jprb) :: eta(nlev)
+
+    ! Indices of column, level and surface half-level
+    integer :: jcol, isurf
+
+    ! Local values of istartcol, iendcol
+    integer :: i1, i2
+
+    real(jprb)             :: hook_handle
+
+    if (lhook) call dr_hook('radiation_cloud:create_inv_cloud_effective_size_eta',0,hook_handle)
+
+    if (allocated(this%inv_cloud_effective_size)) then
+      deallocate(this%inv_cloud_effective_size)
+    end if
+    
+    allocate(this%inv_cloud_effective_size(ncol, nlev))
+
+    if (present(istartcol)) then
+      i1 = istartcol
+    else
+      i1 = 1
+    end if
+
+    if (present(iendcol)) then
+      i2 = iendcol
+    else
+      i2 = ncol
+    end if
+
+    ! Locate the surface half-level
+    if (pressure_hl(1,1) > pressure_hl(1,2)) then
+      isurf = 1
+    else
+      isurf = nlev+1
+    end if
+
+    do jcol = i1,i2
+      eta = (pressure_hl(jcol,1:nlev)+pressure_hl(jcol,2:nlev+1)) &
+           &  * (0.5_jprb / pressure_hl(jcol,isurf))
+      where (eta > eta_low_mid)
+        this%inv_cloud_effective_size(jcol,:) = inv_eff_size_low
+      elsewhere (eta > eta_mid_high)
+        this%inv_cloud_effective_size(jcol,:) = inv_eff_size_mid
+      elsewhere
+        this%inv_cloud_effective_size(jcol,:) = inv_eff_size_high
+      end where
+    end do
+
+    if (lhook) call dr_hook('radiation_cloud:create_inv_cloud_effective_size_eta',1,hook_handle)
+
+  end subroutine create_inv_cloud_effective_size_eta
+
+
+  !---------------------------------------------------------------------
+  ! Create a matrix of inverse cloud and inhomogeneity effective size
+  ! (m-1) parameterized according to the value of eta (=pressure
+  ! divided by surface pressure): effective_separation =
+  ! coeff_a + coeff_b*exp(-(eta**power)).  
+  subroutine param_cloud_effective_separation_eta(this, ncol, nlev, &
+       &  pressure_hl, separation_surf, separation_toa, power, &
+       &  inhom_separation_factor, istartcol, iendcol)
+
+    use yomhook,                  only : lhook, dr_hook
+
+    class(cloud_type), intent(inout) :: this
+    integer,           intent(in)    :: ncol, nlev
+    ! Pressure on half levels (Pa)
+    real(jprb),        intent(in)    :: pressure_hl(:,:)
+    ! Separation distances at surface and top-of-atmosphere, and power
+    ! on eta
+    real(jprb),           intent(in) :: separation_surf ! m
+    real(jprb),           intent(in) :: separation_toa ! m
+    real(jprb),           intent(in) :: power
+    real(jprb), optional, intent(in) :: inhom_separation_factor
+    integer,    optional, intent(in) :: istartcol, iendcol
+
+    ! Ratio of layer midpoint pressure to surface pressure
+    real(jprb) :: eta(nlev)
+
+    ! Effective cloud separation (m)
+    real(jprb) :: eff_separation(nlev)
+
+    ! Coefficients used to compute effective separation distance
+    real(jprb) :: coeff_e, coeff_a, coeff_b, inhom_sep_factor
+
+    ! Indices of column, level and surface half-level
+    integer :: jcol, isurf
+
+    ! Local values of istartcol, iendcol
+    integer :: i1, i2
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_cloud:param_cloud_effective_separation_eta',0,hook_handle)
+
+    if (present(inhom_separation_factor)) then
+      inhom_sep_factor = inhom_separation_factor
+    else
+      inhom_sep_factor = 1.0_jprb
+    end if
+
+    coeff_e = 1.0_jprb - exp(-1.0_jprb)
+    coeff_b = (separation_toa - separation_surf) / coeff_e
+    coeff_a = separation_toa - coeff_b
+
+    if (allocated(this%inv_cloud_effective_size)) then
+      deallocate(this%inv_cloud_effective_size)
+    end if
+     if (allocated(this%inv_inhom_effective_size)) then
+      deallocate(this%inv_inhom_effective_size)
+    end if
+   
+    allocate(this%inv_cloud_effective_size(ncol, nlev))
+    allocate(this%inv_inhom_effective_size(ncol, nlev))
+
+    if (present(istartcol)) then
+      i1 = istartcol
+    else
+      i1 = 1
+    end if
+
+    if (present(iendcol)) then
+      i2 = iendcol
+    else
+      i2 = ncol
+    end if
+
+    ! Locate the surface half-level
+    if (pressure_hl(1,1) > pressure_hl(1,2)) then
+      isurf = 1
+    else
+      isurf = nlev+1
+    end if
+
+    do jcol = i1,i2
+      eta = (pressure_hl(jcol,1:nlev)+pressure_hl(jcol,2:nlev+1)) &
+           &  * (0.5_jprb / pressure_hl(jcol,isurf))
+      eff_separation = coeff_a + coeff_b * exp(-eta**power)
+      this%inv_cloud_effective_size(jcol,:) = 1.0_jprb / (eff_separation &
+           &  * sqrt(max(1.0e-5_jprb,this%fraction(jcol,:)*(1.0_jprb-this%fraction(jcol,:)))))
+      this%inv_inhom_effective_size(jcol,:) = 1.0_jprb / (eff_separation * inhom_sep_factor &
+           &  * sqrt(max(1.0e-5_jprb,0.5_jprb*this%fraction(jcol,:)*(1.0_jprb-0.5_jprb*this%fraction(jcol,:)))))
+    end do
+
+    if (lhook) call dr_hook('radiation_cloud:param_cloud_effective_separation_eta',1,hook_handle)
+
+  end subroutine param_cloud_effective_separation_eta
+
+
+  !---------------------------------------------------------------------
+  ! Remove "ghost" clouds: those with a cloud fraction that is too
+  ! small to treat sensibly (e.g. because it implies that the
+  ! "in-cloud" water content is too high), or with a cloud water
+  ! content that is too small.  We do this in one place to ensure that
+  ! all subsequent subroutines can assume that if cloud_fraction > 0.0
+  ! then cloud is really present and should be treated.
+  subroutine crop_cloud_fraction(this, istartcol, iendcol, &
+       &    cloud_fraction_threshold, cloud_mixing_ratio_threshold)
+    
+    use yomhook, only : lhook, dr_hook
+
+    class(cloud_type), intent(inout) :: this
+    integer,           intent(in)    :: istartcol, iendcol
+
+    integer :: nlev
+    integer :: jcol, jlev
+
+    real(jprb) :: cloud_fraction_threshold, cloud_mixing_ratio_threshold
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_cloud:crop_cloud_fraction',0,hook_handle)
+
+    nlev = size(this%fraction,2)
+
+    do jlev = 1,nlev
+      do jcol = istartcol,iendcol
+        if (this%fraction(jcol,jlev) < cloud_fraction_threshold &
+             &  .or. this%q_liq(jcol,jlev)+this%q_ice(jcol,jlev) &
+             &        < cloud_mixing_ratio_threshold) then
+          this%fraction(jcol,jlev) = 0.0_jprb
+        end if
+      end do
+    end do
+
+    if (lhook) call dr_hook('radiation_cloud:crop_cloud_fraction',1,hook_handle)
+
+  end subroutine crop_cloud_fraction
+
+
+  !---------------------------------------------------------------------
+  ! Return .true. if variables are out of a physically sensible range,
+  ! optionally only considering columns between istartcol and iendcol
+  function out_of_physical_bounds(this, istartcol, iendcol, do_fix) result(is_bad)
+
+    use yomhook,          only : lhook, dr_hook
+    use radiation_config, only : out_of_bounds_2d
+
+    class(cloud_type), intent(inout) :: this
+    integer,  optional,intent(in) :: istartcol, iendcol
+    logical,  optional,intent(in) :: do_fix
+    logical                       :: is_bad
+
+    logical    :: do_fix_local
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_cloud:out_of_physical_bounds',0,hook_handle)
+
+    if (present(do_fix)) then
+      do_fix_local = do_fix
+    else
+      do_fix_local = .false.
+    end if
+
+    is_bad =    out_of_bounds_2d(this%q_liq, 'q_liq', 0.0_jprb, 1.0_jprb, &
+         &                       do_fix_local, i1=istartcol, i2=iendcol) &
+         & .or. out_of_bounds_2d(this%q_ice, 'q_ice', 0.0_jprb, 1.0_jprb, &
+         &                       do_fix_local, i1=istartcol, i2=iendcol) &
+         & .or. out_of_bounds_2d(this%re_liq, 're_liq', 0.0_jprb, 0.01_jprb, &
+         &                       do_fix_local, i1=istartcol, i2=iendcol) &
+         & .or. out_of_bounds_2d(this%re_ice, 're_ice', 0.0_jprb, 0.1_jprb, &
+         &                       do_fix_local, i1=istartcol, i2=iendcol) &
+         & .or. out_of_bounds_2d(this%fraction, 'cloud%fraction', 0.0_jprb, 1.0_jprb, &
+         &                       do_fix_local, i1=istartcol, i2=iendcol) &
+         & .or. out_of_bounds_2d(this%fractional_std, 'fractional_std', 0.0_jprb, 10.0_jprb, &
+         &                       do_fix_local, i1=istartcol, i2=iendcol) &
+         & .or. out_of_bounds_2d(this%inv_cloud_effective_size, 'inv_cloud_effective_size', &
+         &                       0.0_jprb, 1.0_jprb, do_fix_local, i1=istartcol, i2=iendcol) &
+         & .or. out_of_bounds_2d(this%inv_inhom_effective_size, 'inv_inhom_effective_size', &
+         &                       0.0_jprb, 1.0_jprb, do_fix_local, i1=istartcol, i2=iendcol) &
+         & .or. out_of_bounds_2d(this%overlap_param, 'overlap_param', -0.5_jprb, 1.0_jprb, &
+         &                       do_fix_local, i1=istartcol, i2=iendcol)
+
+    if (lhook) call dr_hook('radiation_cloud:out_of_physical_bounds',1,hook_handle)
+
+  end function out_of_physical_bounds
+  
+end module radiation_cloud
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloud_cover.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloud_cover.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloud_cover.F90	(revision 3908)
@@ -0,0 +1,566 @@
+! radiation_cloud_cover.F90 - Compute cumulative cloud cover for McICA
+!
+! (C) Copyright 2016- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Generate profiles of the cumulative cloud cover as seen from TOA,
+! used in the McICA cloud generator.
+!
+! Modifications
+!   2020-10-07  R. Hogan  Ensure iobj1 initialized in case of alpha_obj==0
+
+module radiation_cloud_cover
+
+  use parkind1, only           : jprb
+
+  public
+
+  ! Three overlap schemes.  Note that "Exponential" means that
+  ! clear-sky regions have no special significance for computing the
+  ! cumulative cloud cover: non-contiguous clouds are exponentially
+  ! rather than randomly overlapped. This is the situaition in the
+  ! McRad radiation scheme at ECMWF.
+  enum, bind(c)
+    enumerator IOverlapMaximumRandom, IOverlapExponentialRandom, &
+         &     IOverlapExponential
+  end enum
+  character(len=*), parameter :: OverlapName(0:2) = (/ 'Max-Ran', &
+       &                                               'Exp-Ran', &
+       &                                               'Exp-Exp' /)
+
+  ! Maximum cloud fraction distinguishable from 1
+  real(jprb), parameter :: MaxCloudFrac = 1.0_jprb-epsilon(1.0_jprb)*10.0_jprb
+
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Convert "beta" overlap parameter of Shonk et al. (2010) to "alpha"
+  ! overlap parameter of Hogan and Illingworth (2000)
+  elemental function beta2alpha(beta, frac1, frac2)
+
+    implicit none
+
+    ! Beta overlap parameter and the cloud fractions in the upper and
+    ! lower layers
+    real(jprb), intent(in) :: beta, frac1, frac2
+
+    real(jprb)             :: beta2alpha
+
+    ! Absolute difference in cloud fraction
+    real(jprb)             :: frac_diff
+
+    if (beta < 1.0_jprb) then
+      frac_diff = abs(frac1-frac2)
+      beta2alpha = beta &
+           &  + (1.0_jprb-beta)*frac_diff &
+           &  / (frac_diff + 1.0_jprb/beta - 1.0_jprb)
+    else
+      beta2alpha = 1.0_jprb
+    end if
+
+  end function beta2alpha
+
+
+  !---------------------------------------------------------------------
+  ! Compute total cloud cover according to the specified overlap
+  ! rule. This can be used to compute the high, mid and low cloud
+  ! cover by passing in subsets of the cloud fraction array
+  function cloud_cover(nlev, i_overlap_scheme, frac, overlap_param, &
+       &               is_beta_overlap)
+
+    implicit none
+    
+    ! Number of levels and the overlap scheme to be applied
+    integer, intent(in)    :: nlev, i_overlap_scheme
+
+    ! Cloud fraction and the overlap parameter between adjacent pairs
+    ! of levels
+    real(jprb), intent(in) :: frac(nlev), overlap_param(nlev-1)
+
+    ! Do we use the "beta" overlap scheme of Shonk et al. (2010)?
+    ! Default is false.
+    logical, intent(in), optional :: is_beta_overlap
+
+    ! Return cloud cover
+    real(jprb)             :: cloud_cover
+
+    ! Cumulative cloud cover from TOA to the base of each layer
+    real(jprb) :: cum_cloud_cover(nlev)
+
+    ! Cloud cover of a pair of layers
+    real(jprb) :: pair_cloud_cover(nlev-1)
+
+    if (i_overlap_scheme == IOverlapExponentialRandom) then
+      call cum_cloud_cover_exp_ran(nlev, frac, overlap_param, &
+           &   cum_cloud_cover, pair_cloud_cover, is_beta_overlap)
+    else if (i_overlap_scheme == IOverlapExponential) then
+      call cum_cloud_cover_exp_exp(nlev, frac, overlap_param, &
+           &   cum_cloud_cover, pair_cloud_cover, is_beta_overlap)
+    else
+      call cum_cloud_cover_max_ran(nlev, frac, cum_cloud_cover, &
+           &                       pair_cloud_cover)
+    end if
+
+    cloud_cover = cum_cloud_cover(nlev)
+
+  end function cloud_cover
+
+
+  !---------------------------------------------------------------------
+  ! Maximum-random overlap: Geleyn & Hollingsworth formula
+  subroutine cum_cloud_cover_max_ran(nlev, frac, &
+       & cum_cloud_cover, pair_cloud_cover)
+
+    use yomhook,  only           : lhook, dr_hook
+
+    implicit none
+
+    ! Inputs
+    integer, intent(in)     :: nlev  ! number of model levels
+
+    ! Cloud fraction on full levels
+    real(jprb), intent(in)  :: frac(nlev)
+
+    ! Outputs
+
+    ! Cumulative cloud cover from TOA to the base of each layer
+    real(jprb), intent(out) :: cum_cloud_cover(nlev)
+
+    ! Cloud cover of a pair of layers
+    real(jprb), intent(out) :: pair_cloud_cover(nlev-1)
+
+    ! Local variables
+
+    ! Cumulative product needed in computation of total_cloud_cover
+    real(jprb) :: cum_product
+
+    ! Loop index for model level
+    integer :: jlev
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_cloud_cover:cum_cloud_cover_max_ran',0,hook_handle)
+
+    ! Loop to compute total cloud cover and the cumulative cloud cover
+
+    ! down to the base of each layer
+    cum_product = 1.0_jprb - frac(1)
+    cum_cloud_cover(1) = frac(1)
+    do jlev = 1,nlev-1
+      ! Compute the combined cloud cover of layers jlev and jlev+1
+      pair_cloud_cover(jlev) = max(frac(jlev),frac(jlev+1))
+
+      if (frac(jlev) >= MaxCloudFrac) then
+        ! Cloud cover has reached one
+        cum_product = 0.0_jprb
+      else
+        cum_product = cum_product * (1.0_jprb - pair_cloud_cover(jlev)) &
+             &  / (1.0_jprb - frac(jlev))
+      end if
+      cum_cloud_cover(jlev+1) = 1.0_jprb - cum_product
+    end do
+
+    if (lhook) call dr_hook('radiation_cloud_cover:cum_cloud_cover_max_ran',1,hook_handle)
+
+  end subroutine cum_cloud_cover_max_ran
+  
+
+  !---------------------------------------------------------------------
+  ! Exponential-random overlap: exponential overlap for contiguous
+  ! clouds, random overlap for non-contiguous clouds
+  subroutine cum_cloud_cover_exp_ran(nlev, frac, overlap_param, &
+       & cum_cloud_cover, pair_cloud_cover, is_beta_overlap)
+
+    use yomhook,  only           : lhook, dr_hook
+
+    implicit none
+
+    ! Inputs
+    integer, intent(in)     :: nlev  ! number of model levels
+
+    ! Cloud fraction on full levels
+    real(jprb), intent(in)  :: frac(nlev)
+
+    ! Cloud overlap parameter for interfaces between model layers,
+    ! where 0 indicates random overlap and 1 indicates maximum-random
+    ! overlap
+    real(jprb), intent(in)  :: overlap_param(nlev-1)
+
+    ! This routine has been coded using the "alpha" overlap parameter
+    ! of Hogan and Illingworth (2000). If the following logical is
+    ! present and true then the input is interpretted to be the "beta"
+    ! overlap parameter of Shonk et al. (2010), and needs to be
+    ! converted to alpha.
+    logical, intent(in), optional :: is_beta_overlap
+
+    ! Outputs
+
+    ! Cumulative cloud cover from TOA to the base of each layer
+    real(jprb), intent(out) :: cum_cloud_cover(nlev)
+
+    ! Cloud cover of a pair of layers
+    real(jprb), intent(out) :: pair_cloud_cover(nlev-1)
+
+    ! Local variables
+
+    ! Cumulative product needed in computation of total_cloud_cover
+    real(jprb) :: cum_product
+
+    ! "Alpha" overlap parameter
+    real(jprb) :: overlap_alpha
+    logical    :: do_overlap_conversion
+
+    ! Loop index for model level
+    integer :: jlev
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_cloud_cover:cum_cloud_cover_exp_ran',0,hook_handle)
+
+    
+    if (present(is_beta_overlap)) then
+      do_overlap_conversion = is_beta_overlap
+    else
+      do_overlap_conversion = .false.
+    end if
+
+    ! Loop to compute total cloud cover and the cumulative cloud cover
+
+    ! down to the base of each layer
+    cum_product = 1.0_jprb - frac(1)
+    cum_cloud_cover(1) = frac(1)
+    do jlev = 1,nlev-1
+      ! Convert to "alpha" overlap parameter if necessary
+      if (do_overlap_conversion) then
+        overlap_alpha = beta2alpha(overlap_param(jlev), &
+             &                     frac(jlev), frac(jlev+1))
+      else
+        overlap_alpha = overlap_param(jlev)
+      end if
+
+      ! Compute the combined cloud cover of layers jlev and jlev+1
+      pair_cloud_cover(jlev) = overlap_alpha*max(frac(jlev),frac(jlev+1)) &
+           &  + (1.0_jprb - overlap_alpha) &
+           &  * (frac(jlev)+frac(jlev+1)-frac(jlev)*frac(jlev+1))
+
+      if (frac(jlev) >= MaxCloudFrac) then
+        ! Cloud cover has reached one
+        cum_product = 0.0_jprb
+      else
+        cum_product = cum_product * (1.0_jprb - pair_cloud_cover(jlev)) &
+             &  / (1.0_jprb - frac(jlev))
+      end if
+      cum_cloud_cover(jlev+1) = 1.0_jprb - cum_product
+    end do
+
+
+    if (lhook) call dr_hook('radiation_cloud_cover:cum_cloud_cover_exp_ran',1,hook_handle)
+
+  end subroutine cum_cloud_cover_exp_ran
+
+
+
+  !---------------------------------------------------------------------
+  ! Exponential-exponential overlap: exponential overlap for both
+  ! contiguous and non-contiguous clouds. This is the result of the
+  ! simple Raisanen cloud generator, but unfortunately it has no
+  ! (known) analytic formula for the total cloud cover, or the
+  ! cumulative cloud cover.  In partially cloudy columns, The McICA
+  ! scheme needs this info in order to devote all the cloudy g-points
+  ! to columns containing cloud, which reduces McICA noise. The
+  ! following routine provides an approximate estimate of cumulative
+  ! cloud cover consistent with the exponential-exponential scheme.
+  subroutine cum_cloud_cover_exp_exp(nlev, frac, overlap_param, &
+       & cum_cloud_cover, pair_cloud_cover, is_beta_overlap)
+
+    use yomhook,  only           : lhook, dr_hook
+
+    implicit none
+
+    ! Inputs
+    integer, intent(in)     :: nlev  ! number of model levels
+
+    ! Cloud fraction on full levels
+    real(jprb), intent(in)  :: frac(nlev)
+
+    ! Cloud overlap parameter for interfaces between model layers,
+    ! where 0 indicates random overlap and 1 indicates maximum-random
+    ! overlap
+    real(jprb), intent(in)  :: overlap_param(nlev-1)
+
+    ! This routine has been coded using the "alpha" overlap parameter
+    ! of Hogan and Illingworth (2000). If the following logical is
+    ! present and true then the input is interpretted to be the "beta"
+    ! overlap parameter of Shonk et al. (2010), and needs to be
+    ! converted to alpha.
+    logical, intent(in), optional :: is_beta_overlap
+
+    ! Outputs
+
+    ! Cumulative cloud cover from TOA to the base of each layer
+    real(jprb), intent(out) :: cum_cloud_cover(nlev)
+
+    ! Cloud cover of a pair of layers
+    real(jprb), intent(out) :: pair_cloud_cover(nlev-1)
+
+    ! Local variables
+
+    ! If this routine is called from the radiation_interface tree then
+    ! very low cloud fractions have already been set to zero, but if
+    ! it is called as a cloud cover diagnostic then this can't be
+    ! guaranteed so a small non-zero numbers is required
+    real(jprb), parameter :: min_frac = 1.0e-6_jprb
+
+    ! "Alpha" overlap parameter
+    real(jprb) :: overlap_alpha(nlev-1)
+    logical    :: do_overlap_conversion
+
+    ! Variables describing "concave cloud objects", i.e. contiguous
+    ! layers where the cloud fraction monotonically increases then
+    ! monotonically decreases
+
+    ! Number of objects
+    integer    :: nobj
+
+    ! Indices to the location of the top, maximum cloud fraction, and
+    ! base, of each concave cloud object
+    integer    :: i_top_obj(nlev)
+    integer    :: i_max_obj(nlev)
+    integer    :: i_base_obj(nlev)
+    ! Poor-man's linked list to allow for deletion of objects: this
+    ! variable points to the index of the next active object
+    integer    :: i_next_obj(nlev)
+
+    ! Cloud cover of object
+    real(jprb) :: cc_obj(nlev)
+
+    ! Overlap parameter between objects
+    real(jprb) :: alpha_obj(nlev)
+
+    ! Do (while) loop index for model level
+    integer :: jlev
+
+    ! Do loop index for object
+    integer :: jobj
+
+    ! Maximum correlation between adjacent objects
+    real(jprb) :: alpha_max
+
+    ! Indices to pair of objects
+    integer    :: iobj1, iobj2
+
+    ! Combined cloud cover of pair of objects, and scaling to modify
+    ! cumulative cloud cover of lower layer
+    real(jprb) :: cc_pair, scaling
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_cloud_cover:cum_cloud_cover_exp_exp',0,hook_handle)
+
+    
+    if (present(is_beta_overlap)) then
+      do_overlap_conversion = is_beta_overlap
+    else
+      do_overlap_conversion = .false.
+    end if
+
+    ! Loop down through atmosphere to locate objects and compute their
+    ! basic properties
+    jlev = 1
+    nobj = 0
+    do while (jlev <= nlev)
+      if (frac(jlev) > min_frac) then
+        ! Starting a new object: store its top
+        nobj = nobj + 1
+        i_top_obj(nobj) = jlev;
+        ! Find its maximum cloud fraction
+        jlev = jlev + 1
+        do while (jlev <= nlev) 
+          if (frac(jlev) < frac(jlev-1)) then
+            exit
+          end if
+          jlev = jlev + 1
+        end do
+        i_max_obj(nobj) = jlev - 1
+        ! Find its base
+        do while (jlev <= nlev)
+          if (frac(jlev) > frac(jlev-1) .or. frac(jlev) <= min_frac) then
+            exit
+          end if
+          jlev = jlev + 1
+        end do
+        ! In the case of cloud fraction profile starting from the top
+        ! like this: 0.1 0.2 0.1 0.2 0.1, we may want the object grouping
+        ! to be (0.1 0.2) (0.1 0.2 0.1), not (0.1 0.2 0.1) (0.2 0.1),
+        ! in which case the following should be uncommented
+        !        if (jlev < nlev) then
+        !          if (frac(jlev) > frac(jlev-1)) then
+        !            jlev = jlev - 1
+        !          end if
+        !        end if
+        i_base_obj(nobj) = jlev - 1
+        ! Index to the next object
+        i_next_obj(nobj) = nobj+1
+      else
+        jlev = jlev + 1
+      end if
+    end do
+
+    ! Array assignments
+    cum_cloud_cover = 0.0_jprb
+    pair_cloud_cover = 0.0_jprb
+
+    if (nobj > 0) then
+      ! Only do any more work if there is cloud present
+      
+      ! To minimize the potential calls to beta2alpha, we do all the
+      ! computations related to overlap parameter here
+      if (.not. do_overlap_conversion) then
+
+        ! Compute the combined cloud cover of pairs of layers
+        do jlev = 1,nlev-1
+          pair_cloud_cover(jlev) &
+               &  = overlap_param(jlev)*max(frac(jlev),frac(jlev+1)) &
+               &  + (1.0_jprb - overlap_param(jlev)) &
+               &  * (frac(jlev)+frac(jlev+1)-frac(jlev)*frac(jlev+1))
+        end do
+        ! Estimate the effective overlap parameter "alpha_obj" between
+        ! adjacent objects as the product of the layerwise overlap
+        ! parameters between their layers of maximum cloud fraction
+        do jobj = 1,nobj-1
+          alpha_obj(jobj) &
+               &  = product(overlap_param(i_max_obj(jobj):i_max_obj(jobj+1)-1))
+        end do
+
+      else
+
+        ! Convert Shonk et al overlap parameter to Hogan and
+        ! Illingworth definition
+        overlap_alpha = beta2alpha(overlap_param, &
+             &                     frac(1:nlev-1), frac(2:nlev))
+        ! Compute the combined cloud cover of pairs of layers
+        do jlev = 1,nlev-1
+          pair_cloud_cover(jlev) &
+               &  = overlap_alpha(jlev)*max(frac(jlev),frac(jlev+1)) &
+               &  + (1.0_jprb - overlap_alpha(jlev)) &
+               &  * (frac(jlev)+frac(jlev+1)-frac(jlev)*frac(jlev+1))          
+        end do
+        ! Estimate the effective overlap parameter "alpha_obj" between
+        ! adjacent objects as the product of the layerwise overlap
+        ! parameters between their layers of maximum cloud fraction
+        do jobj = 1,nobj-1
+          alpha_obj(jobj) &
+               &  = product(overlap_alpha(i_max_obj(jobj):i_max_obj(jobj+1)-1))
+        end do
+
+      end if
+
+
+      ! Compute the cumulative cloud cover working down from the top
+      ! of each object: this will later be converted to the cumulative
+      ! cloud cover working down from TOA
+      do jobj = 1,nobj
+        cum_cloud_cover(i_top_obj(jobj)) = frac(i_top_obj(jobj))
+        do jlev = i_top_obj(jobj), i_base_obj(jobj)-1
+          if (frac(jlev) >= MaxCloudFrac) then
+            ! Cloud cover has reached one
+            cum_cloud_cover(jlev+1) = 1.0_jprb
+          else
+            cum_cloud_cover(jlev+1) = 1.0_jprb &
+                 &  - (1.0_jprb - cum_cloud_cover(jlev)) &
+                 &  * (1.0_jprb - pair_cloud_cover(jlev))  &
+                 &  / (1.0_jprb - frac(jlev))
+          end if
+        end do
+        cc_obj(jobj) = cum_cloud_cover(i_base_obj(jobj))
+      end do
+
+      iobj1 = 1
+
+      ! Sequentially combine objects until there is only one left
+      ! covering the full vertical extent of clouds in the profile
+      do while (nobj > 1)
+        ! Find the most correlated adjacent pair of objects
+        alpha_max = 0.0_jprb
+
+        ! Need to re-initialize iobj1 here in case alpha_obj(:)==0.0,
+        ! which would mean that the "if" statement in the following
+        ! loop would never get triggered
+        iobj1 = 1
+
+        jobj = 1
+        do while (jobj < nobj)
+          if (alpha_obj(jobj) > alpha_max) then
+            alpha_max = alpha_obj(jobj)
+            iobj1 = jobj
+          end if
+          jobj = i_next_obj(jobj)
+        end do
+
+        ! iobj1 is the index to the first object in the pair, set
+        ! iobj2 to the second
+        iobj2 = i_next_obj(iobj1)
+
+        ! Set the cumulative cloud cover in the clear-sky gap between
+        ! the objects to the value at the base of the upper object
+        cum_cloud_cover(i_base_obj(iobj1)+1:i_top_obj(iobj2)-1) &
+             &  = cum_cloud_cover(i_base_obj(iobj1))
+
+        ! Calculate the combined cloud cover of the pair of objects
+        cc_pair = alpha_obj(iobj1)*max(cc_obj(iobj1), cc_obj(iobj2)) &
+             &  + (1.0_jprb - alpha_obj(iobj1)) &
+             &  * (cc_obj(iobj1) + cc_obj(iobj2) - cc_obj(iobj1)*cc_obj(iobj2))
+        scaling = min(max((cc_pair-cc_obj(iobj1)) / max(min_frac, cc_obj(iobj2)), &
+             &            0.0_jprb), &
+             &        1.0_jprb)
+        
+        ! Scale the combined cloud cover of the lower object to
+        ! account for its overlap with the upper object
+        do jlev = i_top_obj(iobj2),i_base_obj(iobj2)
+          cum_cloud_cover(jlev) = cum_cloud_cover(i_base_obj(iobj1)) &
+               +  cum_cloud_cover(jlev) * scaling
+        end do
+        
+        ! Merge the objects by setting the properties of the upper
+        ! object to the combined properties of both.  Note that
+        ! i_max_obj is not modified because it is no longer needed.
+        cc_obj(iobj1) = cc_pair
+        i_base_obj(iobj1) = i_base_obj(iobj2)
+        i_next_obj(iobj1) = i_next_obj(iobj2)
+        alpha_obj(iobj1)  = alpha_obj(iobj2)
+        nobj = nobj - 1
+      end do
+
+      ! Finish off the total cloud cover below cloud
+      cum_cloud_cover(i_base_obj(iobj1)+1:nlev) &
+           &  = cum_cloud_cover(i_base_obj(iobj1)) 
+
+      ! Ensure that the combined cloud cover of pairs of layers is
+      ! consistent with the overhang
+      do jlev = 1,nlev-1
+        pair_cloud_cover(jlev) = max(pair_cloud_cover(jlev), &
+             &     frac(jlev)+cum_cloud_cover(jlev+1)-cum_cloud_cover(jlev))
+      end do
+
+      ! Sometimes round-off error can lead to cloud cover just above
+      ! one, which in turn can lead to direct shortwave fluxes just
+      ! below zero
+      cum_cloud_cover = min(cum_cloud_cover, 1.0_jprb)
+
+    end if ! cloud is present in profile
+
+    if (lhook) call dr_hook('radiation_cloud_cover:cum_cloud_cover_exp_exp',1,hook_handle)
+
+  end subroutine cum_cloud_cover_exp_exp
+
+end module radiation_cloud_cover
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloud_generator.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloud_generator.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloud_generator.F90	(revision 3908)
@@ -0,0 +1,485 @@
+! radiation_cloud_generator.F90 - Generate water-content or optical-depth scalings for McICA
+!
+! (C) Copyright 2015- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Generate clouds for McICA using a method modified from Raisanen et
+! al. (2002)
+!
+! Modifications
+!   2018-02-22  R. Hogan  Call masked version of PDF sampler for speed
+
+module radiation_cloud_generator
+
+  public
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Generate scaling factors for the cloud optical depth to represent
+  ! cloud overlap, the overlap of internal cloud inhomogeneities and
+  ! the fractional standard deviation of these inhomogeneities, for
+  ! use in a Monte Carlo Independent Column Approximation radiation
+  ! scheme. All returned profiles contain cloud, and the total cloud
+  ! cover is also returned, so the calling function can then do a
+  ! weighted average of clear and cloudy skies; this is a way to
+  ! reduce the Monte Carlo noise in profiles with low cloud cover.
+  subroutine cloud_generator(ng, nlev, i_overlap_scheme, &
+       &  iseed, frac_threshold, &
+       &  frac, overlap_param, decorrelation_scaling, &
+       &  fractional_std, pdf_sampler, &
+       &  od_scaling, total_cloud_cover, &
+       &  is_beta_overlap)
+
+    use parkind1, only           : jprb
+    use yomhook,  only           : lhook, dr_hook
+    use radiation_io,   only     : nulerr, radiation_abort
+    use random_numbers_mix, only : randomnumberstream, &
+         initialize_random_numbers, uniform_distribution
+    use radiation_pdf_sampler, only : pdf_sampler_type
+    use radiation_cloud_cover, only : cum_cloud_cover_exp_ran, &
+         &       cum_cloud_cover_max_ran, cum_cloud_cover_exp_exp, &
+         &       IOverlapMaximumRandom, IOverlapExponentialRandom, &
+         &       IOverlapExponential
+
+    implicit none
+
+    ! Inputs
+    integer, intent(in)     :: ng    ! number of g points
+    integer, intent(in)     :: nlev  ! number of model levels
+    integer, intent(in)     :: i_overlap_scheme
+    integer, intent(in)     :: iseed ! seed for random number generator
+
+    ! Only cloud fractions above this threshold are considered to be
+    ! clouds
+    real(jprb), intent(in)  :: frac_threshold
+
+    ! Cloud fraction on full levels
+    real(jprb), intent(in)  :: frac(nlev)
+
+    ! Cloud overlap parameter for interfaces between model layers,
+    ! where 0 indicates random overlap and 1 indicates maximum-random
+    ! overlap
+    real(jprb), intent(in)  :: overlap_param(nlev-1)
+
+    ! Overlap parameter for internal inhomogeneities
+    real(jprb), intent(in)  :: decorrelation_scaling
+
+    ! Fractional standard deviation at each layer
+    real(jprb), intent(in)  :: fractional_std(nlev)
+
+    ! Object for sampling from a lognormal or gamma distribution
+    type(pdf_sampler_type), intent(in) :: pdf_sampler
+
+    ! This routine has been coded using the "alpha" overlap parameter
+    ! of Hogan and Illingworth (2000). If the following logical is
+    ! present and true then the input is interpretted to be the "beta"
+    ! overlap parameter of Shonk et al. (2010), and needs to be
+    ! converted to alpha.
+    logical, intent(in), optional :: is_beta_overlap
+
+    ! Outputs
+
+    ! Cloud optical depth scaling factor, with 0 indicating clear sky
+    real(jprb), intent(out) :: od_scaling(ng,nlev)
+
+    ! Total cloud cover using cloud fraction and overlap parameter
+    real(jprb), intent(out) :: total_cloud_cover
+
+    ! Local variables
+
+    ! Cumulative cloud cover from TOA to the base of each layer
+    real(jprb) :: cum_cloud_cover(nlev)
+
+    ! Scaled random number for finding cloud
+    real(jprb) :: trigger
+
+    ! Uniform deviates between 0 and 1
+    real(jprb) :: rand_top(ng)
+
+    ! Overlap parameter of inhomogeneities
+    real(jprb) :: overlap_param_inhom(nlev-1)
+
+    ! Seed for random number generator and stream for producing random
+    ! numbers
+    type(randomnumberstream) :: random_stream
+    
+    ! First and last cloudy layers
+    integer :: ibegin, iend
+
+    integer :: itrigger
+
+    ! Loop index for model level and g-point
+    integer :: jlev, jg
+
+    ! Cloud cover of a pair of layers, and amount by which cloud at
+    ! next level increases total cloud cover as seen from above
+    real(jprb), dimension(nlev-1) :: pair_cloud_cover, overhang
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_cloud_generator:cloud_generator',0,hook_handle)
+
+    if (i_overlap_scheme == IOverlapExponentialRandom) then
+      call cum_cloud_cover_exp_ran(nlev, frac, overlap_param, &
+           &   cum_cloud_cover, pair_cloud_cover, is_beta_overlap)
+    else if (i_overlap_scheme == IOverlapMaximumRandom) then
+      call cum_cloud_cover_max_ran(nlev, frac, &
+           &   cum_cloud_cover, pair_cloud_cover)
+    else if (i_overlap_scheme == IOverlapExponential) then
+      call cum_cloud_cover_exp_exp(nlev, frac, overlap_param, &
+           &   cum_cloud_cover, pair_cloud_cover, is_beta_overlap)
+    else
+      write(nulerr,'(a)') '*** Error: cloud overlap scheme not recognised'
+      call radiation_abort()
+    end if
+
+    total_cloud_cover = cum_cloud_cover(nlev);
+    do jlev = 1,nlev-1
+      overhang(jlev) = cum_cloud_cover(jlev+1)-cum_cloud_cover(jlev)
+    end do
+
+    if (total_cloud_cover < frac_threshold) then
+      ! Treat column as clear sky: calling function therefore will not
+      ! use od_scaling so we don't need to calculate it
+      total_cloud_cover = 0.0_jprb
+
+    else
+      ! Cloud is present: need to calculate od_scaling
+
+      ! Find range of cloudy layers
+      jlev = 1
+      do while (frac(jlev) <= 0.0_jprb) 
+        jlev = jlev + 1
+      end do
+      ibegin = jlev
+      iend = jlev
+      do jlev = jlev+1,nlev
+        if (frac(jlev) > 0.0_jprb) then
+          iend = jlev
+        end if
+      end do
+
+      ! Set overlap parameter of inhomogeneities
+      overlap_param_inhom = overlap_param
+
+      do jlev = ibegin,iend-1
+        if (overlap_param(jlev) > 0.0_jprb) then
+          overlap_param_inhom(jlev) &
+               &  = overlap_param(jlev)**(1.0_jprb/decorrelation_scaling)
+        end if
+      end do
+
+      ! Reset optical depth scaling to clear skies
+      od_scaling = 0.0_jprb
+
+      ! Expensive operation: initialize random number generator for
+      ! this column
+      call initialize_random_numbers(iseed, random_stream)
+
+      ! Compute ng random numbers to use to locate cloud top
+      call uniform_distribution(rand_top, random_stream)
+
+      ! Loop over ng columns
+      do jg = 1,ng
+        ! Find the cloud top height corresponding to the current
+        ! random number, and store in itrigger
+        trigger = rand_top(jg) * total_cloud_cover
+        jlev = ibegin
+        do while (trigger > cum_cloud_cover(jlev) .and. jlev < iend)
+          jlev = jlev + 1
+        end do
+        itrigger = jlev
+
+        if (i_overlap_scheme /= IOverlapExponential) then
+          call generate_column_exp_ran(ng, nlev, jg, random_stream, pdf_sampler, &
+               &  frac, pair_cloud_cover, &
+               &  cum_cloud_cover, overhang, fractional_std, overlap_param_inhom, &
+               &  itrigger, iend, od_scaling)
+        else
+          call generate_column_exp_exp(ng, nlev, jg, random_stream, pdf_sampler, &
+               &  frac, pair_cloud_cover, &
+               &  cum_cloud_cover, overhang, fractional_std, overlap_param_inhom, &
+               &  itrigger, iend, od_scaling)
+        end if
+        
+      end do
+
+    end if
+
+
+    if (lhook) call dr_hook('radiation_cloud_generator:cloud_generator',1,hook_handle)
+
+  end subroutine cloud_generator
+
+
+  !---------------------------------------------------------------------
+  ! Generate a column of optical depth scalings using
+  ! exponential-random overlap (which includes maximum-random overlap
+  ! as a limiting case)
+  subroutine generate_column_exp_ran(ng, nlev, ig, random_stream, pdf_sampler, &
+       &  frac, pair_cloud_cover, &
+       &  cum_cloud_cover, overhang, fractional_std, overlap_param_inhom, &
+       &  itrigger, iend, od_scaling)
+
+    use parkind1,              only : jprb
+    use radiation_pdf_sampler, only : pdf_sampler_type
+    use random_numbers_mix,    only : randomnumberstream, &
+         initialize_random_numbers, uniform_distribution
+
+
+    implicit none
+
+    ! Number of g points / columns, and number of current column
+    integer, intent(in) :: ng, ig
+
+    ! Number of levels
+    integer, intent(in) :: nlev
+
+    ! Stream for producing random numbers
+    type(randomnumberstream), intent(inout) :: random_stream
+
+    ! Object for sampling from a lognormal or gamma distribution
+    type(pdf_sampler_type), intent(in) :: pdf_sampler
+
+    ! Cloud fraction, cumulative cloud cover and fractional standard
+    ! deviation in each layer
+    real(jprb), intent(in), dimension(nlev) :: frac, cum_cloud_cover, fractional_std
+
+    ! Cloud cover of a pair of layers, and amount by which cloud at
+    ! next level increases total cloud cover as seen from above
+    real(jprb), intent(in), dimension(nlev-1) :: pair_cloud_cover, overhang
+
+    ! Overlap parameter of inhomogeneities
+    real(jprb), intent(in), dimension(nlev-1) :: overlap_param_inhom
+
+    ! Top of highest cloudy layer (in this subcolumn) and base of
+    ! lowest
+    integer, intent(in) :: itrigger, iend
+
+    ! Optical depth scaling to output
+    real(jprb), intent(inout), dimension(ng,nlev) :: od_scaling
+
+    ! Height indices
+    integer :: jlev, jcloud
+
+    ! Number of contiguous cloudy layers for which to compute optical
+    ! depth scaling
+    integer :: n_layers_to_scale
+
+    integer :: iy
+
+    ! Is it time to fill the od_scaling variable?
+    logical :: do_fill_od_scaling
+
+    real(jprb) :: rand_cloud(nlev)
+    real(jprb) :: rand_inhom1(nlev), rand_inhom2(nlev)
+
+    ! So far our vertically contiguous cloud contains only one layer
+    n_layers_to_scale = 1
+    iy = 0
+
+    ! Locate the clouds below this layer: first generate some more
+    ! random numbers
+    call uniform_distribution(rand_cloud(1:(iend+1-itrigger)),random_stream)
+
+    ! Loop from the layer below the local cloud top down to the
+    ! bottom-most cloudy layer
+    do jlev = itrigger+1,iend+1
+      do_fill_od_scaling = .false.
+      if (jlev <= iend) then
+        iy = iy+1
+        if (n_layers_to_scale > 0) then
+          ! There is a cloud above, in which case the probability
+          ! of cloud in the layer below is as follows
+          if (rand_cloud(iy)*frac(jlev-1) &
+               &  < frac(jlev) + frac(jlev-1) - pair_cloud_cover(jlev-1)) then
+            ! Add another cloudy layer
+            n_layers_to_scale = n_layers_to_scale + 1
+          else 
+            ! Reached the end of a contiguous set of cloudy layers and
+            ! will compute the optical depth scaling immediately.
+            do_fill_od_scaling = .true.
+          end if
+        else
+          ! There is clear-sky above, in which case the
+          ! probability of cloud in the layer below is as follows
+          if (rand_cloud(iy)*(cum_cloud_cover(jlev-1) - frac(jlev-1)) &
+               &  < pair_cloud_cover(jlev-1) - overhang(jlev-1) - frac(jlev-1)) then
+            ! A new cloud top
+            n_layers_to_scale = 1
+          end if
+        end if
+      else
+        ! We are at the bottom of the cloudy layers in the model,
+        ! so in a moment need to populate the od_scaling array
+        do_fill_od_scaling = .true.
+      end if
+
+      if (do_fill_od_scaling) then
+        ! We have a contiguous range of layers for which we
+        ! compute the od_scaling elements using some random
+        ! numbers
+        call uniform_distribution(rand_inhom1(1:n_layers_to_scale),random_stream)
+        call uniform_distribution(rand_inhom2(1:n_layers_to_scale),random_stream)
+
+        ! Loop through the sequence of cloudy layers
+        do jcloud = 2,n_layers_to_scale
+          ! Use second random number, and inhomogeneity overlap
+          ! parameter, to decide whether the first random number
+          ! should be repeated (corresponding to maximum overlap)
+          ! or not (corresponding to random overlap)
+          if (rand_inhom2(jcloud) &
+               &  < overlap_param_inhom(jlev-n_layers_to_scale+jcloud-2)) then
+            rand_inhom1(jcloud) = rand_inhom1(jcloud-1)
+          end if
+        end do
+        
+        ! Sample from a lognormal or gamma distribution to obtain
+        ! the optical depth scalings
+        call pdf_sampler%sample(fractional_std(jlev-n_layers_to_scale:jlev-1), &
+             & rand_inhom1(1:n_layers_to_scale), od_scaling(ig,jlev-n_layers_to_scale:jlev-1))
+
+        n_layers_to_scale = 0
+      end if
+          
+    end do
+
+  end subroutine generate_column_exp_ran
+
+
+
+  !---------------------------------------------------------------------
+  ! Generate a column of optical depth scalings using
+  ! exponential-exponential overlap
+  subroutine generate_column_exp_exp(ng, nlev, ig, random_stream, pdf_sampler, &
+       &  frac, pair_cloud_cover, &
+       &  cum_cloud_cover, overhang, fractional_std, overlap_param_inhom, &
+       &  itrigger, iend, od_scaling)
+
+    use parkind1,              only : jprb
+    use radiation_pdf_sampler, only : pdf_sampler_type
+    use random_numbers_mix,    only : randomnumberstream, &
+         initialize_random_numbers, uniform_distribution
+
+    implicit none
+
+    ! Number of g points / columns, and number of current column
+    integer, intent(in) :: ng, ig
+
+    ! Number of levels
+    integer, intent(in) :: nlev
+
+    ! Stream for producing random numbers
+    type(randomnumberstream), intent(inout) :: random_stream
+
+    ! Object for sampling from a lognormal or gamma distribution
+    type(pdf_sampler_type), intent(in) :: pdf_sampler
+
+    ! Cloud fraction, cumulative cloud cover and fractional standard
+    ! deviation in each layer
+    real(jprb), intent(in), dimension(nlev) :: frac, cum_cloud_cover, fractional_std
+
+    ! Cloud cover of a pair of layers, and amount by which cloud at
+    ! next level increases total cloud cover as seen from above
+    real(jprb), intent(in), dimension(nlev-1) :: pair_cloud_cover, overhang
+
+    ! Overlap parameter of inhomogeneities
+    real(jprb), intent(in), dimension(nlev-1) :: overlap_param_inhom
+
+    ! Top of highest cloudy layer (in this subcolumn) and base of
+    ! lowest
+    integer, intent(in) :: itrigger, iend
+
+    ! Optical depth scaling to output
+    real(jprb), intent(inout), dimension(ng,nlev) :: od_scaling
+
+    ! Height indices
+    integer :: jlev, jcloud
+
+    integer :: iy
+
+    real(jprb) :: rand_cloud(nlev)
+    real(jprb) :: rand_inhom1(nlev), rand_inhom2(nlev)
+
+    ! For each column analysed, this vector locates the clouds. It is
+    ! only actually used for Exp-Exp overlap
+    logical :: is_cloudy(nlev)
+
+    ! Number of contiguous cloudy layers for which to compute optical
+    ! depth scaling
+    integer :: n_layers_to_scale
+
+    iy = 0
+
+    is_cloudy = .false.
+    is_cloudy(itrigger) = .true.
+
+    ! Locate the clouds below this layer: first generate some more
+    ! random numbers
+    call uniform_distribution(rand_cloud(1:(iend+1-itrigger)),random_stream)
+
+    ! Loop from the layer below the local cloud top down to the
+    ! bottom-most cloudy layer
+    do jlev = itrigger+1,iend
+      iy = iy+1
+      if (is_cloudy(jlev-1)) then
+        ! There is a cloud above, in which case the probability
+        ! of cloud in the layer below is as follows
+        if (rand_cloud(iy)*frac(jlev-1) &
+             &  < frac(jlev) + frac(jlev-1) - pair_cloud_cover(jlev-1)) then
+          ! Add another cloudy layer
+          is_cloudy(jlev) = .true.
+        end if
+      else
+        ! There is clear-sky above, in which case the
+        ! probability of cloud in the layer below is as follows
+        if (rand_cloud(iy)*(cum_cloud_cover(jlev-1) - frac(jlev-1)) &
+             &  < pair_cloud_cover(jlev-1) - overhang(jlev-1) - frac(jlev-1)) then
+            ! A new cloud top
+          is_cloudy(jlev) = .true.
+        end if
+      end if
+    end do
+
+    ! We have a contiguous range of layers for which we compute the
+    ! od_scaling elements using some random numbers
+
+    ! In the Exp-Exp overlap scheme we do all layers at once
+    n_layers_to_scale = iend+1 - itrigger
+        
+    call uniform_distribution(rand_inhom1(1:n_layers_to_scale),random_stream)
+    call uniform_distribution(rand_inhom2(1:n_layers_to_scale),random_stream)
+        
+    ! Loop through the sequence of cloudy layers
+    do jcloud = 2,n_layers_to_scale
+      ! Use second random number, and inhomogeneity overlap
+      ! parameter, to decide whether the first random number
+      ! should be repeated (corresponding to maximum overlap)
+      ! or not (corresponding to random overlap)
+      if (rand_inhom2(jcloud) &
+           &  < overlap_param_inhom(iend-n_layers_to_scale+jcloud-1)) then
+        rand_inhom1(jcloud) = rand_inhom1(jcloud-1)
+      end if
+    end do
+        
+    ! Sample from a lognormal or gamma distribution to obtain the
+    ! optical depth scalings, calling the faster masked version and
+    ! assuming values outside the range itrigger:iend are already zero
+    call pdf_sampler%masked_sample(n_layers_to_scale, &
+         &  fractional_std(itrigger:iend), &
+         &  rand_inhom1(1:n_layers_to_scale), od_scaling(ig,itrigger:iend), &
+         &  is_cloudy(itrigger:iend))
+        
+  end subroutine generate_column_exp_exp
+
+end module radiation_cloud_generator
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloud_optics.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloud_optics.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloud_optics.F90	(revision 3908)
@@ -0,0 +1,491 @@
+! radiation_cloud_optics.F90 - Computing cloud optical properties
+!
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2017-07-22  R. Hogan  Added Yi et al. ice optics model
+
+module radiation_cloud_optics
+
+  implicit none
+  public
+
+contains
+
+  ! Provides elemental function "delta_eddington_scat_od"
+#include "radiation_delta_eddington.h"
+
+  !---------------------------------------------------------------------
+  ! Load cloud scattering data; this subroutine delegates to one
+  ! in radiation_cloud_optics_data.F90, but checks the size of
+  ! what is returned
+  subroutine setup_cloud_optics(config)
+
+    use parkind1,         only : jprb
+    use yomhook,          only : lhook, dr_hook
+
+    use radiation_io,     only : nulerr, radiation_abort
+    use radiation_config, only : config_type, IIceModelFu, IIceModelBaran, &
+         &                       IIceModelBaran2016, IIceModelBaran2017, &
+         &                       IIceModelYi, &
+         &                       ILiquidModelSOCRATES, ILiquidModelSlingo
+    use radiation_cloud_optics_data, only  : cloud_optics_type
+    use radiation_ice_optics_fu, only    : NIceOpticsCoeffsFuSW, &
+         &                                 NIceOpticsCoeffsFuLW
+    use radiation_ice_optics_baran, only : NIceOpticsCoeffsBaran, &
+         &                                 NIceOpticsCoeffsBaran2016
+    use radiation_ice_optics_baran2017, only : NIceOpticsCoeffsBaran2017, &
+         &                                 NIceOpticsGeneralCoeffsBaran2017
+    use radiation_ice_optics_yi, only    : NIceOpticsCoeffsYiSW, &
+         &                                 NIceOpticsCoeffsYiLW
+    use radiation_liquid_optics_socrates, only : NLiqOpticsCoeffsSOCRATES
+    use radiation_liquid_optics_slingo, only : NLiqOpticsCoeffsSlingoSW, &
+         &                                     NLiqOpticsCoeffsLindnerLiLW
+
+    type(config_type), intent(inout) :: config
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_cloud_optics:setup_cloud_optics',0,hook_handle)
+
+    call config%cloud_optics%setup(trim(config%liq_optics_file_name), &
+         &     trim(config%ice_optics_file_name), iverbose=config%iverbosesetup)
+
+    ! Check liquid coefficients
+    if (size(config%cloud_optics%liq_coeff_lw, 1) /= config%n_bands_lw) then
+      write(nulerr,'(a,i0,a,i0,a)') &
+           &  '*** Error: number of longwave bands for droplets (', &
+           &  size(config%cloud_optics%liq_coeff_lw, 1), &
+           &  ') does not match number for gases (', config%n_bands_lw, ')'
+      call radiation_abort()
+    end if
+    if (size(config%cloud_optics%liq_coeff_sw, 1) /= config%n_bands_sw) then
+      write(nulerr,'(a,i0,a,i0,a)') &
+           &  '*** Error: number of shortwave bands for droplets (', &
+           &  size(config%cloud_optics%liq_coeff_sw, 1), &
+           &  ') does not match number for gases (', config%n_bands_sw, ')'
+      call radiation_abort()        
+    end if
+
+    if (config%i_liq_model == ILiquidModelSOCRATES) then
+      if (size(config%cloud_optics%liq_coeff_lw, 2) /= NLiqOpticsCoeffsSOCRATES) then
+        write(nulerr,'(a,i0,a,i0,a,i0,a)') &
+             &  '*** Error: number of liquid cloud optical coefficients (', &
+             &  size(config%cloud_optics%liq_coeff_lw, 2), &
+             &  ') does not match number expected (', NLiqOpticsCoeffsSOCRATES,')'
+        call radiation_abort()
+      end if
+    else if (config%i_liq_model == ILiquidModelSlingo) then
+      if (size(config%cloud_optics%liq_coeff_sw, 2) /= NLiqOpticsCoeffsSlingoSW) then
+        write(nulerr,'(a,i0,a,i0,a,i0,a)') &
+             &  '*** Error: number of shortwave liquid cloud optical coefficients (', &
+             &  size(config%cloud_optics%liq_coeff_sw, 2), &
+             &  ') does not match number expected (', NLiqOpticsCoeffsSlingoSW,')'
+        call radiation_abort()
+      end if
+      if (size(config%cloud_optics%liq_coeff_lw, 2) /= NLiqOpticsCoeffsLindnerLiLW) then
+        write(nulerr,'(a,i0,a,i0,a,i0,a)') &
+             &  '*** Error: number of longwave liquid cloud optical coefficients (', &
+             &  size(config%cloud_optics%liq_coeff_lw, 2), &
+             &  ') does not match number expected (', NLiqOpticsCoeffsLindnerLiLw,')'
+        call radiation_abort()
+      end if
+    end if
+
+    ! Check ice coefficients
+    if (size(config%cloud_optics%ice_coeff_lw, 1) /= config%n_bands_lw) then
+      write(nulerr,'(a,i0,a,i0,a)') &
+           &  '*** Error: number of longwave bands for ice particles (', &
+           &  size(config%cloud_optics%ice_coeff_lw, 1), &
+           &  ') does not match number for gases (', config%n_bands_lw, ')'
+      call radiation_abort()
+    end if
+    if (size(config%cloud_optics%ice_coeff_sw, 1) /= config%n_bands_sw) then
+      write(nulerr,'(a,i0,a,i0,a)') &
+           &  '*** Error: number of shortwave bands for ice particles (', &
+           &  size(config%cloud_optics%ice_coeff_sw, 1), &
+           &  ') does not match number for gases (', config%n_bands_sw, ')'
+      call radiation_abort()
+    end if
+
+    if (config%i_ice_model == IIceModelFu) then
+      if (size(config%cloud_optics%ice_coeff_lw, 2) &
+           &  /= NIceOpticsCoeffsFuLW) then
+        write(nulerr,'(a,i0,a,i0,a,i0,a)') &
+             &  '*** Error: number of LW ice-particle optical coefficients (', &
+             &  size(config%cloud_optics%ice_coeff_lw, 2), &
+             &  ') does not match number expected (', NIceOpticsCoeffsFuLW,')'
+        call radiation_abort()
+      end if
+      if (size(config%cloud_optics%ice_coeff_sw, 2) &
+           &  /= NIceOpticsCoeffsFuSW) then
+        write(nulerr,'(a,i0,a,i0,a,i0,a)') &
+             &  '*** Error: number of SW ice-particle optical coefficients (', &
+             &  size(config%cloud_optics%ice_coeff_sw, 2), &
+             &  ') does not match number expected (', NIceOpticsCoeffsFuSW,')'
+        call radiation_abort()
+      end if
+    else if (config%i_ice_model == IIceModelBaran &
+         &  .and. size(config%cloud_optics%ice_coeff_lw, 2) &
+         &  /= NIceOpticsCoeffsBaran) then
+      write(nulerr,'(a,i0,a,i0,a,i0,a)') &
+           &  '*** Error: number of ice-particle optical coefficients (', &
+           &  size(config%cloud_optics%ice_coeff_lw, 2), &
+           &  ') does not match number expected (', NIceOpticsCoeffsBaran,')'
+      call radiation_abort()
+    else if (config%i_ice_model == IIceModelBaran2016 &
+         &  .and. size(config%cloud_optics%ice_coeff_lw, 2) &
+         &  /= NIceOpticsCoeffsBaran2016) then
+      write(nulerr,'(a,i0,a,i0,a,i0,a)') &
+           &  '*** Error: number of ice-particle optical coefficients (', &
+           &  size(config%cloud_optics%ice_coeff_lw, 2), &
+           &  ') does not match number expected (', NIceOpticsCoeffsBaran2016,')'
+      call radiation_abort()
+    else if (config%i_ice_model == IIceModelBaran2017) then
+      if (size(config%cloud_optics%ice_coeff_lw, 2) &
+           &  /= NIceOpticsCoeffsBaran2017) then
+        write(nulerr,'(a,i0,a,i0,a,i0,a)') &
+             &  '*** Error: number of ice-particle optical coefficients (', &
+             &  size(config%cloud_optics%ice_coeff_lw, 2), &
+             &  ') does not match number expected (', NIceOpticsCoeffsBaran2017,')'
+        call radiation_abort()
+      else if (.not. allocated(config%cloud_optics%ice_coeff_gen)) then
+        write(nulerr,'(a)') &
+             &  '*** Error: coeff_gen needed for Baran-2017 ice optics parameterization'
+        call radiation_abort()
+      else if (size(config%cloud_optics%ice_coeff_gen) &
+           &  /= NIceOpticsGeneralCoeffsBaran2017) then
+        write(nulerr,'(a,i0,a,i0,a,i0,a)') &
+             &  '*** Error: number of general ice-particle optical coefficients (', &
+             &  size(config%cloud_optics%ice_coeff_gen), &
+             &  ') does not match number expected (', NIceOpticsGeneralCoeffsBaran2017,')'
+        call radiation_abort()
+      end if
+    else if (config%i_ice_model == IIceModelYi) then
+      if (size(config%cloud_optics%ice_coeff_lw, 2) &
+           &  /= NIceOpticsCoeffsYiLW) then
+        write(nulerr,'(a,i0,a,i0,a,i0,a)') &
+             &  '*** Error: number of LW ice-particle optical coefficients (', &
+             &  size(config%cloud_optics%ice_coeff_lw, 2), &
+             &  ') does not match number expected (', NIceOpticsCoeffsYiLW,')'
+        call radiation_abort()
+      end if
+      if (size(config%cloud_optics%ice_coeff_sw, 2) &
+           &  /= NIceOpticsCoeffsYiSW) then
+        write(nulerr,'(a,i0,a,i0,a,i0,a)') &
+             &  '*** Error: number of SW ice-particle optical coefficients (', &
+             &  size(config%cloud_optics%ice_coeff_sw, 2), &
+             &  ') does not match number expected (', NIceOpticsCoeffsYiSW,')'
+        call radiation_abort()
+      end if
+    end if
+
+    if (lhook) call dr_hook('radiation_cloud_optics:setup_cloud_optics',1,hook_handle)
+
+  end subroutine setup_cloud_optics
+
+
+  !---------------------------------------------------------------------
+  ! Compute cloud optical properties
+  subroutine cloud_optics(nlev,istartcol,iendcol, &
+       &  config, thermodynamics, cloud, & 
+       &  od_lw_cloud, ssa_lw_cloud, g_lw_cloud, &
+       &  od_sw_cloud, ssa_sw_cloud, g_sw_cloud)
+
+    use parkind1, only           : jprb
+    use yomhook,  only           : lhook, dr_hook
+
+    use radiation_io,     only : nulout, nulerr, radiation_abort
+    use radiation_config, only : config_type, IIceModelFu, IIceModelBaran, &
+         &                       IIceModelBaran2016, IIceModelBaran2017, &
+         &                       IIceModelYi, &
+         &                       ILiquidModelSOCRATES, ILiquidModelSlingo
+    use radiation_thermodynamics, only    : thermodynamics_type
+    use radiation_cloud, only             : cloud_type
+    use radiation_constants, only         : AccelDueToGravity
+    use radiation_cloud_optics_data, only : cloud_optics_type
+    use radiation_ice_optics_fu, only     : calc_ice_optics_fu_sw, &
+         &                                  calc_ice_optics_fu_lw
+    use radiation_ice_optics_baran, only  : calc_ice_optics_baran, &
+         &                                  calc_ice_optics_baran2016
+    use radiation_ice_optics_baran2017, only  : calc_ice_optics_baran2017
+    use radiation_ice_optics_yi, only     : calc_ice_optics_yi_sw, &
+         &                                  calc_ice_optics_yi_lw
+    use radiation_liquid_optics_socrates, only:calc_liq_optics_socrates
+    use radiation_liquid_optics_slingo, only:calc_liq_optics_slingo, &
+         &                                   calc_liq_optics_lindner_li
+
+    integer, intent(in) :: nlev               ! number of model levels
+    integer, intent(in) :: istartcol, iendcol ! range of columns to process
+    type(config_type), intent(in), target :: config
+    type(thermodynamics_type),intent(in)  :: thermodynamics
+    type(cloud_type),   intent(in)        :: cloud
+
+    ! Layer optical depth, single scattering albedo and g factor of
+    ! clouds in each longwave band, where the latter two
+    ! variables are only defined if cloud longwave scattering is
+    ! enabled (otherwise both are treated as zero).
+    real(jprb), dimension(config%n_bands_lw,nlev,istartcol:iendcol), intent(out) :: &
+         &   od_lw_cloud
+    real(jprb), dimension(config%n_bands_lw_if_scattering,nlev,istartcol:iendcol), &
+         &   intent(out) :: ssa_lw_cloud, g_lw_cloud
+
+    ! Layer optical depth, single scattering albedo and g factor of
+    ! clouds in each shortwave band
+    real(jprb), dimension(config%n_bands_sw,nlev,istartcol:iendcol), intent(out) :: &
+         &   od_sw_cloud, ssa_sw_cloud, g_sw_cloud
+
+    ! Longwave and shortwave optical depth, scattering optical depth
+    ! and asymmetry factor, for liquid and ice in all bands but a
+    ! single cloud layer
+    real(jprb), dimension(config%n_bands_lw) :: &
+         &  od_lw_liq, scat_od_lw_liq, g_lw_liq, &
+         &  od_lw_ice, scat_od_lw_ice, g_lw_ice
+    real(jprb), dimension(config%n_bands_sw) :: &
+         &  od_sw_liq, scat_od_sw_liq, g_sw_liq, &
+         &  od_sw_ice, scat_od_sw_ice, g_sw_ice
+
+    ! In-cloud water path of cloud liquid or ice (i.e. liquid or ice
+    ! gridbox-mean water path divided by cloud fraction); kg m-2
+    real(jprb) :: lwp_in_cloud, iwp_in_cloud
+
+    ! Full-level temperature (K)
+    real(jprb) :: temperature
+
+    ! Factor to convert gridbox-mean mixing ratio to in-cloud water
+    ! path
+    real(jprb) :: factor
+
+    ! Pointer to the cloud optics coefficients for brevity of
+    ! access
+    type(cloud_optics_type), pointer :: ho
+
+    integer    :: jcol, jlev
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_cloud_optics:cloud_optics',0,hook_handle)
+
+    if (config%iverbose >= 2) then
+      write(nulout,'(a)') 'Computing cloud absorption/scattering properties'
+    end if
+
+    ho => config%cloud_optics
+
+    ! Array-wise assignment
+    od_lw_cloud  = 0.0_jprb
+    od_sw_cloud  = 0.0_jprb
+    ssa_sw_cloud = 0.0_jprb
+    g_sw_cloud   = 0.0_jprb
+    if (config%do_lw_cloud_scattering) then
+      ssa_lw_cloud = 0.0_jprb
+      g_lw_cloud   = 0.0_jprb
+    end if
+
+    do jlev = 1,nlev
+      do jcol = istartcol,iendcol
+        ! Only do anything if cloud is present (assume that
+        ! cloud%crop_cloud_fraction has already been called)
+        if (cloud%fraction(jcol,jlev) > 0.0_jprb) then
+
+          ! Compute in-cloud liquid and ice water path
+          if (config%is_homogeneous) then
+            ! Homogeneous solvers assume cloud fills the box
+            ! horizontally, so we don't divide by cloud fraction
+            factor = ( thermodynamics%pressure_hl(jcol,jlev+1)    &
+                 &  -thermodynamics%pressure_hl(jcol,jlev  )  ) &
+                 &  / AccelDueToGravity
+          else
+            factor = ( thermodynamics%pressure_hl(jcol,jlev+1)    &
+                 &  -thermodynamics%pressure_hl(jcol,jlev  )  ) &
+                 &  / (AccelDueToGravity * cloud%fraction(jcol,jlev))
+          end if
+          lwp_in_cloud = factor * cloud%q_liq(jcol,jlev)
+          iwp_in_cloud = factor * cloud%q_ice(jcol,jlev)
+
+          ! Only compute liquid properties if liquid cloud is
+          ! present
+          if (lwp_in_cloud > 0.0_jprb) then
+            if (config%i_liq_model == ILiquidModelSOCRATES) then
+              ! Compute longwave properties
+              call calc_liq_optics_socrates(config%n_bands_lw, &
+                   &  config%cloud_optics%liq_coeff_lw, &
+                   &  lwp_in_cloud, cloud%re_liq(jcol,jlev), &
+                   &  od_lw_liq, scat_od_lw_liq, g_lw_liq)
+              ! Compute shortwave properties
+              call calc_liq_optics_socrates(config%n_bands_sw, &
+                   &  config%cloud_optics%liq_coeff_sw, &
+                   &  lwp_in_cloud, cloud%re_liq(jcol,jlev), &
+                   &  od_sw_liq, scat_od_sw_liq, g_sw_liq)
+            else if (config%i_liq_model == ILiquidModelSlingo) then
+              ! Compute longwave properties
+              call calc_liq_optics_lindner_li(config%n_bands_lw, &
+                   &  config%cloud_optics%liq_coeff_lw, &
+                   &  lwp_in_cloud, cloud%re_liq(jcol,jlev), &
+                   &  od_lw_liq, scat_od_lw_liq, g_lw_liq)
+              ! Compute shortwave properties
+              call calc_liq_optics_slingo(config%n_bands_sw, &
+                   &  config%cloud_optics%liq_coeff_sw, &
+                   &  lwp_in_cloud, cloud%re_liq(jcol,jlev), &
+                   &  od_sw_liq, scat_od_sw_liq, g_sw_liq)
+            else
+              write(nulerr,*) '*** Error: Unknown liquid model with code', &
+                   &          config%i_liq_model
+              call radiation_abort()
+            end if
+
+            if (.not. config%do_sw_delta_scaling_with_gases) then
+              ! Delta-Eddington scaling in the shortwave only
+              call delta_eddington_scat_od(od_sw_liq, scat_od_sw_liq, g_sw_liq)
+            end if
+          else
+            ! Liquid not present: set properties to zero
+            od_lw_liq = 0.0_jprb
+            scat_od_lw_liq = 0.0_jprb
+            g_lw_liq = 0.0_jprb
+
+            od_sw_liq = 0.0_jprb
+            scat_od_sw_liq = 0.0_jprb
+            g_sw_liq = 0.0_jprb
+          end if ! Liquid present
+
+          ! Only compute ice properties if ice cloud is present
+          if (iwp_in_cloud > 0.0_jprb) then
+            if (config%i_ice_model == IIceModelBaran) then
+              ! Compute longwave properties
+              call calc_ice_optics_baran(config%n_bands_lw, &
+                   &  config%cloud_optics%ice_coeff_lw, &
+                   &  iwp_in_cloud, cloud%q_ice(jcol,jlev), &
+                   &  od_lw_ice, scat_od_lw_ice, g_lw_ice)
+              ! Compute shortwave properties
+              call calc_ice_optics_baran(config%n_bands_sw, &
+                   &  config%cloud_optics%ice_coeff_sw, &
+                   &  iwp_in_cloud, cloud%q_ice(jcol,jlev), &
+                   &  od_sw_ice, scat_od_sw_ice, g_sw_ice)
+            else if (config%i_ice_model == IIceModelBaran2016) then
+              temperature = 0.5_jprb * (thermodynamics%temperature_hl(jcol,jlev) &
+                   &                   +thermodynamics%temperature_hl(jcol,jlev+1))
+              ! Compute longwave properties
+              call calc_ice_optics_baran2016(config%n_bands_lw, &
+                   &  config%cloud_optics%ice_coeff_lw, &
+                   &  iwp_in_cloud, cloud%q_ice(jcol,jlev), &
+                   &  temperature, &
+                   &  od_lw_ice, scat_od_lw_ice, g_lw_ice)
+              ! Compute shortwave properties
+              call calc_ice_optics_baran2016(config%n_bands_sw, &
+                   &  config%cloud_optics%ice_coeff_sw, &
+                   &  iwp_in_cloud, cloud%q_ice(jcol,jlev), &
+                   &  temperature, &
+                   &  od_sw_ice, scat_od_sw_ice, g_sw_ice)
+            else if (config%i_ice_model == IIceModelBaran2017) then
+              temperature = 0.5_jprb * (thermodynamics%temperature_hl(jcol,jlev) &
+                   &                   +thermodynamics%temperature_hl(jcol,jlev+1))
+              ! Compute longwave properties
+              call calc_ice_optics_baran2017(config%n_bands_lw, &
+                   &  config%cloud_optics%ice_coeff_gen, &
+                   &  config%cloud_optics%ice_coeff_lw, &
+                   &  iwp_in_cloud, cloud%q_ice(jcol,jlev), &
+                   &  temperature, &
+                   &  od_lw_ice, scat_od_lw_ice, g_lw_ice)
+              ! Compute shortwave properties
+              call calc_ice_optics_baran2017(config%n_bands_sw, &
+                   &  config%cloud_optics%ice_coeff_gen, &
+                   &  config%cloud_optics%ice_coeff_sw, &
+                   &  iwp_in_cloud, cloud%q_ice(jcol,jlev), &
+                   &  temperature, &
+                   &  od_sw_ice, scat_od_sw_ice, g_sw_ice)
+            else if (config%i_ice_model == IIceModelFu) then
+              ! Compute longwave properties
+              call calc_ice_optics_fu_lw(config%n_bands_lw, &
+                   &  config%cloud_optics%ice_coeff_lw, &
+                   &  iwp_in_cloud, cloud%re_ice(jcol,jlev), &
+                   &  od_lw_ice, scat_od_lw_ice, g_lw_ice)
+              if (config%do_fu_lw_ice_optics_bug) then
+                ! Reproduce bug in old IFS scheme
+                scat_od_lw_ice = od_lw_ice - scat_od_lw_ice
+              end if
+              ! Compute shortwave properties
+              call calc_ice_optics_fu_sw(config%n_bands_sw, &
+                   &  config%cloud_optics%ice_coeff_sw, &
+                   &  iwp_in_cloud, cloud%re_ice(jcol,jlev), &
+                   &  od_sw_ice, scat_od_sw_ice, g_sw_ice)
+            else if (config%i_ice_model == IIceModelYi) then
+              ! Compute longwave properties
+              call calc_ice_optics_yi_lw(config%n_bands_lw, &
+                   &  config%cloud_optics%ice_coeff_lw, &
+                   &  iwp_in_cloud, cloud%re_ice(jcol,jlev), &
+                   &  od_lw_ice, scat_od_lw_ice, g_lw_ice)
+              ! Compute shortwave properties
+              call calc_ice_optics_yi_sw(config%n_bands_sw, &
+                   &  config%cloud_optics%ice_coeff_sw, &
+                   &  iwp_in_cloud, cloud%re_ice(jcol,jlev), &
+                   &  od_sw_ice, scat_od_sw_ice, g_sw_ice)
+            else
+              write(nulerr,*) '*** Error: Unknown ice model with code', &
+                   &          config%i_ice_model
+              call radiation_abort()
+            end if
+
+            if (.not. config%do_sw_delta_scaling_with_gases) then
+              ! Delta-Eddington scaling in both longwave and shortwave
+              ! (assume that particles are larger than wavelength even
+              ! in longwave)
+              call delta_eddington_scat_od(od_sw_ice, scat_od_sw_ice, g_sw_ice)
+            end if
+
+            call delta_eddington_scat_od(od_lw_ice, scat_od_lw_ice, g_lw_ice)
+          else
+            ! Ice not present: set properties to zero
+            od_lw_ice = 0.0_jprb
+            scat_od_lw_ice = 0.0_jprb
+            g_lw_ice = 0.0_jprb
+
+            od_sw_ice = 0.0_jprb
+            scat_od_sw_ice = 0.0_jprb
+            g_sw_ice = 0.0_jprb
+          end if ! Ice present
+
+          ! Combine liquid and ice 
+          if (config%do_lw_cloud_scattering) then
+            od_lw_cloud(:,jlev,jcol) = od_lw_liq + od_lw_ice
+            where (scat_od_lw_liq+scat_od_lw_ice > 0.0_jprb)
+              g_lw_cloud(:,jlev,jcol) = (g_lw_liq * scat_od_lw_liq &
+                   &  + g_lw_ice * scat_od_lw_ice) &
+                   &  / (scat_od_lw_liq+scat_od_lw_ice)
+            elsewhere
+              g_lw_cloud(:,jlev,jcol) = 0.0_jprb
+            end where
+            ssa_lw_cloud(:,jlev,jcol) = (scat_od_lw_liq + scat_od_lw_ice) &
+                 &                    / (od_lw_liq + od_lw_ice)
+          else
+            ! If longwave scattering is to be neglected then the
+            ! best approximation is to set the optical depth equal
+            ! to the absorption optical depth
+            od_lw_cloud(:,jlev,jcol) = od_lw_liq - scat_od_lw_liq &
+                 &                   + od_lw_ice - scat_od_lw_ice
+          end if
+          od_sw_cloud(:,jlev,jcol) = od_sw_liq + od_sw_ice
+          g_sw_cloud(:,jlev,jcol) = (g_sw_liq * scat_od_sw_liq &
+               &  + g_sw_ice * scat_od_sw_ice) &
+               &  / (scat_od_sw_liq + scat_od_sw_ice)
+          ssa_sw_cloud(:,jlev,jcol) &
+               &  = (scat_od_sw_liq + scat_od_sw_ice) / (od_sw_liq + od_sw_ice)
+        end if ! Cloud present
+      end do ! Loop over column
+    end do ! Loop over level
+
+    if (lhook) call dr_hook('radiation_cloud_optics:cloud_optics',1,hook_handle)
+
+  end subroutine cloud_optics
+
+end module radiation_cloud_optics
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloud_optics_data.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloud_optics_data.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloud_optics_data.F90	(revision 3908)
@@ -0,0 +1,108 @@
+! radiation_cloud_optics_data.F90 - Type to store cloud optical properties
+!
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+
+module radiation_cloud_optics_data
+
+  use parkind1, only : jprb
+
+  implicit none
+  public
+
+  !---------------------------------------------------------------------
+  ! This type holds the configuration information to compute
+  ! cloud optical properties
+  type cloud_optics_type
+     ! Band-specific coefficients are provided separately in the
+     ! shortwave and longwave, and are dimensioned (nband,ncoeff),
+     ! where ncoeff depends on the nature of the parameterization
+     real(jprb), allocatable, dimension(:,:) :: &
+          &  liq_coeff_lw, liq_coeff_sw, &
+          &  ice_coeff_lw, ice_coeff_sw
+     ! General coefficients are vectors of length ncoeffgen, which
+     ! depends on the nature of the parameterization; note that most
+     ! parameterizations use only band-specific coefficients
+     real(jprb), allocatable, dimension(:) :: &
+          &  liq_coeff_gen, ice_coeff_gen
+
+   contains
+     procedure :: setup => setup_cloud_optics
+
+  end type cloud_optics_type
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Setup cloud optics coefficients by reading them from a file
+  subroutine setup_cloud_optics(this, liq_file_name, ice_file_name, &
+       &                        iverbose)
+
+    use yomhook,  only : lhook, dr_hook
+    use easy_netcdf, only : netcdf_file
+
+    class(cloud_optics_type), intent(inout) :: this
+    character(len=*), intent(in)            :: liq_file_name, ice_file_name
+    integer, intent(in), optional           :: iverbose
+
+    ! The NetCDF file containing the coefficients
+    type(netcdf_file)  :: file
+    integer            :: iverb
+    real(jprb)         :: hook_handle
+
+    if (lhook) call dr_hook('radiation_cloud_optics_data:setup',0,hook_handle)
+
+    if (present(iverbose)) then
+      iverb = iverbose
+    else
+      iverb = 2
+    end if
+
+    ! Open the droplet scattering file and configure the way it is
+    ! read
+    call file%open(trim(liq_file_name), iverbose=iverb)
+    call file%transpose_matrices()
+
+    ! Read the band-specific coefficients
+    call file%get('coeff_lw',this%liq_coeff_lw)
+    call file%get('coeff_sw',this%liq_coeff_sw)
+
+    ! Read the general  coefficients
+    if (file%exists('coeff_gen')) then
+      call file%get('coeff_gen',this%liq_coeff_gen)
+    end if
+
+    ! Close droplet scattering file
+    call file%close()
+
+    ! Open the ice scattering file and configure the way it is read
+    call file%open(trim(ice_file_name), iverbose=iverb)
+    call file%transpose_matrices()
+
+    ! Read the band-specific  coefficients
+    call file%get('coeff_lw',this%ice_coeff_lw)
+    call file%get('coeff_sw',this%ice_coeff_sw)
+
+    ! Read the general  coefficients
+    if (file%exists('coeff_gen')) then
+      call file%get('coeff_gen',this%ice_coeff_gen)
+    end if
+
+    ! Close ice scattering file
+    call file%close()
+
+    if (lhook) call dr_hook('radiation_cloud_optics_data:setup',1,hook_handle)
+
+  end subroutine setup_cloud_optics
+
+end module radiation_cloud_optics_data
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloudless_lw.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloudless_lw.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloudless_lw.F90	(revision 3908)
@@ -0,0 +1,179 @@
+! radiation_cloudless_lw.F90 - Longwave homogeneous cloudless solver
+!
+! (C) Copyright 2019- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+
+module radiation_cloudless_lw
+
+public :: solver_cloudless_lw
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Longwave homogeneous solver containing no clouds
+  subroutine solver_cloudless_lw(nlev,istartcol,iendcol, &
+       &  config, od, ssa, g, planck_hl, emission, albedo, flux)
+
+    use parkind1, only           : jprb
+    use yomhook,  only           : lhook, dr_hook
+
+    use radiation_config, only         : config_type
+    use radiation_flux, only           : flux_type, indexed_sum_profile
+    use radiation_two_stream, only     : calc_two_stream_gammas_lw, &
+         &                               calc_reflectance_transmittance_lw, &
+         &                               calc_no_scattering_transmittance_lw
+    use radiation_adding_ica_lw, only  : adding_ica_lw, calc_fluxes_no_scattering_lw
+    use radiation_lw_derivatives, only : calc_lw_derivatives_ica
+
+    implicit none
+
+    ! Inputs
+    integer, intent(in) :: nlev               ! number of model levels
+    integer, intent(in) :: istartcol, iendcol ! range of columns to process
+    type(config_type),        intent(in) :: config
+
+    ! Gas and aerosol optical depth, single-scattering albedo and
+    ! asymmetry factor at each longwave g-point
+    real(jprb), intent(in), dimension(config%n_g_lw, nlev, istartcol:iendcol) :: &
+         &  od
+    real(jprb), intent(in), dimension(config%n_g_lw_if_scattering, nlev, istartcol:iendcol) :: &
+         &  ssa, g
+
+    ! Planck function at each half-level and the surface
+    real(jprb), intent(in), dimension(config%n_g_lw,nlev+1,istartcol:iendcol) :: &
+         &  planck_hl
+  
+    ! Emission (Planck*emissivity) and albedo (1-emissivity) at the
+    ! surface at each longwave g-point
+    real(jprb), intent(in), dimension(config%n_g_lw, istartcol:iendcol) &
+         &  :: emission, albedo
+
+    ! Output
+    type(flux_type), intent(inout):: flux
+
+    ! Local variables
+
+    ! Diffuse reflectance and transmittance for each layer in clear
+    ! and all skies
+    real(jprb), dimension(config%n_g_lw, nlev) :: reflectance, transmittance
+
+    ! Emission by a layer into the upwelling or downwelling diffuse
+    ! streams, in clear and all skies
+    real(jprb), dimension(config%n_g_lw, nlev) :: source_up, source_dn
+
+    ! Fluxes per g point
+    real(jprb), dimension(config%n_g_lw, nlev+1) :: flux_up, flux_dn
+
+    ! Combined optical depth, single scattering albedo and asymmetry
+    ! factor
+    real(jprb), dimension(config%n_g_lw) :: ssa_total, g_total
+
+    ! Two-stream coefficients
+    real(jprb), dimension(config%n_g_lw) :: gamma1, gamma2
+
+    ! Number of g points
+    integer :: ng
+
+    ! Loop indices for level and column
+    integer :: jlev, jcol
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_cloudless_lw:solver_cloudless_lw',0,hook_handle)
+
+    ng = config%n_g_lw
+
+    ! Loop through columns
+    do jcol = istartcol,iendcol
+
+      ! Compute the reflectance and transmittance of all layers,
+      ! neglecting clouds
+      do jlev = 1,nlev
+        if (config%do_lw_aerosol_scattering) then
+          ! Scattering case: first compute clear-sky reflectance,
+          ! transmittance etc at each model level
+          ssa_total = ssa(:,jlev,jcol)
+          g_total   = g(:,jlev,jcol)
+          call calc_two_stream_gammas_lw(ng, ssa_total, g_total, &
+               &  gamma1, gamma2)
+          call calc_reflectance_transmittance_lw(ng, &
+               &  od(:,jlev,jcol), gamma1, gamma2, &
+               &  planck_hl(:,jlev,jcol), planck_hl(:,jlev+1,jcol), &
+               &  reflectance(:,jlev), transmittance(:,jlev), &
+               &  source_up(:,jlev), source_dn(:,jlev))
+        else
+          ! Non-scattering case: use simpler functions for
+          ! transmission and emission
+          call calc_no_scattering_transmittance_lw(ng, od(:,jlev,jcol), &
+               &  planck_hl(:,jlev,jcol), planck_hl(:,jlev+1, jcol), &
+               &  transmittance(:,jlev), source_up(:,jlev), source_dn(:,jlev))          
+          ! Ensure that clear-sky reflectance is zero
+          reflectance(:,jlev) = 0.0_jprb
+        end if
+      end do
+
+      if (config%do_lw_aerosol_scattering) then
+        ! Then use adding method to compute fluxes
+        call adding_ica_lw(ng, nlev, &
+             &  reflectance, transmittance, source_up, source_dn, &
+             &  emission(:,jcol), albedo(:,jcol), &
+             &  flux_up, flux_dn)
+      else
+        ! Simpler down-then-up method to compute fluxes
+        call calc_fluxes_no_scattering_lw(ng, nlev, &
+             &  transmittance, source_up, source_dn, &
+             &  emission(:,jcol), albedo(:,jcol), &
+             &  flux_up, flux_dn)
+          
+      end if
+
+      ! Sum over g-points to compute broadband fluxes
+      flux%lw_up(jcol,:) = sum(flux_up,1)
+      flux%lw_dn(jcol,:) = sum(flux_dn,1)
+      ! Store surface spectral downwelling fluxes
+      flux%lw_dn_surf_g(:,jcol) = flux_dn(:,nlev+1)
+
+      ! Save the spectral fluxes if required
+      if (config%do_save_spectral_flux) then
+        call indexed_sum_profile(flux_up, config%i_spec_from_reordered_g_lw, &
+             &                   flux%lw_up_band(:,jcol,:))
+        call indexed_sum_profile(flux_dn, config%i_spec_from_reordered_g_lw, &
+             &                   flux%lw_dn_band(:,jcol,:))
+      end if
+
+      if (config%do_clear) then
+        ! Clear-sky calculations are equal to all-sky for this solver:
+        ! copy fluxes over
+        flux%lw_up_clear(jcol,:) = flux%lw_up(jcol,:)
+        flux%lw_dn_clear(jcol,:) = flux%lw_dn(jcol,:)
+        flux%lw_dn_surf_clear_g(:,jcol) = flux%lw_dn_surf_g(:,jcol)
+        if (config%do_save_spectral_flux) then
+          flux%lw_up_clear_band(:,jcol,:) = flux%lw_up_band(:,jcol,:)
+          flux%lw_dn_clear_band(:,jcol,:) = flux%lw_dn_band(:,jcol,:)
+        end if
+      end if
+
+      ! Compute the longwave derivatives needed by Hogan and Bozzo
+      ! (2015) approximate radiation update scheme
+      if (config%do_lw_derivatives) then
+        call calc_lw_derivatives_ica(ng, nlev, jcol, transmittance, flux_up(:,nlev+1), &
+             &                       flux%lw_derivatives)
+       end if
+
+    end do
+
+    if (lhook) call dr_hook('radiation_cloudless_lw:solver_cloudless_lw',1,hook_handle)
+    
+  end subroutine solver_cloudless_lw
+
+end module radiation_cloudless_lw
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloudless_sw.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloudless_sw.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloudless_sw.F90	(revision 3908)
@@ -0,0 +1,245 @@
+! radiation_cloudless_sw.F90 - Shortwave homogeneous cloudless solver
+!
+! (C) Copyright 2019- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+
+module radiation_cloudless_sw
+
+public :: solver_cloudless_sw
+
+contains
+
+  ! Provides elemental function "delta_eddington"
+#include "radiation_delta_eddington.h"
+
+  !---------------------------------------------------------------------
+  ! Shortwave homogeneous solver containing no clouds
+  subroutine solver_cloudless_sw(nlev,istartcol,iendcol, &
+       &  config, single_level, & 
+       &  od, ssa, g, albedo_direct, albedo_diffuse, incoming_sw, &
+       &  flux)
+
+    use parkind1, only           : jprb
+    use yomhook,  only           : lhook, dr_hook
+
+    use radiation_config, only         : config_type
+    use radiation_single_level, only   : single_level_type
+    use radiation_flux, only           : flux_type, indexed_sum_profile, &
+         &                               add_indexed_sum_profile
+    use radiation_two_stream, only     : calc_two_stream_gammas_sw, &
+         &                       calc_reflectance_transmittance_sw
+    use radiation_constants, only      : Pi, GasConstantDryAir, &
+         &                               AccelDueToGravity
+    use radiation_adding_ica_sw, only  : adding_ica_sw
+
+    implicit none
+
+    ! Inputs
+    integer, intent(in) :: nlev               ! number of model levels
+    integer, intent(in) :: istartcol, iendcol ! range of columns to process
+    type(config_type),        intent(in) :: config
+    type(single_level_type),  intent(in) :: single_level
+
+    ! Gas and aerosol optical depth, single-scattering albedo and
+    ! asymmetry factor at each shortwave g-point
+    real(jprb), intent(in), dimension(config%n_g_sw, nlev, istartcol:iendcol) :: &
+         &  od, ssa, g
+
+    ! Direct and diffuse surface albedos, and the incoming shortwave
+    ! flux into a plane perpendicular to the incoming radiation at
+    ! top-of-atmosphere in each of the shortwave g points
+    real(jprb), intent(in), dimension(config%n_g_sw,istartcol:iendcol) :: &
+         &  albedo_direct, albedo_diffuse, incoming_sw
+
+    ! Output
+    type(flux_type), intent(inout):: flux
+
+    ! Local variables
+
+    ! Cosine of solar zenith angle
+    real(jprb)                                 :: cos_sza
+
+    ! Diffuse reflectance and transmittance for each layer
+    real(jprb), dimension(config%n_g_sw, nlev) :: reflectance, transmittance
+
+    ! Fraction of direct beam scattered by a layer into the upwelling
+    ! or downwelling diffuse streams
+    real(jprb), dimension(config%n_g_sw, nlev) :: ref_dir, trans_dir_diff
+
+    ! Transmittance for the direct beam in clear and all skies
+    real(jprb), dimension(config%n_g_sw, nlev) :: trans_dir_dir
+
+    ! Fluxes per g point
+    real(jprb), dimension(config%n_g_sw, nlev+1) :: flux_up, flux_dn_diffuse, flux_dn_direct
+
+    ! Combined optical depth, single scattering albedo and asymmetry
+    ! factor
+    real(jprb), dimension(config%n_g_sw) :: od_total, ssa_total, g_total
+
+    ! Two-stream coefficients
+    real(jprb), dimension(config%n_g_sw) :: gamma1, gamma2, gamma3
+
+    ! Number of g points
+    integer :: ng
+
+    ! Loop indices for level and column
+    integer :: jlev, jcol
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_cloudless_sw:solver_cloudless_sw',0,hook_handle)
+
+    ng = config%n_g_sw
+
+    ! Loop through columns
+    do jcol = istartcol,iendcol
+      ! Only perform calculation if sun above the horizon
+      if (single_level%cos_sza(jcol) > 0.0_jprb) then
+
+        cos_sza = single_level%cos_sza(jcol)
+        
+        ! The following is the same as the clear-sky part of
+        ! solver_homogeneous_sw
+        if (.not. config%do_sw_delta_scaling_with_gases) then
+          ! Delta-Eddington scaling has already been performed to the
+          ! aerosol part of od, ssa and g
+          do jlev = 1,nlev
+            call calc_two_stream_gammas_sw(ng, cos_sza, &
+                 &  ssa(:,jlev,jcol), g(:,jlev,jcol), &
+                 &  gamma1, gamma2, gamma3)
+            call calc_reflectance_transmittance_sw(ng, &
+                 &  cos_sza, &
+                 &  od(:,jlev,jcol), ssa(:,jlev,jcol), &
+                 &  gamma1, gamma2, gamma3, &
+                 &  reflectance(:,jlev), transmittance(:,jlev), &
+                 &  ref_dir(:,jlev), trans_dir_diff(:,jlev), &
+                 &  trans_dir_dir(:,jlev) )
+          end do
+        else
+          ! Apply delta-Eddington scaling to the aerosol-gas mixture
+          do jlev = 1,nlev
+            od_total  =  od(:,jlev,jcol)
+            ssa_total = ssa(:,jlev,jcol)
+            g_total   =   g(:,jlev,jcol)
+            call delta_eddington(od_total, ssa_total, g_total)
+            call calc_two_stream_gammas_sw(ng, &
+                 &  cos_sza, ssa_total, g_total, &
+                 &  gamma1, gamma2, gamma3)
+            call calc_reflectance_transmittance_sw(ng, &
+                 &  cos_sza, od_total, ssa_total, &
+                 &  gamma1, gamma2, gamma3, &
+                 &  reflectance(:,jlev), transmittance(:,jlev), &
+                 &  ref_dir(:,jlev), trans_dir_diff(:,jlev), &
+                 &  trans_dir_dir(:,jlev) )
+          end do
+        end if
+          
+        ! Use adding method to compute fluxes
+        call adding_ica_sw(ng, nlev, incoming_sw(:,jcol), &
+             &  albedo_diffuse(:,jcol), albedo_direct(:,jcol), &
+             &  spread(cos_sza,1,ng), reflectance, transmittance, ref_dir, trans_dir_diff, &
+             &  trans_dir_dir, flux_up, flux_dn_diffuse, flux_dn_direct)
+        
+        ! Sum over g-points to compute and save clear-sky broadband
+        ! fluxes
+        flux%sw_up(jcol,:) = sum(flux_up,1)
+        if (allocated(flux%sw_dn_direct)) then
+          flux%sw_dn_direct(jcol,:) = sum(flux_dn_direct,1)
+          flux%sw_dn(jcol,:) = sum(flux_dn_diffuse,1) &
+               &  + flux%sw_dn_direct(jcol,:)
+        else
+          flux%sw_dn(jcol,:) = sum(flux_dn_diffuse,1) + sum(flux_dn_direct,1)
+        end if
+        ! Store spectral downwelling fluxes at surface
+        flux%sw_dn_diffuse_surf_g(:,jcol) = flux_dn_diffuse(:,nlev+1)
+        flux%sw_dn_direct_surf_g(:,jcol)  = flux_dn_direct(:,nlev+1)
+
+        ! Save the spectral fluxes if required
+        if (config%do_save_spectral_flux) then
+          call indexed_sum_profile(flux_up, config%i_spec_from_reordered_g_sw, &
+               &                   flux%sw_up_band(:,jcol,:))
+          call indexed_sum_profile(flux_dn_direct, config%i_spec_from_reordered_g_sw, &
+               &                   flux%sw_dn_band(:,jcol,:))
+          if (allocated(flux%sw_dn_direct_band)) then
+            flux%sw_dn_direct_band(:,jcol,:) &
+                 &  = flux%sw_dn_band(:,jcol,:)
+          end if
+          call add_indexed_sum_profile(flux_dn_diffuse, &
+               &                       config%i_spec_from_reordered_g_sw, &
+               &                       flux%sw_dn_band(:,jcol,:))
+        end if
+
+        if (config%do_clear) then
+          ! Clear-sky calculations are equal to all-sky for this
+          ! solver: copy fluxes over
+          flux%sw_up_clear(jcol,:) = flux%sw_up(jcol,:)
+          flux%sw_dn_clear(jcol,:) = flux%sw_dn(jcol,:)
+          if (allocated(flux%sw_dn_direct_clear)) then
+            flux%sw_dn_direct_clear(jcol,:) = flux%sw_dn_direct(jcol,:)
+          end if
+          flux%sw_dn_diffuse_surf_clear_g(:,jcol) = flux%sw_dn_diffuse_surf_g(:,jcol)
+          flux%sw_dn_direct_surf_clear_g(:,jcol)  = flux%sw_dn_direct_surf_g(:,jcol)
+
+          if (config%do_save_spectral_flux) then
+            flux%sw_up_clear_band(:,jcol,:) = flux%sw_up_band(:,jcol,:)
+            flux%sw_dn_clear_band(:,jcol,:) = flux%sw_dn_band(:,jcol,:)
+            if (allocated(flux%sw_dn_direct_clear_band)) then
+              flux%sw_dn_direct_clear_band(:,jcol,:) = flux%sw_dn_direct_band(:,jcol,:)
+            end if
+          end if
+
+        end if ! do_clear
+
+      else
+        ! Set fluxes to zero if sun is below the horizon
+        flux%sw_up(jcol,:) = 0.0_jprb
+        flux%sw_dn(jcol,:) = 0.0_jprb
+        if (allocated(flux%sw_dn_direct)) then
+          flux%sw_dn_direct(jcol,:) = 0.0_jprb
+        end if
+        flux%sw_dn_diffuse_surf_g(:,jcol) = 0.0_jprb
+        flux%sw_dn_direct_surf_g(:,jcol)  = 0.0_jprb
+
+        if (config%do_clear) then
+          flux%sw_up_clear(jcol,:) = 0.0_jprb
+          flux%sw_dn_clear(jcol,:) = 0.0_jprb
+          if (allocated(flux%sw_dn_direct_clear)) then
+            flux%sw_dn_direct_clear(jcol,:) = 0.0_jprb
+          end if
+          flux%sw_dn_diffuse_surf_clear_g(:,jcol) = 0.0_jprb
+          flux%sw_dn_direct_surf_clear_g(:,jcol)  = 0.0_jprb
+        end if
+
+        if (config%do_save_spectral_flux) then
+          flux%sw_dn_band(:,jcol,:) = 0.0_jprb
+          flux%sw_up_band(:,jcol,:) = 0.0_jprb
+          if (allocated(flux%sw_dn_direct_band)) then
+            flux%sw_dn_direct_band(:,jcol,:) = 0.0_jprb
+          end if
+          if (config%do_clear) then
+            flux%sw_dn_clear_band(:,jcol,:) = 0.0_jprb
+            flux%sw_up_clear_band(:,jcol,:) = 0.0_jprb
+            if (allocated(flux%sw_dn_direct_clear_band)) then
+              flux%sw_dn_direct_clear_band(:,jcol,:) = 0.0_jprb
+            end if
+          end if
+        end if
+
+      end if ! sun above horizon
+    end do
+
+    if (lhook) call dr_hook('radiation_cloudless_sw:solver_cloudless_sw',1,hook_handle)
+
+  end subroutine solver_cloudless_sw
+
+end module radiation_cloudless_sw
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_config.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_config.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_config.F90	(revision 3908)
@@ -0,0 +1,1980 @@
+! radiation_config.F90 - Derived type to configure the radiation scheme
+!
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2017-07-22  R. Hogan  Added Yi et al. ice optics model
+!   2017-10-23  R. Hogan  Renamed single-character variables
+!   2018-03-15  R. Hogan  Added logicals controlling surface spectral treatment
+!   2018-08-29  R. Hogan  Added monochromatic single-scattering albedo / asymmetry factor
+!   2018-09-03  R. Hogan  Added min_cloud_effective_size
+!   2018-09-04  R. Hogan  Added encroachment_scaling
+!   2018-09-13  R. Hogan  Added IEncroachmentFractal
+!   2019-01-02  R. Hogan  Added Cloudless solvers
+!   2019-01-14  R. Hogan  Added out_of_bounds_[1,2,3]d for checker routines
+!   2019-01-18  R. Hogan  Added albedo weighting
+!   2019-02-03  R. Hogan  Added ability to fix out-of-physical-bounds inputs
+!   2019-02-10  R. Hogan  Renamed "encroachment" to "entrapment"
+!
+! Note: The aim is for ecRad in the IFS to be as similar as possible
+! to the offline version, so if you make any changes to this or any
+! files in this directory, please inform Robin Hogan.
+!
+
+module radiation_config
+
+  use parkind1,                      only : jprb
+
+  use radiation_cloud_optics_data,   only : cloud_optics_type
+  use radiation_aerosol_optics_data, only : aerosol_optics_type
+  use radiation_pdf_sampler,         only : pdf_sampler_type
+  use radiation_cloud_cover,         only : OverlapName, &
+       & IOverlapMaximumRandom, IOverlapExponentialRandom, IOverlapExponential
+
+  implicit none
+  public
+
+  ! Configuration codes: use C-style enumerators to avoid having to
+  ! remember the numbers
+
+  ! Solvers: can be specified for longwave and shortwave
+  ! independently, except for "Homogeneous", which must be the same
+  ! for both
+  enum, bind(c) 
+     enumerator ISolverCloudless, ISolverHomogeneous, ISolverMcICA, &
+          &     ISolverSpartacus, ISolverTripleclouds 
+  end enum
+  character(len=*), parameter :: SolverName(0:4) = (/ 'Cloudless   ', &
+       &                                              'Homogeneous ', &
+       &                                              'McICA       ', &
+       &                                              'SPARTACUS   ', &
+       &                                              'Tripleclouds' /)
+
+  ! SPARTACUS shortwave solver can treat the reflection of radiation
+  ! back up into different regions in various ways
+  enum, bind(c) 
+     enumerator &
+       & IEntrapmentZero, &     ! No entrapment, as Tripleclouds
+       & IEntrapmentEdgeOnly, & ! Only radiation passed through cloud edge is horizontally homogenized
+       & IEntrapmentExplicit, & ! Estimate horiz migration dist, account for fractal clouds
+       & IEntrapmentExplicitNonFractal, & ! As above but ignore fractal nature of clouds
+       & IEntrapmentMaximum ! Complete horizontal homogenization within regions (old SPARTACUS assumption)
+
+  end enum
+  
+  ! Names available in the radiation namelist for variable
+  ! sw_entrapment_name
+  character(len=*), parameter :: EntrapmentName(0:4)   = [ 'Zero       ', &
+       &                                                   'Edge-only  ', &
+       &                                                   'Explicit   ', &
+       &                                                   'Non-fractal', &
+       &                                                   'Maximum    ' ]
+  ! For backwards compatibility, the radiation namelist also supports
+  ! the equivalent variable sw_encroachment_name with the following
+  ! names
+  character(len=*), parameter :: EncroachmentName(0:4) = [ 'Zero    ', &
+       &                                                   'Minimum ', &
+       &                                                   'Fractal ', &
+       &                                                   'Computed', &
+       &                                                   'Maximum ' ]
+
+  ! Two-stream models
+  ! This is not configurable at run-time
+
+  ! Gas models
+  enum, bind(c) 
+     enumerator IGasModelMonochromatic, IGasModelIFSRRTMG
+  end enum
+  character(len=*), parameter :: GasModelName(0:1) = (/ 'Monochromatic', &
+       &                                                'RRTMG-IFS    ' /)
+
+  ! Hydrometeor scattering models
+  enum, bind(c) 
+     enumerator ILiquidModelMonochromatic, &
+          &     ILiquidModelSOCRATES, ILiquidModelSlingo
+  end enum
+  character(len=*), parameter :: LiquidModelName(0:2) = (/ 'Monochromatic', &
+       &                                                   'SOCRATES     ', &
+       &                                                   'Slingo       ' /)
+
+  enum, bind(c) 
+     enumerator IIceModelMonochromatic, IIceModelFu, &
+          &  IIceModelBaran, IIceModelBaran2016, IIceModelBaran2017,   &
+          &  IIceModelYi
+  end enum
+  character(len=*), parameter :: IceModelName(0:5) = (/ 'Monochromatic', &
+       &                                                'Fu-IFS       ', &
+       &                                                'Baran        ', &
+       &                                                'Baran2016    ', &
+       &                                                'Baran2017    ', &
+       &                                                'Yi           ' /)
+
+  ! Cloud PDF distribution shapes
+  enum, bind(c)
+    enumerator IPdfShapeLognormal, IPdfShapeGamma
+  end enum
+  character(len=*), parameter :: PdfShapeName(0:1) = (/ 'Lognormal', &
+       &                                                'Gamma    ' /)
+
+  ! Maximum number of different aerosol types that can be provided
+  integer, parameter :: NMaxAerosolTypes = 256
+
+  ! Maximum number of shortwave albedo and longwave emissivity
+  ! intervals
+  integer, parameter :: NMaxAlbedoIntervals = 256
+
+  ! Length of string buffer for printing config information
+  integer, parameter :: NPrintStringLen = 60
+
+  !---------------------------------------------------------------------
+  ! Derived type containing all the configuration information needed
+  ! to run the radiation scheme.  The intention is that this is fixed
+  ! for a given model run.  The parameters are to list first those
+  ! quantities that can be set directly by the user, for example using a
+  ! namelist, and second those quantities that are computed afterwards
+  ! from the user-supplied numbers, especially the details of the gas
+  ! optics model.
+  type config_type
+    ! USER-CONFIGURABLE PARAMETERS
+
+    ! Override default solar spectrum
+    logical :: use_spectral_solar_scaling = .false.
+
+    ! Directory in which gas, cloud and aerosol data files are to be
+    ! found
+    character(len=511) :: directory_name = '.'
+
+    ! Cloud is deemed to be present in a layer if cloud fraction
+    ! exceeds this value
+    real(jprb) :: cloud_fraction_threshold = 1.0e-6_jprb
+    ! ...and total cloud water mixing ratio exceeds this value
+    real(jprb) :: cloud_mixing_ratio_threshold = 1.0e-9_jprb
+
+    ! Overlap scheme
+    integer :: i_overlap_scheme = IOverlapExponentialRandom
+
+    ! Use the Shonk et al. (2010) "beta" overlap parameter, rather
+    ! than the "alpha" overlap parameter of Hogan and Illingworth
+    ! (2000)?
+    logical :: use_beta_overlap = .false.
+
+    ! Shape of sub-grid cloud water PDF
+    integer :: i_cloud_pdf_shape = IPdfShapeGamma
+
+    ! The ratio of the overlap decorrelation length for cloud
+    ! inhomogeneities to the overlap decorrelation length for cloud
+    ! boundaries.  Observations suggest this has a value of 0.5
+    ! (e.g. from the decorrelation lengths of Hogan and Illingworth
+    ! 2003 and Hogan and Illingworth 2000).
+    real(jprb) :: cloud_inhom_decorr_scaling = 0.5_jprb
+
+    ! Factor controlling how much of the cloud edge length interfaces
+    ! directly between the clear-sky region (region a) and the
+    ! optically thick cloudy region (region c).  If Lxy is the length
+    ! of the interfaces between regions x and y, and Lab and Lbc have
+    ! been computed already, then
+    !   Lac=clear_to_thick_fraction*min(Lab,Lbc).
+    real(jprb) :: clear_to_thick_fraction = 0.0_jprb
+
+    ! Factor allowing lateral transport when the sun is close to
+    ! overhead; consider atand(overhead_sun_factor) to be the number
+    ! of degrees that the sun angle is perturbed from zenith for the
+    ! purposes of computing lateral transport.  A value of up to 0.1
+    ! seems to be necessary to account for the fact that some forward
+    ! scattered radiation is treated as unscattered by delta-Eddington
+    ! scaling; therefore it ought to have the chance to escape.
+    real(jprb) :: overhead_sun_factor = 0.0_jprb
+
+    ! Minimum gas optical depth in a single layer at any wavelength,
+    ! for stability
+    real(jprb) :: min_gas_od_lw = 1.0e-15_jprb
+    real(jprb) :: min_gas_od_sw = 0.0_jprb
+
+    ! Maximum gas optical depth in a layer before that g-point will
+    ! not be considered for 3D treatment: a limit is required to avoid
+    ! expensive computation of matrix exponentials on matrices with
+    ! large elements
+    real(jprb) :: max_gas_od_3d = 8.0_jprb
+
+    ! Maximum total optical depth of a cloudy region for stability:
+    ! optical depth will be capped at this value in the SPARTACUS
+    ! solvers
+    real(jprb) :: max_cloud_od = 16.0_jprb
+
+    ! How much longwave scattering is included?
+    logical :: do_lw_cloud_scattering = .true.
+    logical :: do_lw_aerosol_scattering = .true.
+
+    ! Number of regions used to describe clouds and clear skies. A
+    ! value of 2 means one clear and one cloudy region, so clouds are
+    ! horizontally homogeneous, while a value of 3 means two cloudy
+    ! regions with different optical depth, thereby representing
+    ! inhomogeneity via the Shonk & Hogan (2008) "Tripleclouds"
+    ! method.
+    integer :: nregions = 3
+
+    ! Code specifying the solver to be used: use the enumerations
+    ! defined above
+    integer :: i_solver_sw = ISolverMcICA
+    integer :: i_solver_lw = ISolverMcICA
+
+    ! Do shortwave delta-Eddington scaling on the cloud-aerosol-gas
+    ! mixture (as in the original IFS scheme), rather than the more
+    ! correct approach of separately scaling the cloud and aerosol
+    ! scattering properties before merging with gases.  Note that
+    ! .true. is not compatible with the SPARTACUS solver.
+    logical :: do_sw_delta_scaling_with_gases = .false.
+
+    ! Codes describing the gas and cloud scattering models to use, the
+    ! latter of which is currently not used
+    integer :: i_gas_model = IGasModelIFSRRTMG
+    !     integer :: i_cloud_model
+
+    ! Optics if i_gas_model==IGasModelMonochromatic.
+    ! The wavelength to use for the Planck function in metres. If this
+    ! is positive then the output longwave fluxes will be in units of
+    ! W m-2 um-1.  If this is zero or negative (the default) then
+    ! sigma*T^4 will be used and the output longwave fluxes will be in
+    ! W m-2.
+    real(jprb) :: mono_lw_wavelength = -1.0_jprb
+    ! Total zenith optical depth of the atmosphere in the longwave and
+    ! shortwave, distributed vertically according to the pressure.
+    ! Default is zero.
+    real(jprb) :: mono_lw_total_od = 0.0_jprb
+    real(jprb) :: mono_sw_total_od = 0.0_jprb
+    ! Single-scattering albedo and asymmetry factor: values typical
+    ! for liquid clouds with effective radius of 10 microns, at (SW)
+    ! 0.55 micron wavelength and (LW) 10.7 microns wavelength
+    real(jprb) :: mono_sw_single_scattering_albedo = 0.999999_jprb
+    real(jprb) :: mono_sw_asymmetry_factor = 0.86_jprb
+    real(jprb) :: mono_lw_single_scattering_albedo = 0.538_jprb
+    real(jprb) :: mono_lw_asymmetry_factor = 0.925_jprb
+
+    ! Codes describing particle scattering models
+    integer :: i_liq_model = ILiquidModelSOCRATES
+    integer :: i_ice_model = IIceModelBaran
+    
+    ! The mapping from albedo/emissivity intervals to SW/LW bands can
+    ! either be done by finding the interval containing the central
+    ! wavenumber of the band (nearest neighbour), or by a weighting
+    ! according to the spectral overlap of each interval with each
+    ! band
+    logical :: do_nearest_spectral_sw_albedo = .true.
+    logical :: do_nearest_spectral_lw_emiss  = .true.
+
+    ! User-defined monotonically increasing wavelength bounds (m)
+    ! between input surface albedo/emissivity intervals. Implicitly
+    ! the first interval starts at zero and the last ends at infinity.
+    real(jprb) :: sw_albedo_wavelength_bound(NMaxAlbedoIntervals-1) = -1.0_jprb
+    real(jprb) :: lw_emiss_wavelength_bound( NMaxAlbedoIntervals-1)  = -1.0_jprb
+
+    ! The index to the surface albedo/emissivity intervals for each of
+    ! the wavelength bounds specified in sw_albedo_wavelength_bound
+    ! and lw_emiss_wavelength_bound
+    integer :: i_sw_albedo_index(NMaxAlbedoIntervals) = 0
+    integer :: i_lw_emiss_index (NMaxAlbedoIntervals)  = 0
+
+    ! Do we compute longwave and/or shortwave radiation?
+    logical :: do_lw = .true.
+    logical :: do_sw = .true.
+
+    ! Do we compute clear-sky fluxes and/or solar direct fluxes?
+    logical :: do_clear = .true.
+    logical :: do_sw_direct = .true.
+
+    ! Do we include 3D effects?
+    logical :: do_3d_effects = .true.
+    
+    ! To what extent do we include "entrapment" effects in the
+    ! SPARTACUS solver? This essentially means that in a situation
+    ! like this
+    !
+    ! 000111
+    ! 222222
+    !
+    ! Radiation downwelling from region 1 may be reflected back into
+    ! region 0 due to some degree of homogenization of the radiation
+    ! in region 2.  Hogan and Shonk (2013) referred to this as
+    ! "anomalous horizontal transport" for a 1D model, although for 3D
+    ! calculations it is desirable to include at least some of it. The
+    ! options are described by the IEntrapment* parameters above.
+    integer :: i_3d_sw_entrapment = IEntrapmentExplicit
+
+    ! In the longwave, the equivalent process it either "on" (like
+    ! maximum entrapment) or "off" (like zero entrapment):
+    logical :: do_3d_lw_multilayer_effects = .false.
+
+    ! Do we account for the effective emissivity of the side of
+    ! clouds?
+    logical :: do_lw_side_emissivity = .true.
+
+    ! The 3D transfer rate "X" is such that if transport out of a
+    ! region was the only process occurring then by the base of a
+    ! layer only exp(-X) of the original flux would remain in that
+    ! region. The transfer rate computed geometrically can be very
+    ! high for the clear-sky regions in layers with high cloud
+    ! fraction.  For stability reasons it is necessary to provide a
+    ! maximum possible 3D transfer rate.
+    real(jprb) :: max_3d_transfer_rate = 10.0_jprb
+
+    ! It has also sometimes been found necessary to set a minimum
+    ! cloud effective size for stability (metres)
+    real(jprb) :: min_cloud_effective_size = 100.0_jprb
+
+    ! Given a horizontal migration distance, there is still
+    ! uncertainty about how much entrapment occurs associated with how
+    ! one assumes cloud boundaries line up in adjacent layers. This
+    ! factor can be varied between 0.0 (the boundaries line up to the
+    ! greatest extent possible given the overlap parameter) and 1.0
+    ! (the boundaries line up to the minimum extent possible). In the
+    ! Hogan et al. entrapment paper it is referred to as the overhang
+    ! factor zeta, and a value of 0 matches the Monte Carlo
+    ! calculations best.
+    real(jprb) :: overhang_factor = 0.0_jprb
+
+    ! By default, the Meador & Weaver (1980) expressions are used
+    ! instead of the matrix exponential whenever 3D effects can be
+    ! neglected (e.g. cloud-free layers or clouds with infinitely
+    ! large effective cloud size), but setting the following to true
+    ! uses the matrix exponential everywhere, enabling the two
+    ! methods to be compared. Note that Meador & Weaver will still be
+    ! used for very optically thick g points where the matrix
+    ! exponential can produce incorrect results.
+    logical :: use_expm_everywhere = .false.
+
+    ! Aerosol descriptors: aerosol_type_mapping must be of length
+    ! n_aerosol_types, and contains 0 if that type is to be ignored,
+    ! positive numbers to map on to the indices of hydrophobic
+    ! aerosols in the aerosol optics configuration file, and negative
+    ! numbers to map on to (the negative of) the indices of
+    ! hydrophilic aerosols in the configuration file.
+    logical :: use_aerosols = .false.
+    integer :: n_aerosol_types = 0
+    integer :: i_aerosol_type_map(NMaxAerosolTypes)
+
+    ! Save the gas and cloud optical properties for each g point in
+    ! "radiative_properties.nc"?
+    logical :: do_save_radiative_properties = .false.
+
+    ! Save the flux profiles in each band?
+    logical :: do_save_spectral_flux = .false.
+
+    ! Save the surface downwelling shortwave fluxes in each band?
+    logical :: do_surface_sw_spectral_flux = .true.
+
+    ! Compute the longwave derivatives needed to apply the approximate
+    ! radiation updates of Hogan and Bozzo (2015)
+    logical :: do_lw_derivatives = .false.
+
+    ! Save the flux profiles in each g-point (overrides
+    ! do_save_spectral_flux if TRUE)?
+    logical :: do_save_gpoint_flux = .false.
+
+    ! In the IFS environment, setting up RRTM has already been done
+    ! so not needed to do it again
+    logical :: do_setup_ifsrrtm = .true.
+
+    ! In the IFS environment the old scheme has a bug in the Fu
+    ! longwave ice optics whereby the single scattering albedo is one
+    ! minus what it should be.  Unfortunately fixing it makes
+    ! forecasts worse. Setting the following to true reproduces the
+    ! bug.
+    logical :: do_fu_lw_ice_optics_bug = .false.
+
+    ! Control verbosity: 0=none (no output to standard output; write
+    ! to standard error only if an error occurs), 1=warning, 2=info,
+    ! 3=progress, 4=detailed, 5=debug.  Separate settings for the
+    ! setup of the scheme and the execution of it.
+    integer :: iverbosesetup = 2
+    integer :: iverbose = 1
+
+    ! Are we doing radiative transfer in complex surface canopies
+    ! (streets/vegetation), in which case tailored downward fluxes are
+    ! needed at the top of the canopy?
+    logical :: do_canopy_fluxes_sw = .false.
+    logical :: do_canopy_fluxes_lw = .false.
+    ! If so, do we use the full spectrum as in the atmosphere, or just
+    ! the reduced spectrum in which the shortwave albedo and longwave
+    ! emissivity are provided?
+    logical :: use_canopy_full_spectrum_sw = .false.
+    logical :: use_canopy_full_spectrum_lw = .false.
+    ! Do we treat gas radiative transfer in streets/vegetation?
+    logical :: do_canopy_gases_sw = .false.
+    logical :: do_canopy_gases_lw = .false.
+
+    ! Optics file names for overriding the ones generated from the
+    ! other options. If these remain empty then the generated names
+    ! will be used (see the "consolidate_config" routine below). If
+    ! the user assigns one of these and it starts with a '/' character
+    ! then that will be used instead. If the user assigns one and it
+    ! doesn't start with a '/' character then it will be prepended by
+    ! the contents of directory_name.
+    character(len=511) :: ice_optics_override_file_name = ''
+    character(len=511) :: liq_optics_override_file_name = ''
+    character(len=511) :: aerosol_optics_override_file_name = ''
+
+    ! Optionally override the look-up table file for the cloud-water
+    ! PDF used by the McICA solver
+    character(len=511) :: cloud_pdf_override_file_name = ''
+
+    ! Has "consolidate" been called?  
+    logical :: is_consolidated = .false.
+
+    ! COMPUTED PARAMETERS
+    ! Users of this library should not edit these parameters directly;
+    ! they are set by the "consolidate" routine
+
+    ! Wavenumber range for each band, in cm-1, which will be allocated
+    ! to be of length n_bands_sw or n_bands_lw
+    real(jprb), allocatable, dimension(:) :: wavenumber1_sw
+    real(jprb), allocatable, dimension(:) :: wavenumber2_sw
+    real(jprb), allocatable, dimension(:) :: wavenumber1_lw
+    real(jprb), allocatable, dimension(:) :: wavenumber2_lw
+
+    ! If the nearest surface albedo/emissivity interval is to be used
+    ! for each SW/LW band then the following arrays will be allocated
+    ! to the length of the number of bands and contain the index to
+    ! the relevant interval
+    integer, allocatable, dimension(:) :: i_albedo_from_band_sw
+    integer, allocatable, dimension(:) :: i_emiss_from_band_lw
+
+    ! ...alternatively, this matrix dimensioned
+    ! (n_albedo_intervals,n_bands_sw) providing the weights needed for
+    ! computing the albedo in each ecRad band from the albedo in each
+    ! native albedo band - see radiation_single_level.F90
+    real(jprb), allocatable, dimension(:,:) :: sw_albedo_weights
+    ! ...and similarly in the longwave, dimensioned
+    ! (n_emiss_intervals,n_bands_lw)
+    real(jprb), allocatable, dimension(:,:) :: lw_emiss_weights
+
+    ! Arrays of length the number of g-points that convert from
+    ! g-point to the band index
+    integer, allocatable, dimension(:) :: i_band_from_g_lw
+    integer, allocatable, dimension(:) :: i_band_from_g_sw
+
+    ! We allow for the possibility for g-points to be ordered in terms
+    ! of likely absorption (weakest to strongest) across the shortwave
+    ! or longwave spectrum, in order that in SPARTACUS we select only
+    ! the first n g-points that will not have too large an absorption,
+    ! and therefore matrix exponentials that are both finite and not
+    ! too expensive to compute.  The following two arrays map the
+    ! reordered g-points to the original ones.
+    integer, allocatable, dimension(:) :: i_g_from_reordered_g_lw
+    integer, allocatable, dimension(:) :: i_g_from_reordered_g_sw
+
+    ! The following map the reordered g-points to the bands
+    integer, allocatable, dimension(:) :: i_band_from_reordered_g_lw
+    integer, allocatable, dimension(:) :: i_band_from_reordered_g_sw
+
+    ! The following map the reordered g-points to the spectral
+    ! information being saved: if do_save_gpoint_flux==TRUE then this
+    ! will map on to the original g points, but if only
+    ! do_save_spectral_flux==TRUE then this will map on to the bands
+    integer, pointer, dimension(:) :: i_spec_from_reordered_g_lw
+    integer, pointer, dimension(:) :: i_spec_from_reordered_g_sw
+
+    ! Number of spectral intervals used for the canopy radiative
+    ! transfer calculation; they are either equal to
+    ! n_albedo_intervals/n_emiss_intervals or n_g_sw/n_g_lw
+    integer :: n_canopy_bands_sw = 1
+    integer :: n_canopy_bands_lw = 1
+
+    ! Data structure containing cloud scattering data
+    type(cloud_optics_type)      :: cloud_optics
+
+    ! Data structure containing aerosol scattering data
+    type(aerosol_optics_type)    :: aerosol_optics
+
+    ! Object for sampling from a gamma or lognormal distribution
+    type(pdf_sampler_type)       :: pdf_sampler
+
+    ! Optics file names
+    character(len=511) :: ice_optics_file_name, &
+         &                liq_optics_file_name, &
+         &                aerosol_optics_file_name
+    
+    ! McICA PDF look-up table file name
+    character(len=511) :: cloud_pdf_file_name
+
+    ! Number of gpoints and bands in the shortwave and longwave - set
+    ! to zero as will be set properly later
+    integer :: n_g_sw = 0, n_g_lw = 0
+    integer :: n_bands_sw = 0, n_bands_lw = 0
+
+    ! Number of spectral points to save (equal either to the number of
+    ! g points or the number of bands
+    integer :: n_spec_sw = 0, n_spec_lw = 0
+
+    ! Dimensions to store variables that are only needed if longwave
+    ! scattering is included. "n_g_lw_if_scattering" is equal to
+    ! "n_g_lw" if aerosols are allowed to scatter in the longwave,
+    ! and zero otherwise. "n_bands_lw_if_scattering" is equal to
+    ! "n_bands_lw" if clouds are allowed to scatter in the longwave,
+    ! and zero otherwise.
+    integer :: n_g_lw_if_scattering = 0, n_bands_lw_if_scattering = 0
+
+    ! Treat clouds as horizontally homogeneous within the gribox
+    logical :: is_homogeneous = .false.
+
+    ! If the solvers are both "Cloudless" then we don't need to do any
+    ! cloud processing
+    logical :: do_clouds = .true.
+
+   contains
+     procedure :: read => read_config_from_namelist
+     procedure :: consolidate => consolidate_config
+     procedure :: set  => set_config
+     procedure :: print => print_config
+     procedure :: get_sw_weights
+     procedure :: define_sw_albedo_intervals
+     procedure :: define_lw_emiss_intervals
+     procedure :: consolidate_intervals
+
+  end type config_type
+
+!  procedure, private :: print_logical, print_real, print_int
+
+contains
+
+
+  !---------------------------------------------------------------------
+  ! This subroutine reads configuration data from a namelist file, and
+  ! anything that is not in the namelists will be set to default
+  ! values. If optional output argument "is_success" is present, then
+  ! on error (e.g. missing file) it will be set to .false.; if this
+  ! argument is missing then on error the program will be aborted. You
+  ! may either specify the file_name or the unit of an open file to
+  ! read, but not both.
+  subroutine read_config_from_namelist(this, file_name, unit, is_success)
+
+    use yomhook,      only : lhook, dr_hook
+    use radiation_io, only : nulout, nulerr, nulrad, radiation_abort
+
+    class(config_type), intent(inout)         :: this
+    character(*),       intent(in),  optional :: file_name
+    integer,            intent(in),  optional :: unit
+    logical,            intent(out), optional :: is_success
+
+    integer :: iosopen, iosread ! Status after calling open and read
+
+    ! The following variables are read from the namelists and map
+    ! directly onto members of the config_type derived type
+
+    ! To be read from the radiation_config namelist 
+    logical :: do_sw, do_lw, do_clear, do_sw_direct
+    logical :: do_3d_effects, use_expm_everywhere, use_aerosols
+    logical :: do_lw_side_emissivity
+    logical :: do_3d_lw_multilayer_effects, do_fu_lw_ice_optics_bug
+    logical :: do_lw_aerosol_scattering, do_lw_cloud_scattering
+    logical :: do_save_radiative_properties, do_save_spectral_flux
+    logical :: do_save_gpoint_flux, do_surface_sw_spectral_flux
+    logical :: use_beta_overlap, do_lw_derivatives
+    logical :: do_sw_delta_scaling_with_gases
+    logical :: do_canopy_fluxes_sw, do_canopy_fluxes_lw
+    logical :: use_canopy_full_spectrum_sw, use_canopy_full_spectrum_lw
+    logical :: do_canopy_gases_sw, do_canopy_gases_lw
+    integer :: n_regions, iverbose, iverbosesetup, n_aerosol_types
+    real(jprb):: mono_lw_wavelength, mono_lw_total_od, mono_sw_total_od
+    real(jprb):: mono_lw_single_scattering_albedo, mono_sw_single_scattering_albedo
+    real(jprb):: mono_lw_asymmetry_factor, mono_sw_asymmetry_factor
+    real(jprb):: cloud_inhom_decorr_scaling, cloud_fraction_threshold
+    real(jprb):: clear_to_thick_fraction, max_gas_od_3d, max_cloud_od
+    real(jprb):: cloud_mixing_ratio_threshold, overhead_sun_factor
+    real(jprb):: max_3d_transfer_rate, min_cloud_effective_size
+    real(jprb):: overhang_factor, encroachment_scaling
+    character(511) :: directory_name, aerosol_optics_override_file_name
+    character(511) :: liq_optics_override_file_name, ice_optics_override_file_name
+    character(511) :: cloud_pdf_override_file_name
+    character(63)  :: liquid_model_name, ice_model_name, gas_model_name
+    character(63)  :: sw_solver_name, lw_solver_name, overlap_scheme_name
+    character(63)  :: sw_entrapment_name, sw_encroachment_name, cloud_pdf_shape_name
+    integer :: i_aerosol_type_map(NMaxAerosolTypes) ! More than 256 is an error
+
+    logical :: do_nearest_spectral_sw_albedo = .true.
+    logical :: do_nearest_spectral_lw_emiss  = .true.
+    real(jprb) :: sw_albedo_wavelength_bound(NMaxAlbedoIntervals-1)
+    real(jprb) :: lw_emiss_wavelength_bound( NMaxAlbedoIntervals-1)
+    integer :: i_sw_albedo_index(NMaxAlbedoIntervals)
+    integer :: i_lw_emiss_index (NMaxAlbedoIntervals)
+
+    integer :: iunit ! Unit number of namelist file
+
+    namelist /radiation/ do_sw, do_lw, do_sw_direct, &
+         &  do_3d_effects, do_lw_side_emissivity, do_clear, &
+         &  do_save_radiative_properties, sw_entrapment_name, sw_encroachment_name, &
+         &  do_3d_lw_multilayer_effects, do_fu_lw_ice_optics_bug, &
+         &  do_save_spectral_flux, do_save_gpoint_flux, &
+         &  do_surface_sw_spectral_flux, do_lw_derivatives, &
+         &  do_lw_aerosol_scattering, do_lw_cloud_scattering, &
+         &  n_regions, directory_name, gas_model_name, &
+         &  ice_optics_override_file_name, liq_optics_override_file_name, &
+         &  aerosol_optics_override_file_name, cloud_pdf_override_file_name, &
+         &  liquid_model_name, ice_model_name, max_3d_transfer_rate, &
+         &  min_cloud_effective_size, overhang_factor, encroachment_scaling, &
+         &  use_canopy_full_spectrum_sw, use_canopy_full_spectrum_lw, &
+         &  do_canopy_fluxes_sw, do_canopy_fluxes_lw, &
+         &  do_canopy_gases_sw, do_canopy_gases_lw, &
+         &  do_sw_delta_scaling_with_gases, overlap_scheme_name, &
+         &  sw_solver_name, lw_solver_name, use_beta_overlap, &
+         &  use_expm_everywhere, iverbose, iverbosesetup, &
+         &  cloud_inhom_decorr_scaling, cloud_fraction_threshold, &
+         &  clear_to_thick_fraction, max_gas_od_3d, max_cloud_od, &
+         &  cloud_mixing_ratio_threshold, overhead_sun_factor, &
+         &  n_aerosol_types, i_aerosol_type_map, use_aerosols, &
+         &  mono_lw_wavelength, mono_lw_total_od, mono_sw_total_od, &
+         &  mono_lw_single_scattering_albedo, mono_sw_single_scattering_albedo, &
+         &  mono_lw_asymmetry_factor, mono_sw_asymmetry_factor, &
+         &  cloud_pdf_shape_name, &
+         &  do_nearest_spectral_sw_albedo, do_nearest_spectral_lw_emiss, &
+         &  sw_albedo_wavelength_bound, lw_emiss_wavelength_bound, &
+         &  i_sw_albedo_index, i_lw_emiss_index
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_config:read',0,hook_handle)
+
+    ! Copy default values from the original structure 
+    do_sw = this%do_sw
+    do_lw = this%do_lw
+    do_sw_direct = this%do_sw_direct
+    do_3d_effects = this%do_3d_effects
+    do_3d_lw_multilayer_effects = this%do_3d_lw_multilayer_effects
+    do_lw_side_emissivity = this%do_lw_side_emissivity
+    do_clear = this%do_clear
+    do_lw_aerosol_scattering = this%do_lw_aerosol_scattering
+    do_lw_cloud_scattering = this%do_lw_cloud_scattering
+    do_sw_delta_scaling_with_gases = this%do_sw_delta_scaling_with_gases
+    do_fu_lw_ice_optics_bug = this%do_fu_lw_ice_optics_bug
+    do_canopy_fluxes_sw = this%do_canopy_fluxes_sw
+    do_canopy_fluxes_lw = this%do_canopy_fluxes_lw
+    use_canopy_full_spectrum_sw = this%use_canopy_full_spectrum_sw
+    use_canopy_full_spectrum_lw = this%use_canopy_full_spectrum_lw
+    do_canopy_gases_sw = this%do_canopy_gases_sw
+    do_canopy_gases_lw = this%do_canopy_gases_lw
+    n_regions = this%nregions
+    directory_name = this%directory_name
+    cloud_pdf_override_file_name = this%cloud_pdf_override_file_name
+    liq_optics_override_file_name = this%liq_optics_override_file_name
+    ice_optics_override_file_name = this%ice_optics_override_file_name
+    aerosol_optics_override_file_name = this%aerosol_optics_override_file_name
+    use_expm_everywhere = this%use_expm_everywhere
+    use_aerosols = this%use_aerosols
+    do_save_radiative_properties = this%do_save_radiative_properties
+    do_save_spectral_flux = this%do_save_spectral_flux
+    do_save_gpoint_flux = this%do_save_gpoint_flux
+    do_lw_derivatives = this%do_lw_derivatives
+    do_surface_sw_spectral_flux = this%do_surface_sw_spectral_flux
+    iverbose = this%iverbose
+    iverbosesetup = this%iverbosesetup
+    cloud_fraction_threshold = this%cloud_fraction_threshold
+    cloud_mixing_ratio_threshold = this%cloud_mixing_ratio_threshold
+    use_beta_overlap = this%use_beta_overlap
+    cloud_inhom_decorr_scaling = this%cloud_inhom_decorr_scaling
+    clear_to_thick_fraction = this%clear_to_thick_fraction
+    overhead_sun_factor = this%overhead_sun_factor
+    max_gas_od_3d = this%max_gas_od_3d
+    max_cloud_od = this%max_cloud_od
+    max_3d_transfer_rate = this%max_3d_transfer_rate
+    min_cloud_effective_size = this%min_cloud_effective_size
+    overhang_factor = this%overhang_factor
+    encroachment_scaling = -1.0_jprb
+    gas_model_name = '' !DefaultGasModelName
+    liquid_model_name = '' !DefaultLiquidModelName
+    ice_model_name = '' !DefaultIceModelName
+    sw_solver_name = '' !DefaultSwSolverName
+    lw_solver_name = '' !DefaultLwSolverName
+    sw_entrapment_name = ''
+    sw_encroachment_name = ''
+    overlap_scheme_name = ''
+    cloud_pdf_shape_name = ''
+    n_aerosol_types = this%n_aerosol_types
+    mono_lw_wavelength = this%mono_lw_wavelength
+    mono_lw_total_od = this%mono_lw_total_od
+    mono_sw_total_od = this%mono_sw_total_od
+    mono_lw_single_scattering_albedo = this%mono_lw_single_scattering_albedo
+    mono_sw_single_scattering_albedo = this%mono_sw_single_scattering_albedo
+    mono_lw_asymmetry_factor = this%mono_lw_asymmetry_factor
+    mono_sw_asymmetry_factor = this%mono_sw_asymmetry_factor
+    i_aerosol_type_map = this%i_aerosol_type_map
+    do_nearest_spectral_sw_albedo = this%do_nearest_spectral_sw_albedo
+    do_nearest_spectral_lw_emiss  = this%do_nearest_spectral_lw_emiss
+    sw_albedo_wavelength_bound    = this%sw_albedo_wavelength_bound
+    lw_emiss_wavelength_bound     = this%lw_emiss_wavelength_bound
+    i_sw_albedo_index             = this%i_sw_albedo_index
+    i_lw_emiss_index              = this%i_lw_emiss_index
+
+    if (present(file_name) .and. present(unit)) then
+      write(nulerr,'(a)') '*** Error: cannot specify both file_name and unit in call to config_type%read'
+      call radiation_abort('Radiation configuration error')
+    else if (.not. present(file_name) .and. .not. present(unit)) then
+      write(nulerr,'(a)') '*** Error: neither file_name nor unit specified in call to config_type%read'
+      call radiation_abort('Radiation configuration error')
+    end if
+
+    if (present(file_name)) then
+      ! Open the namelist file
+      iunit = nulrad
+      open(unit=iunit, iostat=iosopen, file=trim(file_name))
+    else
+      ! Assume that iunit represents and open file
+      iosopen = 0
+      iunit = unit
+    end if
+
+    if (iosopen /= 0) then
+      ! An error occurred opening the file
+      if (present(is_success)) then
+        is_success = .false.
+        ! We now continue the subroutine so that the default values
+        ! are placed in the config structure
+      else
+        write(nulerr,'(a,a,a)') '*** Error: namelist file "', &
+             &                trim(file_name), '" not found'
+        call radiation_abort('Radiation configuration error')
+      end if
+    else
+      read(unit=iunit, iostat=iosread, nml=radiation)
+      if (iosread /= 0) then
+        ! An error occurred reading the file
+        if (present(is_success)) then
+          is_success = .false.
+          ! We now continue the subroutine so that the default values
+          ! are placed in the config structure
+        else if (present(file_name)) then
+          write(nulerr,'(a,a,a)') '*** Error reading namelist "radiation" from file "', &
+               &      trim(file_name), '"'
+          close(unit=iunit)
+          call radiation_abort('Radiation configuration error')
+        else
+          write(nulerr,'(a,i0)') '*** Error reading namelist "radiation" from unit ', &
+               &      iunit
+          call radiation_abort('Radiation configuration error')
+        end if
+      end if
+
+      if (present(file_name)) then
+        close(unit=iunit)
+      end if
+    end if
+
+    ! Copy namelist data into configuration object
+
+    ! Start with verbosity levels, which should be within limits
+    if (iverbose < 0) then
+      iverbose = 0
+    end if
+    this%iverbose = iverbose
+
+    if (iverbosesetup < 0) then
+      iverbosesetup = 0
+    end if
+    this%iverbosesetup = iverbosesetup
+
+    this%do_lw = do_lw
+    this%do_sw = do_sw
+    this%do_clear = do_clear
+    this%do_sw_direct = do_sw_direct
+    this%do_3d_effects = do_3d_effects
+    this%do_3d_lw_multilayer_effects = do_3d_lw_multilayer_effects
+    this%do_lw_side_emissivity = do_lw_side_emissivity
+    this%use_expm_everywhere = use_expm_everywhere
+    this%use_aerosols = use_aerosols
+    this%do_lw_cloud_scattering = do_lw_cloud_scattering
+    this%do_lw_aerosol_scattering = do_lw_aerosol_scattering
+    this%nregions = n_regions
+    this%do_surface_sw_spectral_flux = do_surface_sw_spectral_flux
+    this%do_sw_delta_scaling_with_gases = do_sw_delta_scaling_with_gases
+    this%do_fu_lw_ice_optics_bug = do_fu_lw_ice_optics_bug
+    this%do_canopy_fluxes_sw = do_canopy_fluxes_sw
+    this%do_canopy_fluxes_lw = do_canopy_fluxes_lw
+    this%use_canopy_full_spectrum_sw = use_canopy_full_spectrum_sw
+    this%use_canopy_full_spectrum_lw = use_canopy_full_spectrum_lw
+    this%do_canopy_gases_sw = do_canopy_gases_sw
+    this%do_canopy_gases_lw = do_canopy_gases_lw
+    this%mono_lw_wavelength = mono_lw_wavelength
+    this%mono_lw_total_od = mono_lw_total_od
+    this%mono_sw_total_od = mono_sw_total_od
+    this%mono_lw_single_scattering_albedo = mono_lw_single_scattering_albedo
+    this%mono_sw_single_scattering_albedo = mono_sw_single_scattering_albedo
+    this%mono_lw_asymmetry_factor = mono_lw_asymmetry_factor
+    this%mono_sw_asymmetry_factor = mono_sw_asymmetry_factor
+    this%use_beta_overlap = use_beta_overlap
+    this%cloud_inhom_decorr_scaling = cloud_inhom_decorr_scaling
+    this%clear_to_thick_fraction = clear_to_thick_fraction
+    this%overhead_sun_factor = overhead_sun_factor
+    this%max_gas_od_3d = max_gas_od_3d
+    this%max_cloud_od = max_cloud_od
+    this%max_3d_transfer_rate = max_3d_transfer_rate
+    this%min_cloud_effective_size = max(1.0e-6_jprb, min_cloud_effective_size)
+    if (encroachment_scaling >= 0.0_jprb) then
+      this%overhang_factor = encroachment_scaling
+      if (iverbose >= 1) then
+        write(nulout, '(a)') 'Warning: radiation namelist parameter "encroachment_scaling" is deprecated: use "overhang_factor"'
+      end if
+    else
+      this%overhang_factor = overhang_factor
+    end if
+    this%directory_name = directory_name
+    this%cloud_pdf_override_file_name = cloud_pdf_override_file_name
+    this%liq_optics_override_file_name = liq_optics_override_file_name
+    this%ice_optics_override_file_name = ice_optics_override_file_name
+    this%aerosol_optics_override_file_name = aerosol_optics_override_file_name
+    this%cloud_fraction_threshold = cloud_fraction_threshold
+    this%cloud_mixing_ratio_threshold = cloud_mixing_ratio_threshold
+    this%n_aerosol_types = n_aerosol_types
+    this%do_save_radiative_properties = do_save_radiative_properties
+    this%do_lw_derivatives = do_lw_derivatives
+    this%do_save_spectral_flux = do_save_spectral_flux
+    this%do_save_gpoint_flux = do_save_gpoint_flux
+    this%do_nearest_spectral_sw_albedo = do_nearest_spectral_sw_albedo
+    this%do_nearest_spectral_lw_emiss  = do_nearest_spectral_lw_emiss
+    this%sw_albedo_wavelength_bound    = sw_albedo_wavelength_bound
+    this%lw_emiss_wavelength_bound     = lw_emiss_wavelength_bound
+    this%i_sw_albedo_index             = i_sw_albedo_index
+    this%i_lw_emiss_index              = i_lw_emiss_index
+
+    if (do_save_gpoint_flux) then
+      ! Saving the fluxes every g-point overrides saving as averaged
+      ! in a band, but this%do_save_spectral_flux needs to be TRUE as
+      ! it is tested inside the solver routines to decide whether to
+      ! save anything
+      this%do_save_spectral_flux = .true.
+    end if
+
+    ! Determine liquid optics model
+    call get_enum_code(liquid_model_name, LiquidModelName, &
+         &            'liquid_model_name', this%i_liq_model)
+
+    ! Determine ice optics model
+    call get_enum_code(ice_model_name, IceModelName, &
+         &            'ice_model_name', this%i_ice_model)
+
+    ! Determine gas optics model
+    call get_enum_code(gas_model_name, GasModelName, &
+         &            'gas_model_name', this%i_gas_model)
+
+    ! Determine solvers
+    call get_enum_code(sw_solver_name, SolverName, &
+         &            'sw_solver_name', this%i_solver_sw)
+    call get_enum_code(lw_solver_name, SolverName, &
+         &            'lw_solver_name', this%i_solver_lw)
+
+    if (len_trim(sw_encroachment_name) > 1) then
+      call get_enum_code(sw_encroachment_name, EncroachmentName, &
+           &             'sw_encroachment_name', this%i_3d_sw_entrapment)
+      write(nulout, '(a)') 'Warning: radiation namelist string "sw_encroachment_name" is deprecated: use "sw_entrapment_name"'
+    else
+      call get_enum_code(sw_entrapment_name, EntrapmentName, &
+           &             'sw_entrapment_name', this%i_3d_sw_entrapment)
+    end if
+
+    ! Determine overlap scheme
+    call get_enum_code(overlap_scheme_name, OverlapName, &
+         &             'overlap_scheme_name', this%i_overlap_scheme)
+    
+    ! Determine cloud PDF shape 
+    call get_enum_code(cloud_pdf_shape_name, PdfShapeName, &
+         &             'cloud_pdf_shape_name', this%i_cloud_pdf_shape)
+
+    this%i_aerosol_type_map = 0
+    if (this%use_aerosols) then
+      this%i_aerosol_type_map(1:n_aerosol_types) &
+           &  = i_aerosol_type_map(1:n_aerosol_types)
+    end if
+
+    ! Will clouds be used at all?
+    if ((this%do_sw .and. this%i_solver_sw /= ISolverCloudless) &
+         &  .or. (this%do_lw .and. this%i_solver_lw /= ISolverCloudless)) then
+      this%do_clouds = .true.
+    else
+      this%do_clouds = .false.
+    end if
+
+    ! Normal subroutine exit
+    if (present(is_success)) then
+      is_success = .true.
+    end if
+
+    if (lhook) call dr_hook('radiation_config:read',1,hook_handle)
+
+  end subroutine read_config_from_namelist
+
+
+  !---------------------------------------------------------------------
+  ! This routine is called by radiation_interface:setup_radiation and
+  ! it converts the user specified options into some more specific
+  ! data such as data file names
+  subroutine consolidate_config(this)
+
+    use yomhook,      only : lhook, dr_hook
+    use radiation_io, only : nulout, nulerr, radiation_abort
+
+    class(config_type), intent(inout)         :: this
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_config:consolidate',0,hook_handle)
+
+    ! Check consistency of models
+    if (this%do_canopy_fluxes_sw .and. .not. this%do_surface_sw_spectral_flux) then
+      if (this%iverbosesetup >= 1) then
+        write(nulout,'(a)') 'Warning: turning on do_surface_sw_spectral_flux as required by do_canopy_fluxes_sw'
+      end if
+      this%do_surface_sw_spectral_flux = .true.
+    end if
+
+    ! Will clouds be used at all?
+    if ((this%do_sw .and. this%i_solver_sw /= ISolverCloudless) &
+         &  .or. (this%do_lw .and. this%i_solver_lw /= ISolverCloudless)) then
+      this%do_clouds = .true.
+    else
+      this%do_clouds = .false.
+    end if
+
+    ! SPARTACUS only works with Exp-Ran overlap scheme
+    if ((       this%i_solver_sw == ISolverSPARTACUS &
+         & .or. this%i_solver_lw == ISolverSPARTACUS &
+         & .or. this%i_solver_sw == ISolverTripleclouds &
+         & .or. this%i_solver_lw == ISolverTripleclouds) &
+         & .and. this%i_overlap_scheme /= IOverlapExponentialRandom) then
+      write(nulerr,'(a)') '*** Error: SPARTACUS/Tripleclouds solvers can only do Exponential-Random overlap'
+      call radiation_abort('Radiation configuration error')
+
+    end if
+
+    ! Set aerosol optics file name
+    if (len_trim(this%aerosol_optics_override_file_name) > 0) then
+      if (this%aerosol_optics_override_file_name(1:1) == '/') then
+        this%aerosol_optics_file_name = trim(this%aerosol_optics_override_file_name)
+      else
+        this%aerosol_optics_file_name = trim(this%directory_name) &
+             &  // '/' // trim(this%aerosol_optics_override_file_name)
+      end if
+    else
+      ! In the IFS, the aerosol optics file should be specified in
+      ! ifs/module/radiation_setup.F90, not here
+      this%aerosol_optics_file_name &
+           &   = trim(this%directory_name) // "/aerosol_ifs_rrtm_45R2.nc"
+    end if
+
+    ! Set liquid optics file name
+    if (len_trim(this%liq_optics_override_file_name) > 0) then
+      if (this%liq_optics_override_file_name(1:1) == '/') then
+        this%liq_optics_file_name = trim(this%liq_optics_override_file_name)
+      else
+        this%liq_optics_file_name = trim(this%directory_name) &
+             &  // '/' // trim(this%liq_optics_override_file_name)
+      end if
+    else if (this%i_liq_model == ILiquidModelSOCRATES) then
+      this%liq_optics_file_name &
+           &  = trim(this%directory_name) // "/socrates_droplet_scattering_rrtm.nc"
+    else if (this%i_liq_model == ILiquidModelSlingo) then
+      this%liq_optics_file_name &
+           &  = trim(this%directory_name) // "/slingo_droplet_scattering_rrtm.nc"
+    end if
+
+    ! Set ice optics file name
+    if (len_trim(this%ice_optics_override_file_name) > 0) then
+      if (this%ice_optics_override_file_name(1:1) == '/') then
+        this%ice_optics_file_name = trim(this%ice_optics_override_file_name)
+      else
+        this%ice_optics_file_name = trim(this%directory_name) &
+             &  // '/' // trim(this%ice_optics_override_file_name)
+      end if
+    else if (this%i_ice_model == IIceModelFu) then
+      this%ice_optics_file_name &
+           &   = trim(this%directory_name) // "/fu_ice_scattering_rrtm.nc"
+    else if (this%i_ice_model == IIceModelBaran) then
+      this%ice_optics_file_name &
+           &   = trim(this%directory_name) // "/baran_ice_scattering_rrtm.nc"
+    else if (this%i_ice_model == IIceModelBaran2016) then
+      this%ice_optics_file_name &
+           &   = trim(this%directory_name) // "/baran2016_ice_scattering_rrtm.nc"
+    else if (this%i_ice_model == IIceModelBaran2017) then
+      this%ice_optics_file_name &
+           &   = trim(this%directory_name) // "/baran2017_ice_scattering_rrtm.nc"
+    else if (this%i_ice_model == IIceModelYi) then
+      this%ice_optics_file_name &
+           &   = trim(this%directory_name) // "/yi_ice_scattering_rrtm.nc"
+    end if
+
+    ! Set cloud-water PDF look-up table file name
+    if (len_trim(this%cloud_pdf_override_file_name) > 0) then
+      if (this%cloud_pdf_override_file_name(1:1) == '/') then
+        this%cloud_pdf_file_name = trim(this%cloud_pdf_override_file_name)
+      else
+        this%cloud_pdf_file_name = trim(this%directory_name) &
+             &  // '/' // trim(this%cloud_pdf_override_file_name)
+      end if
+    elseif (this%i_cloud_pdf_shape == IPdfShapeLognormal) then
+      this%cloud_pdf_file_name = trim(this%directory_name) // "/mcica_lognormal.nc"
+    else
+      this%cloud_pdf_file_name = trim(this%directory_name) // "/mcica_gamma.nc"
+    end if
+
+    ! Aerosol data
+    if (this%n_aerosol_types < 0 &
+         &  .or. this%n_aerosol_types > NMaxAerosolTypes) then
+      write(nulerr,'(a,i0)') '*** Error: number of aerosol types must be between 0 and ', &
+           &  NMaxAerosolTypes
+      call radiation_abort('Radiation configuration error')
+    end if
+
+    if (this%use_aerosols .and. this%n_aerosol_types == 0) then
+      if (this%iverbosesetup >= 2) then
+        write(nulout, '(a)') 'Aerosols on but n_aerosol_types=0: optical properties to be computed outside ecRad'
+      end if
+    end if
+
+    ! In the monochromatic case we need to override the liquid, ice
+    ! and aerosol models to ensure compatibility
+    if (this%i_gas_model == IGasModelMonochromatic) then
+      this%i_liq_model = ILiquidModelMonochromatic
+      this%i_ice_model = IIceModelMonochromatic
+      this%use_aerosols = .false.
+    end if
+
+    ! McICA solver currently can't store full profiles of spectral fluxes
+    if (this%i_solver_sw == ISolverMcICA) then
+      this%do_save_spectral_flux = .false.
+    end if
+
+    if (this%i_solver_sw == ISolverSPARTACUS .and. this%do_sw_delta_scaling_with_gases) then
+      write(nulerr,'(a)') '*** Error: SW delta-Eddington scaling with gases not possible with SPARTACUS solver'
+      call radiation_abort('Radiation configuration error')
+    end if
+
+    if ((this%do_lw .and. this%do_sw) .and. &
+         & (     (      this%i_solver_sw == ISolverHomogeneous  &
+         &        .and. this%i_solver_lw /= ISolverHomogeneous) &
+         &  .or. (      this%i_solver_sw /= ISolverHomogeneous  &
+         &        .and. this%i_solver_lw == ISolverHomogeneous) &
+         & ) ) then
+      write(nulerr,'(a)') '*** Error: if one solver is "Homogeneous" then the other must be'
+      call radiation_abort('Radiation configuration error')
+    end if
+
+    ! Set is_homogeneous if the active solvers are homogeneous, since
+    ! this affects how "in-cloud" water contents are computed
+    if (        (this%do_sw .and. this%i_solver_sw == ISolverHomogeneous) &
+         & .or. (this%do_lw .and. this%i_solver_lw == ISolverHomogeneous)) then
+      this%is_homogeneous = .true.
+    end if
+
+    this%is_consolidated = .true.
+
+    if (lhook) call dr_hook('radiation_config:consolidate',1,hook_handle)
+
+  end subroutine consolidate_config
+
+
+  !---------------------------------------------------------------------
+  ! This subroutine sets members of the configuration object via
+  ! optional arguments, and any member not specified is left
+  ! untouched. Therefore, this should be called after taking data from
+  ! the namelist.
+  subroutine set_config(config, directory_name, &
+       &  do_lw, do_sw, &
+       &  do_lw_aerosol_scattering, do_lw_cloud_scattering, &
+       &  do_sw_direct)
+
+    class(config_type), intent(inout):: config
+    character(len=*), intent(in), optional  :: directory_name
+    logical, intent(in), optional           :: do_lw, do_sw
+    logical, intent(in), optional           :: do_lw_aerosol_scattering
+    logical, intent(in), optional           :: do_lw_cloud_scattering
+    logical, intent(in), optional           :: do_sw_direct
+
+    if (present(do_lw)) then
+       config%do_lw = do_lw
+    end if
+
+    if(present(do_sw)) then
+       config%do_sw = do_sw
+    end if
+
+    if (present(do_sw_direct)) then
+       config%do_sw_direct = do_sw_direct
+    end if
+
+    if (present(directory_name)) then
+       config%directory_name = trim(directory_name)
+    end if
+
+    if (present(do_lw_aerosol_scattering)) then
+       config%do_lw_aerosol_scattering = .true.
+    end if
+
+    if (present(do_lw_cloud_scattering)) then
+       config%do_lw_cloud_scattering = .true.
+    end if
+
+  end subroutine set_config
+
+
+  !---------------------------------------------------------------------
+  ! Print configuration information to standard output
+  subroutine print_config(this, iverbose)
+
+    use radiation_io, only : nulout
+
+    class(config_type), intent(in) :: this
+
+    integer, optional,  intent(in) :: iverbose
+    integer                        :: i_local_verbose
+
+    if (present(iverbose)) then
+      i_local_verbose = iverbose
+    else
+      i_local_verbose = this%iverbose
+    end if
+
+    if (i_local_verbose >= 2) then
+      !---------------------------------------------------------------------
+      write(nulout, '(a)') 'General settings:'
+      write(nulout, '(a,a,a)') '  Data files expected in "', &
+           &                   trim(this%directory_name), '"'
+      call print_logical('  Clear-sky calculations are', 'do_clear', this%do_clear)
+      call print_logical('  Saving intermediate radiative properties', &
+           &   'do_save_radiative_properties', this%do_save_radiative_properties)
+      call print_logical('  Saving spectral flux profiles', &
+           &   'do_save_spectral_flux', this%do_save_spectral_flux)
+      call print_enum('  Gas model is', GasModelName, 'i_gas_model', &
+           &          this%i_gas_model)
+      call print_logical('  Aerosols are', 'use_aerosols', this%use_aerosols)
+      call print_logical('  Clouds are', 'do_clouds', this%do_clouds)
+
+      !---------------------------------------------------------------------
+      write(nulout, '(a)') 'Surface settings:'
+      if (this%do_sw) then
+        call print_logical('  Saving surface shortwave spectral fluxes', &
+             &   'do_surface_sw_spectral_flux', this%do_surface_sw_spectral_flux)
+        call print_logical('  Saving surface shortwave fluxes in abledo bands', &
+             &   'do_canopy_fluxes_sw', this%do_canopy_fluxes_sw)
+      end if
+      if (this%do_lw) then
+        call print_logical('  Saving surface longwave fluxes in emissivity bands', &
+             &   'do_canopy_fluxes_lw', this%do_canopy_fluxes_lw)
+        call print_logical('  Longwave derivative calculation is', &
+             &   'do_lw_derivatives',this%do_lw_derivatives)
+      end if
+      if (this%do_sw) then
+        call print_logical('  Nearest-neighbour spectral albedo mapping', &
+             &   'do_nearest_spectral_sw_albedo', this%do_nearest_spectral_sw_albedo)
+      end if
+      if (this%do_lw) then
+        call print_logical('  Nearest-neighbour spectral emissivity mapping', &
+             &   'do_nearest_spectral_lw_emiss', this%do_nearest_spectral_lw_emiss)
+      end if
+      !---------------------------------------------------------------------
+      if (this%do_clouds) then
+        write(nulout, '(a)') 'Cloud settings:'
+        call print_real('  Cloud fraction threshold', &
+             &   'cloud_fraction_threshold', this%cloud_fraction_threshold)
+        call print_real('  Cloud mixing-ratio threshold', &
+             &   'cloud_mixing_ratio_threshold', this%cloud_mixing_ratio_threshold)
+        call print_enum('  Liquid optics scheme is', LiquidModelName, &
+             &          'i_liq_model',this%i_liq_model)
+        call print_enum('  Ice optics scheme is', IceModelName, &
+             &          'i_ice_model',this%i_ice_model)
+        if (this%i_ice_model == IIceModelFu) then
+          call print_logical('  Longwave ice optics bug in Fu scheme is', &
+               &   'do_fu_lw_ice_optics_bug',this%do_fu_lw_ice_optics_bug)
+        end if
+        call print_enum('  Cloud overlap scheme is', OverlapName, &
+             &          'i_overlap_scheme',this%i_overlap_scheme)
+        call print_logical('  Use "beta" overlap parameter is', &
+             &   'use_beta_overlap', this%use_beta_overlap)
+        call print_enum('  Cloud PDF shape is', PdfShapeName, &
+             &          'i_cloud_pdf_shape',this%i_cloud_pdf_shape)
+        call print_real('  Cloud inhom decorrelation scaling', &
+             &   'cloud_inhom_decorr_scaling', this%cloud_inhom_decorr_scaling)
+      end if
+
+      !---------------------------------------------------------------------
+      write(nulout, '(a)') 'Solver settings:'
+      if (this%do_sw) then
+        call print_enum('  Shortwave solver is', SolverName, &
+             &          'i_solver_sw', this%i_solver_sw)
+        
+        if (this%i_gas_model == IGasModelMonochromatic) then
+          call print_real('  Shortwave atmospheric optical depth', &
+               &   'mono_sw_total_od', this%mono_sw_total_od)
+          call print_real('  Shortwave particulate single-scattering albedo', &
+               &   'mono_sw_single_scattering_albedo', &
+               &   this%mono_sw_single_scattering_albedo)
+          call print_real('  Shortwave particulate asymmetry factor', &
+               &   'mono_sw_asymmetry_factor', &
+               &   this%mono_sw_asymmetry_factor)
+        end if
+        call print_logical('  Shortwave delta scaling after merge with gases', &
+             &   'do_sw_delta_scaling_with_gases', &
+             &   this%do_sw_delta_scaling_with_gases)
+      else
+        call print_logical('  Shortwave calculations are','do_sw',this%do_sw)
+      end if
+
+      if (this%do_lw) then
+        call print_enum('  Longwave solver is', SolverName, 'i_solver_lw', &
+             &          this%i_solver_lw)
+
+        if (this%i_gas_model == IGasModelMonochromatic) then
+          if (this%mono_lw_wavelength > 0.0_jprb) then
+            call print_real('  Longwave effective wavelength (m)', &
+                 &   'mono_lw_wavelength', this%mono_lw_wavelength)
+          else
+            write(nulout,'(a)') '  Longwave fluxes are broadband                              (mono_lw_wavelength<=0)'
+          end if
+          call print_real('  Longwave atmospheric optical depth', &
+               &   'mono_lw_total_od', this%mono_lw_total_od)  
+          call print_real('  Longwave particulate single-scattering albedo', &
+               &   'mono_lw_single_scattering_albedo', &
+               &   this%mono_lw_single_scattering_albedo)
+          call print_real('  Longwave particulate asymmetry factor', &
+               &   'mono_lw_asymmetry_factor', &
+               &   this%mono_lw_asymmetry_factor)
+        end if
+        call print_logical('  Longwave cloud scattering is', &
+             &   'do_lw_cloud_scattering',this%do_lw_cloud_scattering)
+        call print_logical('  Longwave aerosol scattering is', &
+             &   'do_lw_aerosol_scattering',this%do_lw_aerosol_scattering)
+      else
+        call print_logical('  Longwave calculations are','do_lw', this%do_lw)
+      end if
+
+      if (this%i_solver_sw == ISolverSpartacus &
+           &  .or. this%i_solver_lw == ISolverSpartacus) then
+        write(nulout, '(a)') '  SPARTACUS options:'
+        call print_integer('    Number of regions', 'n_regions', this%nregions)
+        call print_real('    Max cloud optical depth per layer', &
+             &   'max_cloud_od', this%max_cloud_od)
+        call print_enum('    Shortwave entrapment is', EntrapmentName, &
+             &          'i_3d_sw_entrapment', this%i_3d_sw_entrapment)
+        call print_logical('    Multilayer longwave horizontal transport is', &
+             'do_3d_lw_multilayer_effects', this%do_3d_lw_multilayer_effects)
+        call print_logical('    Use matrix exponential everywhere is', &
+             &   'use_expm_everywhere', this%use_expm_everywhere)
+        call print_logical('    3D effects are', 'do_3d_effects', &
+             &             this%do_3d_effects)
+
+        if (this%do_3d_effects) then
+          call print_logical('    Longwave side emissivity parameterization is', &
+               &  'do_lw_side_emissivity', this%do_lw_side_emissivity)
+          call print_real('    Clear-to-thick edge fraction is', &
+               &  'clear_to_thick_fraction', this%clear_to_thick_fraction)
+          call print_real('    Overhead sun factor is', &
+               &  'overhead_sun_factor', this%overhead_sun_factor)
+          call print_real('    Max gas optical depth for 3D effects', &
+               &   'max_gas_od_3d', this%max_gas_od_3d)
+          call print_real('    Max 3D transfer rate', &
+               &   'max_3d_transfer_rate', this%max_3d_transfer_rate)
+          call print_real('    Min cloud effective size (m)', &
+               &   'min_cloud_effective_size', this%min_cloud_effective_size)
+          call print_real('    Overhang factor', &
+               &   'overhang_factor', this%overhang_factor)
+        end if
+      end if
+            
+    end if
+    
+  end subroutine print_config
+
+
+
+  !---------------------------------------------------------------------
+  ! In order to estimate UV and photosynthetically active radiation,
+  ! we need weighted sum of fluxes considering wavelength range
+  ! required.  This routine returns information for how to correctly
+  ! weight output spectral fluxes for a range of input wavelengths.
+  ! Note that this is approximate; internally it may be assumed that
+  ! the energy is uniformly distributed in wavenumber space, for
+  ! example.  If the character string "weighting_name" is present, and
+  ! iverbose>=2, then information on the weighting will be provided on
+  ! nulout.
+  subroutine get_sw_weights(this, wavelength1, wavelength2, &
+       &                    nweights, iband, weight, weighting_name)
+
+    use parkind1, only : jprb
+    use radiation_io, only : nulout, nulerr, radiation_abort
+
+    class(config_type), intent(in) :: this
+    ! Range of wavelengths to get weights for (m)
+    real(jprb), intent(in) :: wavelength1, wavelength2
+    ! Output number of weights needed
+    integer,    intent(out)   :: nweights
+    ! Only write to the first nweights of these arrays: they contain
+    ! the indices to the non-zero bands, and the weight in each of
+    ! those bands
+    integer,    intent(out)   :: iband(:)
+    real(jprb), intent(out)   :: weight(:)
+    character(len=*), optional, intent(in) :: weighting_name
+
+    ! Internally we deal with wavenumber
+    real(jprb) :: wavenumber1, wavenumber2 ! cm-1
+
+    integer :: jband ! Loop index for spectral band
+
+    if (this%n_bands_sw <= 0) then
+      write(nulerr,'(a)') '*** Error: get_sw_weights called before number of shortwave bands set'
+      call radiation_abort()      
+    end if
+
+    ! Convert wavelength range (m) to wavenumber (cm-1)
+    wavenumber1 = 0.01_jprb / wavelength2
+    wavenumber2 = 0.01_jprb / wavelength1
+
+    nweights = 0
+
+    do jband = 1,this%n_bands_sw
+      if (wavenumber1 < this%wavenumber2_sw(jband) &
+           &  .and. wavenumber2 > this%wavenumber1_sw(jband)) then
+        nweights = nweights+1
+        iband(nweights) = jband
+        weight(nweights) = (min(wavenumber2,this%wavenumber2_sw(jband)) &
+             &         - max(wavenumber1,this%wavenumber1_sw(jband))) &
+             & / (this%wavenumber2_sw(jband) - this%wavenumber1_sw(jband))
+      end if
+    end do
+
+    if (nweights == 0) then
+      write(nulerr,'(a,e8.4,a,e8.4,a)') '*** Error: wavelength range ', &
+           &  wavelength1, ' to ', wavelength2, ' m is outside shortwave band'
+      call radiation_abort()
+    else if (this%iverbosesetup >= 2 .and. present(weighting_name)) then
+      write(nulout,'(a,a,a,f6.0,a,f6.0,a)') 'Spectral weights for ', &
+           &  weighting_name, ' (', wavenumber1, ' to ', &
+           &  wavenumber2, ' cm-1):'
+      do jband = 1, nweights
+        write(nulout, '(a,i0,a,f6.0,a,f6.0,a,f8.4)') '  Shortwave band ', &
+             &  iband(jband), ' (', this%wavenumber1_sw(iband(jband)), ' to ', &
+             &  this%wavenumber2_sw(iband(jband)), ' cm-1): ', weight(jband)
+      end do
+    end if
+
+  end subroutine get_sw_weights
+
+
+  !---------------------------------------------------------------------
+  ! The input shortwave surface albedo coming in is likely to be in
+  ! different spectral intervals to the gas model in the radiation
+  ! scheme. We assume that the input albedo is defined within
+  ! "ninterval" spectral intervals covering the wavelength range 0 to
+  ! infinity, but allow for the possibility that two intervals may be
+  ! indexed back to the same albedo band.  
+  subroutine define_sw_albedo_intervals(this, ninterval, wavelength_bound, &
+       &                                i_intervals, do_nearest)
+
+    use radiation_io, only : nulerr, radiation_abort
+
+    class(config_type),   intent(inout) :: this
+    ! Number of spectral intervals in which albedo is defined
+    integer,              intent(in)    :: ninterval
+    ! Monotonically increasing wavelength bounds between intervals,
+    ! not including the outer bounds (which are assumed to be zero and
+    ! infinity)
+    real(jprb),           intent(in)    :: wavelength_bound(ninterval-1)
+    ! The albedo indices corresponding to each interval
+    integer,              intent(in)    :: i_intervals(ninterval)
+    logical,    optional, intent(in)    :: do_nearest
+    
+    if (ninterval > NMaxAlbedoIntervals) then
+      write(nulerr,'(a,i0,a,i0)') '*** Error: ', ninterval, &
+           &  ' albedo intervals exceeds maximum of ', NMaxAlbedoIntervals
+      call radiation_abort();
+    end if
+
+    if (present(do_nearest)) then
+      this%do_nearest_spectral_sw_albedo = do_nearest
+    else
+      this%do_nearest_spectral_sw_albedo = .false.
+    end if
+    this%sw_albedo_wavelength_bound(1:ninterval-1) = wavelength_bound(1:ninterval-1)
+    this%sw_albedo_wavelength_bound(ninterval:)    = -1.0_jprb
+    this%i_sw_albedo_index(1:ninterval)            = i_intervals(1:ninterval)
+    this%i_sw_albedo_index(ninterval+1:)           = 0
+
+    if (this%is_consolidated) then
+      call this%consolidate_intervals(.true., &
+           &  this%do_nearest_spectral_sw_albedo, &
+           &  this%sw_albedo_wavelength_bound, this%i_sw_albedo_index, &
+           &  this%wavenumber1_sw, this%wavenumber2_sw, &
+           &  this%i_albedo_from_band_sw, this%sw_albedo_weights)
+    end if
+
+  end subroutine define_sw_albedo_intervals
+
+
+  !---------------------------------------------------------------------
+  ! As define_sw_albedo_intervals but for longwave emissivity
+  subroutine define_lw_emiss_intervals(this, ninterval, wavelength_bound, &
+       &                                i_intervals, do_nearest)
+
+    use radiation_io, only : nulerr, radiation_abort
+
+    class(config_type),   intent(inout) :: this
+    ! Number of spectral intervals in which emissivity is defined
+    integer,              intent(in)    :: ninterval
+    ! Monotonically increasing wavelength bounds between intervals,
+    ! not including the outer bounds (which are assumed to be zero and
+    ! infinity)
+    real(jprb),           intent(in)    :: wavelength_bound(ninterval-1)
+    ! The emissivity indices corresponding to each interval
+    integer,              intent(in)    :: i_intervals(ninterval)
+    logical,    optional, intent(in)    :: do_nearest
+    
+    if (ninterval > NMaxAlbedoIntervals) then
+      write(nulerr,'(a,i0,a,i0)') '*** Error: ', ninterval, &
+           &  ' emissivity intervals exceeds maximum of ', NMaxAlbedoIntervals
+      call radiation_abort();
+    end if
+
+    if (present(do_nearest)) then
+      this%do_nearest_spectral_lw_emiss = do_nearest
+    else
+      this%do_nearest_spectral_lw_emiss = .false.
+    end if
+    this%lw_emiss_wavelength_bound(1:ninterval-1) = wavelength_bound(1:ninterval-1)
+    this%lw_emiss_wavelength_bound(ninterval:)    = -1.0_jprb
+    this%i_lw_emiss_index(1:ninterval)            = i_intervals(1:ninterval)
+    this%i_lw_emiss_index(ninterval+1:)           = 0
+
+    if (this%is_consolidated) then
+      call this%consolidate_intervals(.false., &
+           &  this%do_nearest_spectral_lw_emiss, &
+           &  this%lw_emiss_wavelength_bound, this%i_lw_emiss_index, &
+           &  this%wavenumber1_lw, this%wavenumber2_lw, &
+           &  this%i_emiss_from_band_lw, this%lw_emiss_weights)
+    end if
+
+  end subroutine define_lw_emiss_intervals
+
+
+  !---------------------------------------------------------------------
+  ! This routine consolidates either the input shortwave albedo
+  ! intervals with the shortwave bands, or the input longwave
+  ! emissivity intervals with the longwave bands, depending on the
+  ! arguments provided.
+  subroutine consolidate_intervals(this, is_sw, do_nearest, &
+       &  wavelength_bound, i_intervals, wavenumber1, wavenumber2, &
+       &  i_mapping, weights)
+
+    use radiation_io, only : nulout, nulerr, radiation_abort
+
+    class(config_type),   intent(inout) :: this
+    ! Is this the shortwave?  Otherwise longwave
+    logical,    intent(in)    :: is_sw
+    ! Do we find the nearest albedo interval to the centre of each
+    ! band, or properly weight the contributions? This can be modified
+    ! if there is only one albedo intervals.
+    logical, intent(inout)    :: do_nearest
+    ! Monotonically increasing wavelength bounds between intervals,
+    ! not including the outer bounds (which are assumed to be zero and
+    ! infinity)
+    real(jprb), intent(in)    :: wavelength_bound(NMaxAlbedoIntervals-1)
+    ! The albedo band indices corresponding to each interval
+    integer,    intent(in)    :: i_intervals(NMaxAlbedoIntervals)
+    ! Start and end wavenumber bounds for the ecRad bands (cm-1)
+    real(jprb), intent(in)    :: wavenumber1(:), wavenumber2(:)
+
+    ! if do_nearest is TRUE then the result is expressed in i_mapping,
+    ! which will be allocated to have the same length as wavenumber1,
+    ! and contain the index of the albedo interval corresponding to
+    ! that band
+    integer,    allocatable, intent(inout) :: i_mapping(:)
+    ! ...otherwise the result is expressed in "weights", of
+    ! size(n_intervals, n_bands) containing how much of each interval
+    ! contributes to each band.
+    real(jprb), allocatable, intent(inout) :: weights(:,:)
+
+    ! Number and loop index of ecRad bands
+    integer    :: nband, jband
+    ! Number and index of albedo/emissivity intervals
+    integer    :: ninterval, iinterval
+    ! Sometimes an albedo or emissivity value will be used in more
+    ! than one interval, so nvalue indicates how many values will
+    ! actually be provided
+    integer    :: nvalue
+    ! Wavenumber bounds of the albedo/emissivity interval
+    real(jprb) :: wavenumber1_albedo, wavenumber2_albedo
+    ! Reciprocal of the wavenumber range of the ecRad band
+    real(jprb) :: recip_dwavenumber ! cm
+    ! Midpoint/bound of wavenumber band
+    real(jprb) :: wavenumber_mid, wavenumber_bound ! cm-1
+    
+    nband = size(wavenumber1)
+
+    ! Count the number of albedo/emissivity intervals
+    ninterval = 0
+    do iinterval = 1,NMaxAlbedoIntervals
+      if (i_intervals(iinterval) > 0) then
+        ninterval = iinterval
+      else
+        exit
+      end if
+    end do
+
+    if (ninterval < 2) then
+      ! Zero or one albedo/emissivity intervals found, so we index all
+      ! bands to one interval
+      if (allocated(i_mapping)) then
+        deallocate(i_mapping)
+      end if
+      allocate(i_mapping(nband))
+      i_mapping(:) = 1
+      do_nearest = .true.
+      ninterval = 1
+      nvalue = 1
+    else
+      ! Check wavelength is monotonically increasing
+      do jband = 2,ninterval-1
+        if (wavelength_bound(jband) <= wavelength_bound(jband-1)) then
+          if (is_sw) then
+            write(nulerr, '(a,a)') '*** Error: wavelength bounds for shortwave albedo intervals ', &
+                 &  'must be monotonically increasing'
+          else
+            write(nulerr, '(a,a)') '*** Error: wavelength bounds for longwave emissivity intervals ', &
+                 &  'must be monotonically increasing'
+          end if
+          call radiation_abort()
+        end if
+      end do
+
+      ! What is the maximum index, indicating the number of
+      ! albedo/emissivity values to expect?
+      nvalue = maxval(i_intervals(1:ninterval))
+      
+      if (do_nearest) then
+        ! Simpler nearest-neighbour mapping from band to
+        ! albedo/emissivity interval
+        if (allocated(i_mapping)) then
+          deallocate(i_mapping)
+        end if
+        allocate(i_mapping(nband))
+
+        ! Loop over bands
+        do jband = 1,nband
+          ! Compute mid-point of band in wavenumber space (cm-1)
+          wavenumber_mid = 0.5_jprb * (wavenumber1(jband) &
+               &                     + wavenumber2(jband))
+          iinterval = 1
+          ! Convert wavelength (m) into wavenumber (cm-1) at the lower
+          ! bound of the albedo interval
+          wavenumber_bound = 0.01_jprb / wavelength_bound(iinterval)
+          ! Find the albedo interval that has the largest overlap with
+          ! the band; this approach assumes that the albedo intervals
+          ! are larger than the spectral bands
+          do while (wavenumber_bound >= wavenumber_mid &
+               &    .and. iinterval < ninterval)
+            iinterval = iinterval + 1
+            if (iinterval < ninterval) then
+              wavenumber_bound = 0.01_jprb / wavelength_bound(iinterval)
+            else
+              ! For the last interval there is no lower bound
+              wavenumber_bound = 0.0_jprb
+            end if
+          end do
+          ! Save the index of the band corresponding to the albedo
+          ! interval and move onto the next band
+          i_mapping(jband) = i_intervals(iinterval)
+        end do
+      else
+        ! More accurate weighting
+        if (allocated(weights)) then
+          deallocate(weights)
+        end if
+        allocate(weights(nvalue,nband))
+        weights(:,:) = 0.0_jprb
+        
+        ! Loop over bands
+        do jband = 1,nband
+          recip_dwavenumber = 1.0_jprb / (wavenumber2(jband) &
+               &                        - wavenumber1(jband))
+          ! Find the first overlapping albedo band
+          iinterval = 1
+          ! Convert wavelength (m) into wavenumber (cm-1) at the lower
+          ! bound (in wavenumber space) of the albedo/emissivty interval
+          wavenumber1_albedo = 0.01_jprb / wavelength_bound(iinterval)
+          do while (wavenumber1_albedo >= wavenumber2(jband) &
+               &    .and. iinterval < ninterval)
+            iinterval = iinterval + 1
+            wavenumber1_albedo = 0.01_jprb / wavelength_bound(iinterval)
+          end do
+          
+          wavenumber2_albedo = wavenumber2(jband)
+          
+          ! Add all overlapping bands
+          do while (wavenumber2_albedo > wavenumber1(jband) &
+               &  .and. iinterval <= ninterval)
+            weights(i_intervals(iinterval),jband) &
+                 &  = weights(i_intervals(iinterval),jband) &
+                 &  + recip_dwavenumber &
+                 &  * (min(wavenumber2_albedo,wavenumber2(jband)) &
+                 &   - max(wavenumber1_albedo,wavenumber1(jband)))
+            wavenumber2_albedo = wavenumber1_albedo
+            iinterval = iinterval + 1
+            if (iinterval < ninterval) then
+              wavenumber1_albedo = 0.01_jprb / wavelength_bound(iinterval)
+            else
+              wavenumber1_albedo = 0.0_jprb
+            end if
+          end do
+        end do
+      end if
+    end if
+
+    ! Define how many bands to use for reporting surface downwelling
+    ! fluxes for canopy radiation scheme
+    if (is_sw) then
+      if (this%use_canopy_full_spectrum_sw) then
+        this%n_canopy_bands_sw = this%n_g_sw
+      else 
+        this%n_canopy_bands_sw = nvalue
+      end if
+    else
+      if (this%use_canopy_full_spectrum_lw) then
+        this%n_canopy_bands_lw = this%n_g_lw
+      else 
+        this%n_canopy_bands_lw = nvalue
+      end if
+    end if
+
+    if (this%iverbosesetup >= 2) then
+      if (.not. do_nearest) then
+        if (is_sw) then
+          write(nulout, '(a,i0,a,i0,a)') 'Weighting of ', nvalue, ' albedo values in ', &
+             &  nband, ' shortwave bands (wavenumber ranges in cm-1):'
+        else
+          write(nulout, '(a,i0,a,i0,a)') 'Weighting of ', nvalue, ' emissivity values in ', &
+             &  nband, ' longwave bands (wavenumber ranges in cm-1):'
+        end if
+        do jband = 1,nband
+          write(nulout,'(i6,a,i6,a)',advance='no') nint(wavenumber1(jband)), ' to', &
+               &                        nint(wavenumber2(jband)), ':'
+          do iinterval = 1,nvalue
+            write(nulout,'(f5.2)',advance='no') weights(iinterval,jband)
+          end do
+          write(nulout, '()')
+        end do
+      else if (ninterval <= 1) then
+        if (is_sw) then
+          write(nulout, '(a)') 'All shortwave bands will use the same albedo'
+        else
+          write(nulout, '(a)') 'All longwave bands will use the same emissivty'
+        end if
+      else
+        if (is_sw) then
+          write(nulout, '(a,i0,a)',advance='no') 'Mapping from ', nband, &
+               &  ' shortwave bands to albedo intervals:'
+        else
+          write(nulout, '(a,i0,a)',advance='no') 'Mapping from ', nband, &
+               &  ' longwave bands to emissivity intervals:'
+        end if
+        do jband = 1,nband
+          write(nulout,'(a,i0)',advance='no') ' ', i_mapping(jband)
+        end do
+        write(nulout, '()')
+      end if
+    end if
+
+  end subroutine consolidate_intervals
+
+
+  !---------------------------------------------------------------------
+  ! Return the 0-based index for str in enum_str, or abort if it is
+  ! not found
+  subroutine get_enum_code(str, enum_str, var_name, icode)
+
+    use radiation_io, only : nulerr, radiation_abort
+
+    character(len=*), intent(in)  :: str
+    character(len=*), intent(in)  :: enum_str(0:)
+    character(len=*), intent(in)  :: var_name
+    integer,          intent(out) :: icode
+
+    integer :: jc
+    logical :: is_not_found
+
+    ! If string is empty then we don't modify icode but assume it has
+    ! a sensible default value
+    if (len_trim(str) > 1) then
+      is_not_found = .true.
+
+      do jc = 0,size(enum_str)-1
+        if (trim(str) == trim(enum_str(jc))) then
+          icode = jc
+          is_not_found = .false.
+          exit
+        end if
+      end do
+      if (is_not_found) then
+        write(nulerr,'(a,a,a,a,a)',advance='no') '*** Error: ', trim(var_name), &
+             &  ' must be one of: "', enum_str(0), '"'
+        do jc = 1,size(enum_str)-1
+          write(nulerr,'(a,a,a)',advance='no') ', "', trim(enum_str(jc)), '"'
+        end do
+        write(nulerr,'(a)') ''
+        call radiation_abort('Radiation configuration error')
+      end if
+    end if
+
+  end subroutine get_enum_code
+
+
+  !---------------------------------------------------------------------
+  ! Print one line of information: logical
+  subroutine print_logical(message_str, name, val)
+    use radiation_io, only : nulout
+    character(len=*),   intent(in) :: message_str
+    character(len=*),   intent(in) :: name
+    logical,            intent(in) :: val
+    character(4)                   :: on_or_off
+    character(NPrintStringLen)     :: str
+    if (val) then
+      on_or_off = ' ON '
+    else
+      on_or_off = ' OFF'
+    end if
+    write(str, '(a,a4)') message_str, on_or_off
+    write(nulout,'(a,a,a,a,l1,a)') str, ' (', name, '=', val,')'
+  end subroutine print_logical
+
+
+  !---------------------------------------------------------------------
+  ! Print one line of information: integer
+  subroutine print_integer(message_str, name, val)
+    use radiation_io, only : nulout
+    character(len=*),   intent(in) :: message_str
+    character(len=*),   intent(in) :: name
+    integer,            intent(in) :: val
+    character(NPrintStringLen)     :: str
+    write(str, '(a,a,i0)') message_str, ' = ', val
+    write(nulout,'(a,a,a,a)') str, ' (', name, ')'
+  end subroutine print_integer
+
+
+  !---------------------------------------------------------------------
+  ! Print one line of information: real
+  subroutine print_real(message_str, name, val)
+    use parkind1,     only : jprb
+    use radiation_io, only : nulout
+    character(len=*),   intent(in) :: message_str
+    character(len=*),   intent(in) :: name
+    real(jprb),         intent(in) :: val
+    character(NPrintStringLen)     :: str
+    write(str, '(a,a,g8.3)') message_str, ' = ', val
+    write(nulout,'(a,a,a,a)') str, ' (', name, ')'
+  end subroutine print_real
+
+
+  !---------------------------------------------------------------------
+  ! Print one line of information: enum
+  subroutine print_enum(message_str, enum_str, name, val)
+    use radiation_io, only : nulout
+    character(len=*),   intent(in) :: message_str
+    character(len=*),   intent(in) :: enum_str(0:)
+    character(len=*),   intent(in) :: name
+    integer,            intent(in) :: val
+    character(NPrintStringLen)     :: str
+    write(str, '(a,a,a,a)') message_str, ' "', trim(enum_str(val)), '"'
+    write(nulout,'(a,a,a,a,i0,a)') str, ' (', name, '=', val,')'
+  end subroutine print_enum
+
+
+  !---------------------------------------------------------------------
+  ! Return .true. if 1D allocatable array "var" is out of physical
+  ! range specified by boundmin and boundmax, and issue a warning.
+  ! "do_fix" determines whether erroneous values are fixed to lie
+  ! within the physical range. To check only a subset of the array,
+  ! specify i1 and i2 for the range.
+  function out_of_bounds_1d(var, var_name, boundmin, boundmax, do_fix, i1, i2) result (is_bad)
+
+    use radiation_io,     only : nulout
+
+    real(jprb), allocatable, intent(inout) :: var(:)
+    character(len=*),        intent(in) :: var_name
+    real(jprb),              intent(in) :: boundmin, boundmax
+    logical,                 intent(in) :: do_fix
+    integer,       optional, intent(in) :: i1, i2
+
+    logical                       :: is_bad
+
+    real(jprb) :: varmin, varmax
+
+    is_bad = .false.
+
+    if (allocated(var)) then
+
+      if (present(i1) .and. present(i2)) then
+        varmin = minval(var(i1:i2))
+        varmax = maxval(var(i1:i2))
+      else
+        varmin = minval(var)
+        varmax = maxval(var)
+      end if
+
+      if (varmin < boundmin .or. varmax > boundmax) then
+        write(nulout,'(a,a,a,g12.4,a,g12.4,a,g12.4,a,g12.4)',advance='no') &
+             &  '*** Warning: ', var_name, ' range', varmin, ' to', varmax, &
+             &  ' is out of physical range', boundmin, 'to', boundmax
+        is_bad = .true.
+        if (do_fix) then
+          if (present(i1) .and. present(i2)) then
+            var(i1:i2) = max(boundmin, min(boundmax, var(i1:i2)))
+          else
+            var = max(boundmin, min(boundmax, var))
+          end if
+          write(nulout,'(a)') ': corrected'
+        else
+          write(nulout,'(1x)')
+        end if
+      end if
+
+    end if
+    
+  end function out_of_bounds_1d
+
+
+  !---------------------------------------------------------------------
+  ! Return .true. if 2D allocatable array "var" is out of physical
+  ! range specified by boundmin and boundmax, and issue a warning.  To
+  ! check only a subset of the array, specify i1 and i2 for the range
+  ! of the first dimension and j1 and j2 for the range of the second.
+  function out_of_bounds_2d(var, var_name, boundmin, boundmax, do_fix, &
+       &                    i1, i2, j1, j2) result (is_bad)
+
+    use radiation_io,     only : nulout
+
+    real(jprb), allocatable, intent(inout) :: var(:,:)
+    character(len=*),        intent(in) :: var_name
+    real(jprb),              intent(in) :: boundmin, boundmax
+    logical,                 intent(in) :: do_fix
+    integer,       optional, intent(in) :: i1, i2, j1, j2
+
+    ! Local copies of indices
+    integer :: ii1, ii2, jj1, jj2
+
+    logical                       :: is_bad
+
+    real(jprb) :: varmin, varmax
+
+    is_bad = .false.
+
+    if (allocated(var)) then
+
+      if (present(i1) .and. present(i2)) then
+        ii1 = i1
+        ii2 = i2
+      else
+        ii1 = lbound(var,1)
+        ii2 = ubound(var,1)
+      end if
+      if (present(j1) .and. present(j2)) then
+        jj1 = j1
+        jj2 = j2
+      else
+        jj1 = lbound(var,2)
+        jj2 = ubound(var,2)
+      end if
+      varmin = minval(var(ii1:ii2,jj1:jj2))
+      varmax = maxval(var(ii1:ii2,jj1:jj2))
+
+      if (varmin < boundmin .or. varmax > boundmax) then
+        write(nulout,'(a,a,a,g12.4,a,g12.4,a,g12.4,a,g12.4)',advance='no') &
+             &  '*** Warning: ', var_name, ' range', varmin, ' to', varmax,&
+             &  ' is out of physical range', boundmin, 'to', boundmax
+        is_bad = .true.
+        if (do_fix) then
+          var(ii1:ii2,jj1:jj2) = max(boundmin, min(boundmax, var(ii1:ii2,jj1:jj2)))
+          write(nulout,'(a)') ': corrected'
+        else
+          write(nulout,'(1x)')
+        end if
+      end if
+
+    end if
+    
+  end function out_of_bounds_2d
+
+
+  !---------------------------------------------------------------------
+  ! Return .true. if 3D allocatable array "var" is out of physical
+  ! range specified by boundmin and boundmax, and issue a warning.  To
+  ! check only a subset of the array, specify i1 and i2 for the range
+  ! of the first dimension, j1 and j2 for the second and k1 and k2 for
+  ! the third.
+  function out_of_bounds_3d(var, var_name, boundmin, boundmax, do_fix, &
+       &                    i1, i2, j1, j2, k1, k2) result (is_bad)
+
+    use radiation_io,     only : nulout
+
+    real(jprb), allocatable, intent(inout) :: var(:,:,:)
+    character(len=*),        intent(in) :: var_name
+    real(jprb),              intent(in) :: boundmin, boundmax
+    logical,                 intent(in) :: do_fix
+    integer,       optional, intent(in) :: i1, i2, j1, j2, k1, k2
+
+    ! Local copies of indices
+    integer :: ii1, ii2, jj1, jj2, kk1, kk2
+
+    logical                       :: is_bad
+
+    real(jprb) :: varmin, varmax
+
+    is_bad = .false.
+
+    if (allocated(var)) then
+
+      if (present(i1) .and. present(i2)) then
+        ii1 = i1
+        ii2 = i2
+      else
+        ii1 = lbound(var,1)
+        ii2 = ubound(var,1)
+      end if
+      if (present(j1) .and. present(j2)) then
+        jj1 = j1
+        jj2 = j2
+      else
+        jj1 = lbound(var,2)
+        jj2 = ubound(var,2)
+      end if
+      if (present(k1) .and. present(k2)) then
+        kk1 = k1
+        kk2 = k2
+      else
+        kk1 = lbound(var,3)
+        kk2 = ubound(var,3)
+      end if
+      varmin = minval(var(ii1:ii2,jj1:jj2,kk1:kk2))
+      varmax = maxval(var(ii1:ii2,jj1:jj2,kk1:kk2))
+
+      if (varmin < boundmin .or. varmax > boundmax) then
+        write(nulout,'(a,a,a,g12.4,a,g12.4,a,g12.4,a,g12.4)',advance='no') &
+             &  '*** Warning: ', var_name, ' range', varmin, ' to', varmax,&
+             &  ' is out of physical range', boundmin, 'to', boundmax
+        is_bad = .true.
+        if (do_fix) then
+          var(ii1:ii2,jj1:jj2,kk1:kk2) = max(boundmin, min(boundmax, &
+               &                             var(ii1:ii2,jj1:jj2,kk1:kk2)))
+          write(nulout,'(a)') ': corrected'
+        else
+          write(nulout,'(1x)')
+        end if
+      end if
+
+    end if
+    
+  end function out_of_bounds_3d
+
+
+end module radiation_config
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_constants.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_constants.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_constants.F90	(revision 3908)
@@ -0,0 +1,35 @@
+! radiation_constants.F90 - Constants used in radiation calculations
+!
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+
+module radiation_constants
+
+  use parkind1, only : jprb
+!  use yomcst,   only : RPI, RSIGMA, RG, RD, RMV, RMO3, RHPLA
+
+  implicit none
+  public
+
+  ! Rename some constants from their cryptic IFS names
+  real(jprb), parameter :: Pi                 = 3.14159265358979323846_jprb
+  real(jprb), parameter :: AccelDueToGravity  = 9.80665_jprb! m s-2
+  real(jprb), parameter :: StefanBoltzmann    = 5.67037321e-8_jprb ! W m-2 K-4
+  real(jprb), parameter :: DensityLiquidWater = 1000.0_jprb ! kg m-3
+  real(jprb), parameter :: DensitySolidIce    = 916.7_jprb  ! kg m-3
+  real(jprb), parameter :: GasConstantDryAir  = 287.058_jprb! J kg-1 K-1
+  real(jprb), parameter :: PlanckConstant     = 6.6260695729e-34_jprb ! J s
+  real(jprb), parameter :: BoltzmannConstant  = 1.380648813e-23_jprb ! J K-1
+  real(jprb), parameter :: SpeedOfLight       = 299792458.0_jprb ! m s-1
+
+end module radiation_constants
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_delta_eddington.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_delta_eddington.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_delta_eddington.h	(revision 3908)
@@ -0,0 +1,93 @@
+! radiation_delta_eddington.h - Delta-Eddington scaling
+!
+! (C) Copyright 2015- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! This file is intended to be included inside a module to ensure that
+! these simple functions may be inlined
+
+!---------------------------------------------------------------------
+! Perform in-place delta-Eddington scaling of the phase function
+elemental subroutine delta_eddington(od, ssa, g)
+
+  use parkind1, only : jprb
+  
+  ! Total optical depth, single scattering albedo and asymmetry
+  ! factor
+  real(jprb), intent(inout) :: od, ssa, g
+  
+  ! Fraction of the phase function deemed to be in the forward lobe
+  ! and therefore treated as if it is not scattered at all
+  real(jprb) :: f
+  
+  f   = g*g
+  od  = od * (1.0_jprb - ssa*f)
+  ssa = ssa * (1.0_jprb - f) / (1.0_jprb - ssa*f)
+  g   = g / (1.0_jprb + g)
+  
+end subroutine delta_eddington
+
+
+!---------------------------------------------------------------------
+! Perform in-place delta-Eddington scaling of the phase function, but
+! using extensive variables (i.e. the scattering optical depth,
+! scat_od, rather than the single-scattering albedo, and the
+! scattering-optical-depth-multiplied-by-asymmetry-factor, scat_od_g,
+! rather than the asymmetry factor.
+elemental subroutine delta_eddington_extensive(od, scat_od, scat_od_g)
+
+  use parkind1, only : jprb
+
+  ! Total optical depth, scattering optical depth and asymmetry factor
+  ! multiplied by the scattering optical depth
+  real(jprb), intent(inout) :: od, scat_od, scat_od_g
+
+  ! Fraction of the phase function deemed to be in the forward lobe
+  ! and therefore treated as if it is not scattered at all
+  real(jprb) :: f, g
+
+  if (scat_od > 0.0_jprb) then
+    g = scat_od_g / scat_od
+  else
+    g = 0.0
+  end if
+
+  f         = g*g
+  od        = od - scat_od * f
+  scat_od   = scat_od * (1.0_jprb - f)
+  scat_od_g = scat_od * g / (1.0_jprb + g)
+  
+end subroutine delta_eddington_extensive
+
+
+!---------------------------------------------------------------------
+! Perform in-place delta-Eddington scaling of the phase function,
+! using the scattering optical depth rather than the single scattering
+! albedo
+elemental subroutine delta_eddington_scat_od(od, scat_od, g)
+
+  use parkind1, only : jprb
+  
+  ! Total optical depth, scattering optical depth and asymmetry factor
+  real(jprb), intent(inout) :: od, scat_od, g
+
+  ! Fraction of the phase function deemed to be in the forward lobe
+  ! and therefore treated as if it is not scattered at all
+  real(jprb) :: f
+
+  f       = g*g
+  od      = od - scat_od * f
+  scat_od = scat_od * (1.0_jprb - f)
+  g       = g / (1.0_jprb + g)
+
+end subroutine delta_eddington_scat_od
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_flux.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_flux.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_flux.F90	(revision 3908)
@@ -0,0 +1,633 @@
+! radiation_flux.F90 - Derived type to store the output fluxes
+!
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2017-09-08  R. Hogan  Store g-point fluxes
+!   2017-10-23  R. Hogan  Renamed single-character variables
+!   2019-01-08  R. Hogan  Added "indexed_sum_profile"
+!   2019-01-14  R. Hogan  out_of_physical_bounds calls routine in radiation_config
+!   2021-01-20  R. Hogan  Added heating_rate_out_of_physical_bounds function
+
+module radiation_flux
+
+  use parkind1, only : jprb
+
+  implicit none
+  public
+
+  !---------------------------------------------------------------------
+  ! This derived type contains the output from the radiation
+  ! calculation.  Currently this is solely flux profiles, but in
+  ! future surface fluxes in each band may be stored in order that the
+  ! calling program can compute surface-radiation such as
+  ! photosynthetically active radiation and UV index.
+  type flux_type
+     ! All the following are broad-band fluxes in W m-2 with
+     ! dimensions (ncol,nlev+1).  Note that only those fluxes that are
+     ! requested will be used, so clear-sky and direct-beam arrays may
+     ! not be allocated
+     real(jprb), allocatable, dimension(:,:) :: &
+          &  lw_up, lw_dn, &   ! Upwelling and downwelling longwave
+          &  sw_up, sw_dn, &   ! Upwelling and downwelling shortwave
+          &  sw_dn_direct, &   ! Direct-beam shortwave into a horizontal plane
+          &  lw_up_clear, lw_dn_clear, & ! Clear-sky quantities...
+          &  sw_up_clear, sw_dn_clear, &
+          &  sw_dn_direct_clear
+     ! As above but fluxes in each spectral band in W m-2 with
+     ! dimensions (nband,ncol,nlev+1).  These are only allocated if
+     ! config%do_save_spectral_flux==.true.
+     real(jprb), allocatable, dimension(:,:,:) :: &
+          &  lw_up_band, lw_dn_band, &   ! Upwelling and downwelling longwave
+          &  sw_up_band, sw_dn_band, &   ! Upwelling and downwelling shortwave
+          &  sw_dn_direct_band, &        ! Direct-beam shortwave
+          &  lw_up_clear_band, lw_dn_clear_band, & ! Clear-sky quantities...
+          &  sw_up_clear_band, sw_dn_clear_band, &
+          &  sw_dn_direct_clear_band
+     ! Surface downwelling quantaties at each g point, dimensioned
+     ! (ng,ncol), that are always saved by the solver, except for the
+     ! clear-sky ones that are only produced if
+     ! config%do_clear==.true.
+     real(jprb), allocatable, dimension(:,:) :: &
+          &  lw_dn_surf_g, lw_dn_surf_clear_g, &
+          &  sw_dn_diffuse_surf_g, sw_dn_direct_surf_g, &
+          &  sw_dn_diffuse_surf_clear_g, sw_dn_direct_surf_clear_g
+     ! Shortwave downwelling spectral fluxes in W m-2 at the surface,
+     ! from which quantities such as photosynthetically active and UV
+     ! radiation can be computed. Only allocated in
+     ! config%do_surface_sw_spectral_flux==.true.  Note that the
+     ! clear-sky quantities are only computed if
+     ! config%do_clear==.true., but direct fluxes are computed whether
+     ! or not do_direct==.true.. The dimensions are (nband,ncol).
+     real(jprb), allocatable, dimension(:,:) :: &
+          &  sw_dn_surf_band, sw_dn_direct_surf_band, &
+          &  sw_dn_surf_clear_band, sw_dn_direct_surf_clear_band
+     ! Surface downwelling fluxes in W m-2 at the spectral resolution
+     ! needed by any subsequent canopy radiative transfer.  If
+     ! config%use_canopy_full_spectrum_[sw|lw] then these will be at
+     ! g-point resolution; otherwise they will be at
+     ! config%n_albedo_bands and config%n_emiss_bands resolution.
+     real(jprb), allocatable, dimension(:,:) :: &
+          &  lw_dn_surf_canopy, &
+          &  sw_dn_diffuse_surf_canopy, sw_dn_direct_surf_canopy
+
+     ! Diagnosed cloud cover from the short- and long-wave solvers
+     real(jprb), allocatable, dimension(:) :: &
+          &  cloud_cover_lw, cloud_cover_sw
+     ! Longwave derivatives needed by Hogan and Bozzo (2015) method
+     ! for approximate longwave updates in between the full radiation
+     ! calls: rate of change of upwelling broad-band flux with respect
+     ! to surface value, dimensioned (ncol,nlev+1)
+     real(jprb), allocatable, dimension(:,:) :: &
+          &  lw_derivatives
+
+   contains
+     procedure :: allocate   => allocate_flux_type
+     procedure :: deallocate => deallocate_flux_type
+     procedure :: calc_surface_spectral
+     procedure :: out_of_physical_bounds
+     procedure :: heating_rate_out_of_physical_bounds
+  end type flux_type
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Allocate arrays for flux profiles, using config to define which
+  ! fluxes are needed.  The arrays are dimensioned for columns between
+  ! istartcol, iendcol and levels from 1 to nlev+1
+  subroutine allocate_flux_type(this, config, istartcol, iendcol, nlev)
+
+    use yomhook,          only : lhook, dr_hook
+    use radiation_io,     only : nulerr, radiation_abort
+    use radiation_config, only : config_type
+
+    integer, intent(in)             :: istartcol, iendcol, nlev
+    class(flux_type), intent(inout) :: this
+    type(config_type), intent(in)   :: config
+
+    real(jprb)                      :: hook_handle
+
+    if (lhook) call dr_hook('radiation_flux:allocate',0,hook_handle)
+
+    ! Allocate longwave arrays
+    if (config%do_lw) then
+      allocate(this%lw_up(istartcol:iendcol,nlev+1))
+      allocate(this%lw_dn(istartcol:iendcol,nlev+1))
+      if (config%do_clear) then
+        allocate(this%lw_up_clear(istartcol:iendcol,nlev+1))
+        allocate(this%lw_dn_clear(istartcol:iendcol,nlev+1))
+      end if
+      
+      if (config%do_save_spectral_flux) then
+        if (config%n_spec_lw == 0) then
+          write(nulerr,'(a)') '*** Error: number of LW spectral points to save not yet defined ' &
+               & // 'so cannot allocated spectral flux arrays'
+          call radiation_abort()
+        end if
+        
+        allocate(this%lw_up_band(config%n_spec_lw,istartcol:iendcol,nlev+1))
+        allocate(this%lw_dn_band(config%n_spec_lw,istartcol:iendcol,nlev+1))
+        if (config%do_clear) then
+          allocate(this%lw_up_clear_band(config%n_spec_lw, &
+               &                         istartcol:iendcol,nlev+1))
+          allocate(this%lw_dn_clear_band(config%n_spec_lw, &
+               &                         istartcol:iendcol,nlev+1))
+        end if
+      end if
+      
+      if (config%do_lw_derivatives) then
+        allocate(this%lw_derivatives(istartcol:iendcol,nlev+1))
+      end if
+
+      ! Allocate g-point downwelling fluxes at surface passed from
+      ! solver to surface_intermediate%partition
+      allocate(this%lw_dn_surf_g(config%n_g_lw,istartcol:iendcol))
+      if (config%do_clear) then
+        allocate(this%lw_dn_surf_clear_g(config%n_g_lw,istartcol:iendcol))
+      end if
+
+      if (config%do_canopy_fluxes_lw) then
+        ! Downward fluxes at top of canopy at the spectral resolution
+        ! used in the canopy radiative transfer scheme
+        allocate(this%lw_dn_surf_canopy(config%n_canopy_bands_lw,istartcol:iendcol))
+      end if
+    end if
+    
+    ! Allocate shortwave arrays
+    if (config%do_sw) then
+      allocate(this%sw_up(istartcol:iendcol,nlev+1))
+      allocate(this%sw_dn(istartcol:iendcol,nlev+1))
+      if (config%do_sw_direct) then
+        allocate(this%sw_dn_direct(istartcol:iendcol,nlev+1))
+      end if
+      if (config%do_clear) then
+        allocate(this%sw_up_clear(istartcol:iendcol,nlev+1))
+        allocate(this%sw_dn_clear(istartcol:iendcol,nlev+1))
+        if (config%do_sw_direct) then
+          allocate(this%sw_dn_direct_clear(istartcol:iendcol,nlev+1))
+        end if
+      end if
+      
+      if (config%do_save_spectral_flux) then
+        if (config%n_spec_sw == 0) then
+          write(nulerr,'(a)') '*** Error: number of SW spectral points to save not yet defined ' &
+               & // 'so cannot allocate spectral flux arrays'
+          call radiation_abort()
+        end if
+        
+        allocate(this%sw_up_band(config%n_spec_sw,istartcol:iendcol,nlev+1))
+        allocate(this%sw_dn_band(config%n_spec_sw,istartcol:iendcol,nlev+1))
+        
+        if (config%do_sw_direct) then
+          allocate(this%sw_dn_direct_band(config%n_spec_sw, &
+               &                          istartcol:iendcol,nlev+1))
+        end if
+        if (config%do_clear) then
+          allocate(this%sw_up_clear_band(config%n_spec_sw, &
+               &                         istartcol:iendcol,nlev+1))
+          allocate(this%sw_dn_clear_band(config%n_spec_sw, &
+               &                         istartcol:iendcol,nlev+1))
+          if (config%do_sw_direct) then
+            allocate(this%sw_dn_direct_clear_band(config%n_spec_sw, &
+                 &                                istartcol:iendcol, nlev+1))
+          end if
+        end if
+      end if
+      
+      if (config%do_surface_sw_spectral_flux) then
+        if (config%n_bands_sw == 0) then
+          write(nulerr,'(a)') '*** Error: number of SW bands not yet defined ' &
+               & // 'so cannot allocate surface spectral flux arrays'
+          call radiation_abort()
+        end if
+        allocate(this%sw_dn_surf_band(config%n_bands_sw,istartcol:iendcol))
+        allocate(this%sw_dn_direct_surf_band(config%n_bands_sw,istartcol:iendcol))
+        if (config%do_clear) then
+          allocate(this%sw_dn_surf_clear_band(config%n_bands_sw, &
+               &                              istartcol:iendcol))
+          allocate(this%sw_dn_direct_surf_clear_band(config%n_bands_sw, &
+               &                                     istartcol:iendcol))
+        end if
+      end if
+
+      ! Allocate g-point downwelling fluxes at surface passed from
+      ! solver to surface_intermediate%partition
+      allocate(this%sw_dn_diffuse_surf_g(config%n_g_sw,istartcol:iendcol))
+      allocate(this%sw_dn_direct_surf_g (config%n_g_sw,istartcol:iendcol))
+      if (config%do_clear) then
+        allocate(this%sw_dn_diffuse_surf_clear_g(config%n_g_sw,istartcol:iendcol))
+        allocate(this%sw_dn_direct_surf_clear_g (config%n_g_sw,istartcol:iendcol))
+      end if
+
+      if (config%do_canopy_fluxes_sw) then
+        ! Downward fluxes at top of canopy at the spectral resolution
+        ! used in the canopy radiative transfer scheme
+        allocate(this%sw_dn_diffuse_surf_canopy(config%n_canopy_bands_sw,istartcol:iendcol))
+        allocate(this%sw_dn_direct_surf_canopy (config%n_canopy_bands_sw,istartcol:iendcol))
+      end if
+    end if
+    
+    ! Allocate cloud cover arrays
+    allocate(this%cloud_cover_lw(istartcol:iendcol))
+    allocate(this%cloud_cover_sw(istartcol:iendcol))
+
+    ! Some solvers may not write to cloud cover, so we initialize to
+    ! an unphysical value
+    this%cloud_cover_lw = -1.0_jprb
+    this%cloud_cover_sw = -1.0_jprb
+
+    if (lhook) call dr_hook('radiation_flux:allocate',1,hook_handle)
+    
+  end subroutine allocate_flux_type
+
+
+  !---------------------------------------------------------------------
+  ! Deallocate flux arrays
+  subroutine deallocate_flux_type(this)
+
+    use yomhook,          only : lhook, dr_hook
+
+    class(flux_type), intent(inout) :: this
+    real(jprb)                      :: hook_handle
+
+    if (lhook) call dr_hook('radiation_flux:deallocate',0,hook_handle)
+
+    if (allocated(this%lw_up)) then
+      deallocate(this%lw_up)
+      if (allocated(this%lw_dn))       deallocate(this%lw_dn)
+      if (allocated(this%lw_up_clear)) deallocate(this%lw_up_clear)
+      if (allocated(this%lw_dn_clear)) deallocate(this%lw_dn_clear)
+    end if
+
+    if (allocated(this%sw_up)) then
+      deallocate(this%sw_up)
+      if (allocated(this%sw_dn))        deallocate(this%sw_dn)
+      if (allocated(this%sw_up_clear))  deallocate(this%sw_up_clear)
+      if (allocated(this%sw_dn_clear))  deallocate(this%sw_dn_clear)
+      if (allocated(this%sw_dn_direct)) deallocate(this%sw_dn_direct)
+      if (allocated(this%sw_dn_direct_clear)) &
+           &   deallocate(this%sw_dn_direct_clear)
+    end if
+
+    if (allocated(this%lw_up_band)) then
+      deallocate(this%lw_up_band)
+      if (allocated(this%lw_dn_band))       deallocate(this%lw_dn_band)
+      if (allocated(this%lw_up_clear_band)) deallocate(this%lw_up_clear_band)
+      if (allocated(this%lw_dn_clear_band)) deallocate(this%lw_dn_clear_band)
+    end if
+    
+    if (allocated(this%sw_up_band)) then
+      deallocate(this%sw_up_band)
+      if (allocated(this%sw_dn_band))        deallocate(this%sw_dn_band)
+      if (allocated(this%sw_up_clear_band))  deallocate(this%sw_up_clear_band)
+      if (allocated(this%sw_dn_clear_band))  deallocate(this%sw_dn_clear_band)
+      if (allocated(this%sw_dn_direct_band)) deallocate(this%sw_dn_direct_band)
+      if (allocated(this%sw_dn_direct_clear_band)) &
+           &   deallocate(this%sw_dn_direct_clear_band)      
+    end if
+
+    if (allocated(this%sw_dn_surf_band)) then
+      deallocate(this%sw_dn_surf_band)
+      deallocate(this%sw_dn_direct_surf_band)
+    end if
+    if (allocated(this%sw_dn_surf_clear_band)) then
+      deallocate(this%sw_dn_surf_clear_band)
+      deallocate(this%sw_dn_direct_surf_clear_band)
+    end if
+
+    if (allocated(this%lw_dn_surf_canopy)) deallocate(this%lw_dn_surf_canopy)
+    if (allocated(this%sw_dn_diffuse_surf_canopy)) deallocate(this%sw_dn_diffuse_surf_canopy)
+    if (allocated(this%sw_dn_direct_surf_canopy)) deallocate(this%sw_dn_direct_surf_canopy)
+
+    if (allocated(this%cloud_cover_sw)) then
+      deallocate(this%cloud_cover_sw)
+    end if
+    if (allocated(this%cloud_cover_lw)) then
+      deallocate(this%cloud_cover_lw)
+    end if
+
+    if (allocated(this%lw_derivatives)) then
+      deallocate(this%lw_derivatives)
+    end if
+
+    if (lhook) call dr_hook('radiation_flux:deallocate',1,hook_handle)
+
+  end subroutine deallocate_flux_type
+
+  !---------------------------------------------------------------------
+  ! Calculate surface downwelling fluxes in each band using the
+  ! downwelling surface fluxes at each g point
+  subroutine calc_surface_spectral(this, config, istartcol, iendcol)
+
+    use yomhook,          only : lhook, dr_hook
+    use radiation_config, only : config_type
+
+    class(flux_type),  intent(inout) :: this
+    type(config_type), intent(in)    :: config
+    integer,           intent(in)    :: istartcol, iendcol
+
+    integer :: jcol, jband, jalbedoband, nalbedoband
+
+    ! Longwave surface downwelling in each band needed to compute
+    ! canopy fluxes
+    real(jprb) :: lw_dn_surf_band(config%n_bands_lw,istartcol:iendcol)
+
+    real(jprb)                       :: hook_handle
+
+    if (lhook) call dr_hook('radiation_flux:calc_surface_spectral',0,hook_handle)
+
+    if (config%do_sw .and. config%do_surface_sw_spectral_flux) then
+
+      do jcol = istartcol,iendcol
+        call indexed_sum(this%sw_dn_direct_surf_g(:,jcol), &
+             &           config%i_band_from_reordered_g_sw, &
+             &           this%sw_dn_direct_surf_band(:,jcol))
+        call indexed_sum(this%sw_dn_diffuse_surf_g(:,jcol), &
+             &           config%i_band_from_reordered_g_sw, &
+             &           this%sw_dn_surf_band(:,jcol))
+        this%sw_dn_surf_band(:,jcol) &
+             &  = this%sw_dn_surf_band(:,jcol) &
+             &  + this%sw_dn_direct_surf_band(:,jcol)
+      end do
+
+      if (config%do_clear) then
+        do jcol = istartcol,iendcol
+          call indexed_sum(this%sw_dn_direct_surf_clear_g(:,jcol), &
+               &           config%i_band_from_reordered_g_sw, &
+               &           this%sw_dn_direct_surf_clear_band(:,jcol))
+          call indexed_sum(this%sw_dn_diffuse_surf_clear_g(:,jcol), &
+               &           config%i_band_from_reordered_g_sw, &
+               &           this%sw_dn_surf_clear_band(:,jcol))
+          this%sw_dn_surf_clear_band(:,jcol) &
+               &  = this%sw_dn_surf_clear_band(:,jcol) &
+               &  + this%sw_dn_direct_surf_clear_band(:,jcol)
+        end do
+      end if
+
+    end if ! do_surface_sw_spectral_flux
+
+    ! Fluxes in bands required for canopy radiative transfer
+    if (config%do_sw .and. config%do_canopy_fluxes_sw) then
+      if (config%use_canopy_full_spectrum_sw) then
+        this%sw_dn_diffuse_surf_canopy(:,istartcol:iendcol) = this%sw_dn_diffuse_surf_g(:,istartcol:iendcol)
+        this%sw_dn_direct_surf_canopy (:,istartcol:iendcol) = this%sw_dn_direct_surf_g (:,istartcol:iendcol)
+      else if (config%do_nearest_spectral_sw_albedo) then
+        do jcol = istartcol,iendcol
+          call indexed_sum(this%sw_dn_direct_surf_g(:,jcol), &
+               &           config%i_albedo_from_band_sw(config%i_band_from_reordered_g_sw), &
+               &           this%sw_dn_direct_surf_canopy(:,jcol))
+          call indexed_sum(this%sw_dn_diffuse_surf_g(:,jcol), &
+               &           config%i_albedo_from_band_sw(config%i_band_from_reordered_g_sw), &
+               &           this%sw_dn_diffuse_surf_canopy(:,jcol))
+        end do
+      else
+        ! More accurate calculations using weights, but requires
+        ! this%sw_dn_[direct_]surf_band to be defined, i.e.
+        ! config%do_surface_sw_spectral_flux == .true.
+        nalbedoband = size(config%sw_albedo_weights,1)
+        this%sw_dn_diffuse_surf_canopy(:,istartcol:iendcol) = 0.0_jprb
+        this%sw_dn_direct_surf_canopy (:,istartcol:iendcol) = 0.0_jprb
+        do jband = 1,config%n_bands_sw
+          do jalbedoband = 1,nalbedoband
+            if (config%sw_albedo_weights(jalbedoband,jband) /= 0.0_jprb) then
+              ! Initially, "diffuse" is actually "total"
+              this%sw_dn_diffuse_surf_canopy(jalbedoband,istartcol:iendcol) &
+                   &  = this%sw_dn_diffuse_surf_canopy(jalbedoband,istartcol:iendcol) &
+                   &  + config%sw_albedo_weights(jalbedoband,jband) &
+                   &    * this%sw_dn_surf_band(jband,istartcol:iendcol)
+              this%sw_dn_direct_surf_canopy(jalbedoband,istartcol:iendcol) &
+                   &  = this%sw_dn_direct_surf_canopy(jalbedoband,istartcol:iendcol) &
+                   &  + config%sw_albedo_weights(jalbedoband,jband) &
+                   &    * this%sw_dn_direct_surf_band(jband,istartcol:iendcol)
+            end if
+          end do
+        end do
+        ! Subtract the direct from total to get diffuse
+        this%sw_dn_diffuse_surf_canopy(:,istartcol:iendcol) &
+             &  = this%sw_dn_diffuse_surf_canopy(:,istartcol:iendcol) &
+             &  - this%sw_dn_direct_surf_canopy(:,istartcol:iendcol)
+      end if
+
+    end if ! do_canopy_fluxes_sw
+
+    if (config%do_lw .and. config%do_canopy_fluxes_lw) then
+      if (config%use_canopy_full_spectrum_lw) then
+        this%lw_dn_surf_canopy(:,istartcol:iendcol) = this%lw_dn_surf_g(:,istartcol:iendcol)
+      else if (config%do_nearest_spectral_lw_emiss) then
+        do jcol = istartcol,iendcol
+          call indexed_sum(this%lw_dn_surf_g(:,jcol), &
+               &           config%i_emiss_from_band_lw(config%i_band_from_reordered_g_lw), &
+               &           this%lw_dn_surf_canopy(:,jcol))
+        end do
+      else
+        ! Compute fluxes in each longwave emissivity interval using
+        ! weights; first sum over g points to get the values in bands
+        do jcol = istartcol,iendcol
+          call indexed_sum(this%lw_dn_surf_g(:,jcol), &
+               &           config%i_band_from_reordered_g_lw, &
+               &           lw_dn_surf_band(:,jcol))
+        end do
+        nalbedoband = size(config%lw_emiss_weights,1)
+        this%lw_dn_surf_canopy(:,istartcol:iendcol) = 0.0_jprb
+        do jband = 1,config%n_bands_lw
+          do jalbedoband = 1,nalbedoband
+            if (config%lw_emiss_weights(jalbedoband,jband) /= 0.0_jprb) then
+              this%lw_dn_surf_canopy(jalbedoband,istartcol:iendcol) &
+                   &  = this%lw_dn_surf_canopy(jalbedoband,istartcol:iendcol) &
+                   &  + config%lw_emiss_weights(jalbedoband,jband) &
+                   &    * lw_dn_surf_band(jband,istartcol:iendcol)
+            end if
+          end do
+        end do
+      end if
+    end if
+
+    if (lhook) call dr_hook('radiation_flux:calc_surface_spectral',1,hook_handle)
+
+  end subroutine calc_surface_spectral
+
+
+  !---------------------------------------------------------------------
+  ! Return .true. if the most important flux variables are out of a
+  ! physically sensible range, optionally only considering columns
+  ! between istartcol and iendcol
+  function out_of_physical_bounds(this, istartcol, iendcol) result(is_bad)
+
+    use yomhook,          only : lhook, dr_hook
+    use radiation_config, only : out_of_bounds_2d
+
+    class(flux_type), intent(inout) :: this
+    integer, optional,intent(in) :: istartcol, iendcol
+    logical                      :: is_bad
+
+    real(jprb)                   :: hook_handle
+
+    if (lhook) call dr_hook('radiation_flux:out_of_physical_bounds',0,hook_handle)
+
+    is_bad =    out_of_bounds_2d(this%lw_up, 'lw_up', 10.0_jprb, 900.0_jprb, .false., i1=istartcol, i2=iendcol) &
+         & .or. out_of_bounds_2d(this%lw_dn, 'lw_dn', 0.0_jprb,  800.0_jprb, .false., i1=istartcol, i2=iendcol) &
+         & .or. out_of_bounds_2d(this%sw_up, 'sw_up', 0.0_jprb, 1500.0_jprb, .false., i1=istartcol, i2=iendcol) &
+         & .or. out_of_bounds_2d(this%sw_dn, 'sw_dn', 0.0_jprb, 1500.0_jprb, .false., i1=istartcol, i2=iendcol) &
+         & .or. out_of_bounds_2d(this%sw_dn_direct, 'sw_dn_direct', 0.0_jprb, 1500.0_jprb, .false., i1=istartcol, i2=iendcol) &
+         & .or. out_of_bounds_2d(this%lw_derivatives, 'lw_derivatives', 0.0_jprb, 1.0_jprb, .false., i1=istartcol, i2=iendcol) &
+         & .or. out_of_bounds_2d(this%sw_dn_surf_band, 'sw_dn_surf_band', 0.0_jprb, 1500.0_jprb, &
+         &                       .false., j1=istartcol, j2=iendcol) &
+         & .or. out_of_bounds_2d(this%sw_dn_surf_clear_band, 'sw_dn_surf_clear_band', 0.0_jprb, 1500.0_jprb, &
+         &                       .false., j1=istartcol, j2=iendcol)
+
+    if (lhook) call dr_hook('radiation_flux:out_of_physical_bounds',1,hook_handle)
+
+  end function out_of_physical_bounds
+  
+  !---------------------------------------------------------------------
+  ! Return .true. if the heating rates are out of a physically
+  ! sensible range, optionally only considering columns between
+  ! istartcol and iendcol. This function allocates and deallocates
+  ! memory due to the requirements for inputs of out_of_bounds_2d.
+  function heating_rate_out_of_physical_bounds(this, nlev, istartcol, iendcol, pressure_hl) result(is_bad)
+    
+    use radiation_config, only : out_of_bounds_2d
+    use radiation_constants, only : AccelDueToGravity
+
+    ! "Cp" (J kg-1 K-1)
+    real(jprb), parameter :: SpecificHeatDryAir = 1004.0
+
+    class(flux_type), intent(inout) :: this
+    integer, intent(in) :: istartcol, iendcol, nlev
+    logical                      :: is_bad
+    
+    real(jprb), intent(in) :: pressure_hl(:,:)
+
+    real(jprb), allocatable :: hr_K_day(:,:)
+
+    real(jprb) :: scaling(istartcol:iendcol,nlev)
+    
+    allocate(hr_K_day(istartcol:iendcol,nlev))
+
+    scaling = -(24.0_jprb * 3600.0_jprb * AccelDueToGravity / SpecificHeatDryAir) &
+         &  / (pressure_hl(istartcol:iendcol,2:nlev+1) - pressure_hl(istartcol:iendcol,1:nlev))
+    ! Shortwave
+    hr_K_day = scaling * (this%sw_dn(istartcol:iendcol,2:nlev+1) - this%sw_up(istartcol:iendcol,2:nlev+1) &
+         &               -this%sw_dn(istartcol:iendcol,1:nlev)   + this%sw_up(istartcol:iendcol,1:nlev))
+    is_bad = out_of_bounds_2d(hr_K_day, 'sw_heating_rate_K_day', 0.0_jprb, 200.0_jprb, &
+         &                    .false., i1=istartcol, i2=iendcol)
+
+    ! Longwave
+    hr_K_day = scaling * (this%lw_dn(istartcol:iendcol,2:nlev+1) - this%lw_up(istartcol:iendcol,2:nlev+1) &
+         &               -this%lw_dn(istartcol:iendcol,1:nlev)   + this%lw_up(istartcol:iendcol,1:nlev))
+    is_bad = is_bad .or. out_of_bounds_2d(hr_K_day, 'lw_heating_rate_K_day', -250.0_jprb, 150.0_jprb, &
+         &                                .false., i1=istartcol, i2=iendcol)
+
+    deallocate(hr_K_day)
+
+  end function heating_rate_out_of_physical_bounds
+
+
+  !---------------------------------------------------------------------
+  ! Sum elements of "source" into "dest" according to index "ind".
+  ! "source" and "ind" should have the same size and bounds, and no
+  ! element of "ind" should refer outside the bounds of "dest".  This
+  ! version increments existing contents of "dest".
+  pure subroutine add_indexed_sum(source, ind, dest)
+
+    real(jprb), intent(in)    :: source(:)
+    integer,    intent(in)    :: ind(:)
+    real(jprb), intent(inout) :: dest(:)
+
+    integer :: ig, jg, istart, iend
+
+    istart = lbound(source,1)
+    iend   = ubound(source,1)
+
+    do jg = istart, iend
+      ig = ind(jg)
+      dest(ig) = dest(ig) + source(jg)
+    end do
+
+  end subroutine add_indexed_sum
+
+
+  !---------------------------------------------------------------------
+  ! As "add_indexed_sum" but this version overwrites existing contents
+  ! of "dest"
+  pure subroutine indexed_sum(source, ind, dest)
+
+    real(jprb), intent(in)  :: source(:)
+    integer,    intent(in)  :: ind(:)
+    real(jprb), intent(out) :: dest(:)
+
+    integer :: ig, jg, istart, iend
+
+    dest = 0.0
+
+    istart = lbound(source,1)
+    iend   = ubound(source,1)
+
+    do jg = istart, iend
+      ig = ind(jg)
+      dest(ig) = dest(ig) + source(jg)
+    end do
+
+  end subroutine indexed_sum
+
+
+  !---------------------------------------------------------------------
+  ! As "add_indexed_sum" but a whole vertical profiles
+  pure subroutine add_indexed_sum_profile(source, ind, dest)
+
+    real(jprb), intent(in)  :: source(:,:)
+    integer,    intent(in)  :: ind(:)
+    real(jprb), intent(out) :: dest(:,:)
+
+    integer :: ig, jg, istart, iend, jlev, nlev
+
+    istart = lbound(source,1)
+    iend   = ubound(source,1)
+    nlev   = size(source,2)
+
+    do jlev = 1,nlev
+      do jg = istart, iend
+        ig = ind(jg)
+        dest(ig,jlev) = dest(ig,jlev) + source(jg,jlev)
+      end do
+    end do
+
+  end subroutine add_indexed_sum_profile
+
+
+  !---------------------------------------------------------------------
+  ! As "indexed_sum" but a whole vertical profiles
+  pure subroutine indexed_sum_profile(source, ind, dest)
+
+    real(jprb), intent(in)  :: source(:,:)
+    integer,    intent(in)  :: ind(:)
+    real(jprb), intent(out) :: dest(:,:)
+
+    integer :: ig, jg, istart, iend, jlev, nlev
+
+    dest = 0.0
+
+    istart = lbound(source,1)
+    iend   = ubound(source,1)
+    nlev   = size(source,2)
+
+    do jlev = 1,nlev
+      do jg = istart, iend
+        ig = ind(jg)
+        dest(ig,jlev) = dest(ig,jlev) + source(jg,jlev)
+      end do
+    end do
+
+  end subroutine indexed_sum_profile
+  
+end module radiation_flux
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_gas.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_gas.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_gas.F90	(revision 3908)
@@ -0,0 +1,619 @@
+! radiation_gas.F90 - Derived type to store the gas mixing ratios
+!
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2019-01-14  R. Hogan  Added out_of_physical_bounds routine
+
+module radiation_gas
+
+  use parkind1, only : jprb
+
+  implicit none
+  public
+
+  ! Gas codes; these indices match those of RRTM-LW up to 7
+  integer, parameter :: IGasNotPresent = 0
+  integer, parameter :: IH2O   = 1
+  integer, parameter :: ICO2   = 2
+  integer, parameter :: IO3    = 3
+  integer, parameter :: IN2O   = 4
+  integer, parameter :: ICO    = 5
+  integer, parameter :: ICH4   = 6
+  integer, parameter :: IO2    = 7
+  integer, parameter :: ICFC11 = 8
+  integer, parameter :: ICFC12 = 9
+  integer, parameter :: IHCFC22= 10
+  integer, parameter :: ICCl4  = 11 
+  integer, parameter :: INO2   = 12
+  integer, parameter :: NMaxGases = 12
+
+  ! Molar masses (g mol-1) of dry air and the various gases above
+  real(jprb), parameter :: IAirMolarMass = 28.970
+  real(jprb), parameter, dimension(0:NMaxGases) :: IGasMolarMass = (/ &
+       & 0.0_jprb,        & ! Gas not present
+       & 18.0152833_jprb, & ! H2O
+       & 44.011_jprb,     & ! CO2
+       & 47.9982_jprb,    & ! O3
+       & 44.013_jprb,     & ! N2O
+       & 28.0101_jprb,    & ! CO
+       & 16.043_jprb,     & ! CH4
+       & 31.9988_jprb,    & ! O2
+       & 137.3686_jprb,   & ! CFC11
+       & 120.914_jprb,    & ! CFC12
+       & 86.469_jprb,     & ! HCFC22
+       & 153.823_jprb,    & ! CCl4    
+       & 46.0055_jprb /)    ! NO2
+
+  ! The corresponding names of the gases in upper and lower case, used
+  ! for reading variables from the input file
+  character*6, dimension(NMaxGases), parameter :: GasName &
+       &  = (/'H2O   ','CO2   ','O3    ','N2O   ','CO    ','CH4   ', &
+       &      'O2    ','CFC11 ','CFC12 ','HCFC22','CCl4  ','NO2   '/)
+  character*6, dimension(NMaxGases), parameter :: GasLowerCaseName &
+       &  = (/'h2o   ','co2   ','o3    ','n2o   ','co    ','ch4   ', &
+       &      'o2    ','cfc11 ','cfc12 ','hcfc22','ccl4  ','no2   '/)
+
+  ! Available units
+  enum, bind(c)
+    enumerator IMassMixingRatio, IVolumeMixingRatio
+  end enum
+
+  !---------------------------------------------------------------------
+  ! This derived type describes the gaseous composition of the
+  ! atmosphere; gases may be stored as part of a 3D array (if their
+  ! variation with height/column is to be represented) or one 1D array
+  ! (if they are to be assumed globally well-mixed).
+  type gas_type
+    ! Units of each stored gas (or 0 if not present)
+    integer :: iunits(NMaxGases) = 0
+
+    ! Scaling factor that should be applied to each stored gas to get
+    ! a dimensionless result, e.g. if iunits=IVolumeMixingRatio then
+    ! 1.0e-6 is used to indicate the units are actually PPMV: need to
+    ! multiply by 1e-6 to get mol/mol.
+    real(jprb) :: scale_factor(NMaxGases) = 1.0_jprb
+    
+    ! Mixing ratios of variable gases, dimensioned (ncol, nlev,
+    ! NMaxGases)
+    real(jprb), allocatable, dimension(:,:,:) :: mixing_ratio
+
+    ! Flag to indicate whether a gas is present
+    logical :: is_present(NMaxGases) = .false.
+
+    ! Flag to indicate whether a gas is well mixed
+    logical :: is_well_mixed(NMaxGases) = .false.
+
+    integer :: ntype          = 0 ! Number of gas types described
+
+    integer :: ncol           = 0 ! Number of columns in mixing_ratio
+    integer :: nlev           = 0 ! Number of levels  in mixing_ratio
+
+    ! A list of length ntype of gases whose volume mixing ratios have
+    ! been provided
+    integer :: icode(NMaxGases) = 0
+    
+   contains
+     procedure :: allocate   => allocate_gas
+     procedure :: deallocate => deallocate_gas
+     procedure :: put        => put_gas
+     procedure :: put_well_mixed => put_well_mixed_gas
+     procedure :: scale      => scale_gas
+     procedure :: set_units  => set_units_gas
+     procedure :: assert_units => assert_units_gas
+     procedure :: get        => get_gas
+     procedure :: reverse    => reverse_gas
+     procedure :: out_of_physical_bounds
+  end type gas_type
+
+contains
+
+
+  !---------------------------------------------------------------------
+  subroutine allocate_gas(this, ncol, nlev)
+
+    use yomhook, only : lhook, dr_hook
+
+    class(gas_type), intent(inout) :: this
+    integer,         intent(in)    :: ncol, nlev
+
+    real(jprb)          :: hook_handle
+
+    if (lhook) call dr_hook('radiation_gas:allocate',0,hook_handle)
+
+    call this%deallocate()
+
+    allocate(this%mixing_ratio(ncol, nlev, NMaxGases))
+    this%mixing_ratio = 0.0_jprb
+
+    this%ncol = ncol
+    this%nlev = nlev
+
+    if (lhook) call dr_hook('radiation_gas:allocate',1,hook_handle)
+
+  end subroutine allocate_gas
+
+
+  !---------------------------------------------------------------------
+  ! Deallocate memory and reset arrays
+  subroutine deallocate_gas(this)
+
+    use yomhook, only : lhook, dr_hook
+
+    class(gas_type), intent(inout) :: this
+
+    real(jprb)          :: hook_handle
+
+    if (lhook) call dr_hook('radiation_gas:deallocate',0,hook_handle)
+
+    if (allocated(this%mixing_ratio)) then
+       deallocate(this%mixing_ratio)
+    end if
+    
+    this%iunits = 0
+    this%scale_factor = 0.0_jprb
+    this%is_present = .false.
+    this%is_well_mixed = .false.
+    this%ntype = 0
+    this%ncol = 0
+    this%nlev = 0
+    this%icode = 0
+
+    if (lhook) call dr_hook('radiation_gas:deallocate',1,hook_handle)
+
+  end subroutine deallocate_gas
+
+
+  !---------------------------------------------------------------------
+  ! Put gas mixing ratio corresponding to gas ID "igas" with units
+  ! "iunits"
+  subroutine put_gas(this, igas, iunits, mixing_ratio, scale_factor, &
+       istartcol)
+
+    use yomhook,        only : lhook, dr_hook
+    use radiation_io,   only : nulerr, radiation_abort
+
+    class(gas_type),      intent(inout) :: this
+    integer,              intent(in)    :: igas
+    integer,              intent(in)    :: iunits
+    real(jprb),           intent(in)    :: mixing_ratio(:,:)
+    real(jprb), optional, intent(in)    :: scale_factor
+    integer,    optional, intent(in)    :: istartcol
+
+    integer :: i1, i2
+
+    real(jprb)                          :: hook_handle
+
+    if (lhook) call dr_hook('radiation_gas:put',0,hook_handle)
+
+    ! Check inputs
+    if (igas <= IGasNotPresent .or. iunits > NMaxGases) then
+      write(nulerr,'(a,i0,a,i0,a,i0)') '*** Error: provided gas ID (', &
+           &   igas, ') must be in the range ', IGasNotPresent+1, ' to ', &
+           &   NMaxGases
+      call radiation_abort()
+    end if
+    if (iunits < IMassMixingRatio .or. iunits > IVolumeMixingRatio) then
+      write(nulerr,'(a,i0,a,i0,a,i0)') '*** Error: provided gas units (', &
+           &   iunits, ') must be in the range ', IMassMixingRatio, ' to ', &
+           &   IVolumeMixingRatio
+      call radiation_abort()
+    end if
+
+    if (.not. allocated(this%mixing_ratio)) then
+      write(nulerr,'(a,i0,a,i0,a,i0)') '*** Error: attempt to put data to unallocated radiation_gas object'
+      call radiation_abort()
+    end if
+
+    if (present(istartcol)) then
+      i1 = istartcol
+    else
+      i1 = 1
+    end if
+
+    i2 = i1 + size(mixing_ratio,1) - 1
+
+    if (i1 < 1 .or. i2 < 1 .or. i1 > this%ncol .or. i2 > this%ncol) then
+      write(nulerr,'(a,i0,a,i0,a,i0)') '*** Error: attempt to put columns indexed ', &
+           &   i1, ' to ', i2, ' to array indexed 1 to ', this%ncol
+      call radiation_abort()
+    end if
+
+    if (size(mixing_ratio,2) /= this%nlev) then
+      write(nulerr,'(a,i0,a)') &
+           &  '*** Error: gas mixing ratio expected to have ', this%nlev, &
+           &  ' levels'
+      call radiation_abort()
+    end if
+
+    if (.not. this%is_present(igas)) then
+      ! Gas not present until now
+      this%ntype = this%ntype + 1
+      this%icode(this%ntype) = igas
+    end if
+    this%is_present(igas) = .true.
+    this%iunits(igas) = iunits
+    this%is_well_mixed(igas) = .false.
+    this%mixing_ratio(i1:i2,:,igas) = mixing_ratio
+
+    if (present(scale_factor)) then
+      this%scale_factor(igas) = scale_factor
+    else
+      this%scale_factor(igas) = 1.0_jprb
+    end if
+
+    if (lhook) call dr_hook('radiation_gas:put',1,hook_handle)
+
+  end subroutine put_gas
+
+
+  !---------------------------------------------------------------------
+  ! Put well-mixed gas mixing ratio corresponding to gas ID "igas"
+  ! with units "iunits"
+  subroutine put_well_mixed_gas(this, igas, iunits, mixing_ratio, &
+       scale_factor, istartcol, iendcol)
+
+    use yomhook,        only : lhook, dr_hook
+    use radiation_io,   only : nulerr, radiation_abort
+
+    class(gas_type),      intent(inout) :: this
+    integer,              intent(in)    :: igas
+    integer,              intent(in)    :: iunits
+    real(jprb),           intent(in)    :: mixing_ratio
+    real(jprb), optional, intent(in)    :: scale_factor
+    integer,    optional, intent(in)    :: istartcol, iendcol
+
+    real(jprb)                          :: hook_handle
+
+    integer :: i1, i2
+
+    if (lhook) call dr_hook('radiation_gas:put_well_mixed',0,hook_handle)
+
+    ! Check inputs
+    if (igas <= IGasNotPresent .or. igas > NMaxGases) then
+      write(nulerr,'(a,i0,a,i0,a,i0)') '*** Error: provided gas ID (', &
+           &   igas, ') must be in the range ', IGasNotPresent+1, ' to ', &
+           &   NMaxGases
+      call radiation_abort()
+    end if
+    if (iunits < IMassMixingRatio .or. iunits > IVolumeMixingRatio) then
+      write(nulerr,'(a,i0,a,i0,a,i0)') '*** Error: provided gas units (', &
+           &   iunits, ') must be in the range ', IMassMixingRatio, ' to ', &
+           &   IVolumeMixingRatio
+      call radiation_abort()
+    end if
+
+    if (.not. allocated(this%mixing_ratio)) then
+      write(nulerr,'(a)') '*** Error: attempt to put well-mixed gas data to unallocated radiation_gas object'
+      call radiation_abort()
+    end if
+
+    if (present(istartcol)) then
+      i1 = istartcol
+    else
+      i1 = 1
+    end if
+
+    if (present(iendcol)) then
+      i2 = iendcol
+    else
+      i2 = this%ncol
+    end if
+
+    if (i1 < 1 .or. i2 < 1 .or. i1 > this%ncol .or. i2 > this%ncol) then
+      write(nulerr,'(a,i0,a,i0,a,i0)') '*** Error: attempt to put columns indexed ', &
+           &   i1, ' to ', i2, ' to array indexed 1 to ', this%ncol
+      call radiation_abort()
+    end if
+
+    if (.not. this%is_present(igas)) then
+      ! Gas not present until now
+      this%ntype = this%ntype + 1
+      this%icode(this%ntype) = igas
+    end if
+    ! Map uses a negative value to indicate a well-mixed value
+    this%is_present(igas)              = .true.
+    this%iunits(igas)                  = iunits
+    this%is_well_mixed(igas)           = .true.
+    this%mixing_ratio(i1:i2,:,igas)    = mixing_ratio
+
+    if (present(scale_factor)) then
+      this%scale_factor(igas) = scale_factor
+    else
+      this%scale_factor(igas) = 1.0_jprb
+    end if
+
+    if (lhook) call dr_hook('radiation_gas:put_well_mixed',1,hook_handle)
+
+  end subroutine put_well_mixed_gas
+
+
+  !---------------------------------------------------------------------
+  ! Scale gas concentrations, e.g. igas=ICO2 and set scale_factor=2 to
+  ! double CO2.  Note that this does not perform the scaling
+  ! immediately, but changes the scale factor for the specified gas,
+  ! ready to be used in set_units_gas.
+
+  subroutine scale_gas(this, igas, scale_factor, lverbose)
+
+    use radiation_io, only : nulout
+
+    class(gas_type),      intent(inout) :: this
+    integer,              intent(in)    :: igas
+    real(jprb),           intent(in)    :: scale_factor
+    logical,    optional, intent(in)    :: lverbose
+
+    if (scale_factor /= 1.0_jprb) then
+      this%scale_factor(igas) = this%scale_factor(igas) * scale_factor
+      if (present(lverbose)) then
+        if (lverbose) then
+          write(nulout,'(a,a,a,f0.3)') '  Scaling ', trim(GasName(igas)), &
+               &  ' concentration by ', scale_factor
+        end if
+      end if
+    end if
+
+  end subroutine scale_gas
+
+
+  !---------------------------------------------------------------------
+  ! Scale the gas concentrations so that they have the units "iunits"
+  ! and are therefore ready to be used by the gas optics model within
+  ! ecRad with no further scaling.  The existing scale_factor for each
+  ! gas is applied.  If "igas" is present then apply only to gas with
+  ! ID "igas", otherwise to all gases. Optional argument scale_factor
+  ! specifies scaling that any subsequent access would need to apply
+  ! to get a dimensionless result (consistent with definition of
+  ! gas_type). So say that your gas optics model requires gas
+  ! concentrations in PPMV, specify iunits=IVolumeMixingRatio and
+  ! scale_factor=1.0e-6. If the gas concentrations were currently
+  ! dimensionless volume mixing ratios, then the values would be
+  ! internally divided by 1.0e-6.
+  recursive subroutine set_units_gas(this, iunits, igas, scale_factor)
+    class(gas_type),      intent(inout) :: this
+    integer,              intent(in)    :: iunits
+    integer,    optional, intent(in)    :: igas
+    real(jprb), optional, intent(in)    :: scale_factor    
+
+    integer :: ig
+
+    ! Scaling factor to convert from old to new
+    real(jprb) :: sf
+
+    ! New scaling factor to store inside the gas object
+    real(jprb) :: new_sf
+
+    if (present(scale_factor)) then
+      ! "sf" is the scaling to be applied now to the numbers (and may
+      ! be modified below), "new_sf" is the value to be stored along
+      ! with the numbers, informing subsequent routines how much you
+      ! would need to multiply the numbers by to get a dimensionless
+      ! result.
+      sf     = 1.0_jprb / scale_factor
+      new_sf = scale_factor
+    else
+      sf     = 1.0_jprb
+      new_sf = 1.0_jprb
+    end if
+
+    if (present(igas)) then
+      if (this%is_present(igas)) then
+        if (iunits == IMassMixingRatio &
+             &   .and. this%iunits(igas) == IVolumeMixingRatio) then
+          sf = sf * IGasMolarMass(igas) / IAirMolarMass
+        else if (iunits == IVolumeMixingRatio &
+             &   .and. this%iunits(igas) == IMassMixingRatio) then
+          sf = sf * IAirMolarMass / IGasMolarMass(igas)
+        end if
+        sf = sf * this%scale_factor(igas)
+        
+        if (sf /= 1.0_jprb) then
+          this%mixing_ratio(:,:,igas) = this%mixing_ratio(:,:,igas) * sf
+        end if
+        ! Store the new units and scale factor for this gas inside the
+        ! gas object
+        this%iunits(igas) = iunits
+        this%scale_factor(igas) = new_sf
+      end if
+    else
+      do ig = 1,this%ntype
+        call this%set_units(iunits, igas=this%icode(ig), scale_factor=new_sf)
+      end do
+    end if
+
+  end subroutine set_units_gas
+
+
+  !---------------------------------------------------------------------
+  ! Assert that gas mixing ratio units are "iunits", applying to gas
+  ! with ID "igas" if present, otherwise to all gases. Otherwise the
+  ! program will exit. Otional argument scale factor specifies any
+  ! subsequent multiplication to apply; for PPMV one would use
+  ! iunits=IVolumeMixingRatio and scale_factor=1.0e6.
+  recursive subroutine assert_units_gas(this, iunits, igas, scale_factor)
+    
+    use radiation_io,   only : nulerr, radiation_abort    
+
+    class(gas_type),      intent(in) :: this
+    integer,              intent(in) :: iunits
+    integer,    optional, intent(in) :: igas
+    real(jprb), optional, intent(in) :: scale_factor    
+
+    integer :: ig
+
+    real(jprb) :: sf
+
+    if (present(scale_factor)) then
+      sf = scale_factor
+    else
+      sf = 1.0_jprb
+    end if
+
+    if (present(igas)) then
+      if (this%is_present(igas)) then
+        if (iunits /= this%iunits(igas)) then
+          write(nulerr,'(a,a,a)') '*** Error: ', trim(GasName(igas)), &
+               &  ' is not in the required units'
+          call radiation_abort()
+        else if (sf /= this%scale_factor(igas)) then
+          write(nulerr,'(a,a,a,e12.4,a,e12.4)') '*** Error: ', GasName(igas), &
+               &  ' scaling of ', this%scale_factor(igas), &
+               &  ' does not match required ', sf
+          call radiation_abort()
+        end if
+      end if
+    else
+      do ig = 1,this%ntype
+        call this%assert_units(iunits, igas=this%icode(ig), scale_factor=sf)
+      end do
+    end if
+
+  end subroutine assert_units_gas
+
+
+  !---------------------------------------------------------------------
+  ! Get gas mixing ratio corresponding to gas ID "igas" with units
+  ! "iunits" and return as a 2D array of dimensions (ncol,nlev).  The
+  ! array will contain zeros if the gas is not stored.
+  subroutine get_gas(this, igas, iunits, mixing_ratio, scale_factor, &
+       &   istartcol)
+
+    use yomhook,        only : lhook, dr_hook
+    use radiation_io,   only : nulerr, radiation_abort
+
+    class(gas_type),      intent(in)  :: this
+    integer,              intent(in)  :: igas
+    integer,              intent(in)  :: iunits
+    real(jprb),           intent(out) :: mixing_ratio(:,:)
+    real(jprb), optional, intent(in)  :: scale_factor
+    integer,    optional, intent(in)  :: istartcol
+
+    real(jprb)                        :: sf
+    integer                           :: i1, i2
+
+    real(jprb)                        :: hook_handle
+
+    if (lhook) call dr_hook('radiation_gas:get',0,hook_handle)
+
+    if (present(scale_factor)) then
+      sf = scale_factor
+    else
+      sf = 1.0_jprb
+    end if
+
+    if (present(istartcol)) then
+      i1 = istartcol
+    else
+      i1 = 1
+    end if
+
+    i2 = i1 + size(mixing_ratio,1) - 1
+
+    if (i1 < 1 .or. i2 < 1 .or. i1 > this%ncol .or. i2 > this%ncol) then
+      write(nulerr,'(a,i0,a,i0,a,i0)') '*** Error: attempt to get columns indexed ', &
+           &   i1, ' to ', i2, ' from array indexed 1 to ', this%ncol
+      call radiation_abort()
+    end if
+
+    if (size(mixing_ratio,2) /= this%nlev) then
+      write(nulerr,'(a,i0,a)') &
+           &  '*** Error: gas destination array expected to have ', this%nlev, &
+           &  ' levels'
+      call radiation_abort()
+    end if
+
+    if (.not. this%is_present(igas)) then
+      mixing_ratio = 0.0_jprb
+    else 
+      if (iunits == IMassMixingRatio &
+           &   .and. this%iunits(igas) == IVolumeMixingRatio) then
+        sf = sf * IGasMolarMass(igas) / IAirMolarMass
+      else if (iunits == IVolumeMixingRatio &
+           &   .and. this%iunits(igas) == IMassMixingRatio) then
+        sf = sf * IAirMolarMass / IGasMolarMass(igas)
+      end if
+      sf = sf * this%scale_factor(igas)
+        
+      if (sf /= 1.0_jprb) then
+        mixing_ratio = this%mixing_ratio(i1:i2,:,igas) * sf
+      else
+        mixing_ratio = this%mixing_ratio(i1:i2,:,igas)
+      end if
+    end if
+
+    if (lhook) call dr_hook('radiation_gas:get',1,hook_handle)
+
+  end subroutine get_gas
+
+
+  !---------------------------------------------------------------------
+  ! Copy data to "gas_rev", reversing the height ordering of the gas
+  ! data
+  subroutine reverse_gas(this, istartcol, iendcol, gas_rev)
+
+    class(gas_type)             :: this
+    integer,        intent(in)  :: istartcol, iendcol
+    type(gas_type), intent(out) :: gas_rev
+
+    gas_rev%iunits = this%iunits
+    gas_rev%scale_factor = this%scale_factor
+    gas_rev%is_present = this%is_present
+    gas_rev%is_well_mixed = this%is_well_mixed
+    gas_rev%ntype = this%ntype
+    gas_rev%ncol = this%ncol
+    gas_rev%nlev = this%nlev
+    gas_rev%icode = this%icode
+
+    if (allocated(gas_rev%mixing_ratio)) deallocate(gas_rev%mixing_ratio)
+
+    if (allocated(this%mixing_ratio)) then
+      allocate(gas_rev%mixing_ratio(istartcol:iendcol,this%nlev,NMaxGases))
+      gas_rev%mixing_ratio(istartcol:iendcol,:,:) &
+           &  = this%mixing_ratio(istartcol:iendcol,this%nlev:1:-1,:)
+    end if
+
+  end subroutine reverse_gas
+
+  !---------------------------------------------------------------------
+  ! Return .true. if variables are out of a physically sensible range,
+  ! optionally only considering columns between istartcol and iendcol
+  function out_of_physical_bounds(this, istartcol, iendcol, do_fix) result(is_bad)
+
+    use yomhook,          only : lhook, dr_hook
+    use radiation_config, only : out_of_bounds_3d
+
+    class(gas_type),   intent(inout) :: this
+    integer,  optional,intent(in) :: istartcol, iendcol
+    logical,  optional,intent(in) :: do_fix
+    logical                       :: is_bad
+
+    logical    :: do_fix_local
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_gas:out_of_physical_bounds',0,hook_handle)
+
+    if (present(do_fix)) then
+      do_fix_local = do_fix
+    else
+      do_fix_local = .false.
+    end if
+
+    is_bad = out_of_bounds_3d(this%mixing_ratio, 'gas%mixing_ratio', &
+         &                    0.0_jprb, 1.0_jprb, do_fix_local, i1=istartcol, i2=iendcol)
+
+    if (lhook) call dr_hook('radiation_gas:out_of_physical_bounds',1,hook_handle)
+
+  end function out_of_physical_bounds
+  
+end module radiation_gas
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_homogeneous_lw.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_homogeneous_lw.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_homogeneous_lw.F90	(revision 3908)
@@ -0,0 +1,317 @@
+! radiation_homogeneous_lw.F90 - Longwave homogeneous-column (no cloud fraction) solver
+!
+! (C) Copyright 2016- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2017-04-11  R. Hogan  Receive emission/albedo rather than planck/emissivity
+!   2017-04-22  R. Hogan  Store surface fluxes at all g-points
+!   2017-10-23  R. Hogan  Renamed single-character variables
+!   2019-01-14  R. Hogan  Save spectral flux profile if required
+
+module radiation_homogeneous_lw
+
+  public
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Longwave homogeneous solver, in which clouds are assumed to fill
+  ! the gridbox horizontally
+  subroutine solver_homogeneous_lw(nlev,istartcol,iendcol, &
+       &  config, cloud, & 
+       &  od, ssa, g, od_cloud, ssa_cloud, g_cloud, planck_hl, &
+       &  emission, albedo, &
+       &  flux)
+
+    use parkind1, only           : jprb
+    use yomhook,  only           : lhook, dr_hook
+
+    use radiation_config, only         : config_type
+    use radiation_cloud, only          : cloud_type
+    use radiation_flux, only           : flux_type, indexed_sum_profile
+    use radiation_two_stream, only     : calc_two_stream_gammas_lw, &
+         &                               calc_reflectance_transmittance_lw, &
+         &                               calc_no_scattering_transmittance_lw
+    use radiation_adding_ica_lw, only  : adding_ica_lw, calc_fluxes_no_scattering_lw
+    use radiation_lw_derivatives, only : calc_lw_derivatives_ica
+
+    implicit none
+
+    ! Inputs
+    integer, intent(in) :: nlev               ! number of model levels
+    integer, intent(in) :: istartcol, iendcol ! range of columns to process
+    type(config_type),        intent(in) :: config
+    type(cloud_type),         intent(in) :: cloud
+
+    ! Gas and aerosol optical depth, single-scattering albedo and
+    ! asymmetry factor at each longwave g-point
+    real(jprb), intent(in), dimension(config%n_g_lw, nlev, istartcol:iendcol) :: &
+         &  od
+    real(jprb), intent(in), dimension(config%n_g_lw_if_scattering, nlev, istartcol:iendcol) :: &
+         &  ssa, g
+
+    ! Cloud and precipitation optical depth, single-scattering albedo and
+    ! asymmetry factor in each longwave band
+    real(jprb), intent(in), dimension(config%n_bands_lw,nlev,istartcol:iendcol)   :: &
+         &  od_cloud
+    real(jprb), intent(in), dimension(config%n_bands_lw_if_scattering, &
+         &  nlev,istartcol:iendcol) :: ssa_cloud, g_cloud
+
+    ! Planck function at each half-level and the surface
+    real(jprb), intent(in), dimension(config%n_g_lw,nlev+1,istartcol:iendcol) :: &
+         &  planck_hl
+  
+    ! Emission (Planck*emissivity) and albedo (1-emissivity) at the
+    ! surface at each longwave g-point
+    real(jprb), intent(in), dimension(config%n_g_lw, istartcol:iendcol) &
+         &  :: emission, albedo
+
+    ! Output
+    type(flux_type), intent(inout):: flux
+
+    ! Local variables
+
+    ! Diffuse reflectance and transmittance for each layer in clear
+    ! and all skies
+    real(jprb), dimension(config%n_g_lw, nlev) :: reflectance, transmittance
+
+    ! Emission by a layer into the upwelling or downwelling diffuse
+    ! streams, in clear and all skies
+    real(jprb), dimension(config%n_g_lw, nlev) :: source_up, source_dn
+
+    ! Fluxes per g point
+    real(jprb), dimension(config%n_g_lw, nlev+1) :: flux_up, flux_dn
+
+    ! Combined gas+aerosol+cloud optical depth, single scattering
+    ! albedo and asymmetry factor
+    real(jprb), dimension(config%n_g_lw) :: od_total, ssa_total, g_total
+
+    ! Two-stream coefficients
+    real(jprb), dimension(config%n_g_lw) :: gamma1, gamma2
+
+    ! Optical depth of cloud in g-point space
+    real(jprb), dimension(config%n_g_lw) :: od_cloud_g
+
+    ! Is there any cloud in the profile?
+    logical :: is_cloudy_profile
+
+    ! Number of g points
+    integer :: ng
+
+    ! Loop indices for level and column
+    integer :: jlev, jcol
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_homogeneous_lw:solver_homogeneous_lw',0,hook_handle)
+
+    ng = config%n_g_lw
+
+    ! Loop through columns
+    do jcol = istartcol,iendcol
+
+      ! Is there any cloud in the profile?
+      is_cloudy_profile = .false.
+      do jlev = 1,nlev
+        if (cloud%fraction(jcol,jlev) >= config%cloud_fraction_threshold) then
+          is_cloudy_profile = .true.
+          exit
+        end if
+      end do
+
+      ! If clear-sky fluxes need to be computed then we first compute
+      ! the reflectance and transmittance of all layers, neglecting
+      ! clouds. If clear-sky fluxes are not required then we only do
+      ! the clear-sky layers since these will be needed when we come
+      ! to do the total-sky fluxes.
+      do jlev = 1,nlev
+        if (config%do_clear .or. cloud%fraction(jcol,jlev) &
+             &                 < config%cloud_fraction_threshold) then
+          if (config%do_lw_aerosol_scattering) then
+            ! Scattering case: first compute clear-sky reflectance,
+            ! transmittance etc at each model level
+            ssa_total = ssa(:,jlev,jcol)
+            g_total   = g(:,jlev,jcol)
+            call calc_two_stream_gammas_lw(ng, ssa_total, g_total, &
+                 &  gamma1, gamma2)
+            call calc_reflectance_transmittance_lw(ng, &
+                 &  od(:,jlev,jcol), gamma1, gamma2, &
+                 &  planck_hl(:,jlev,jcol), planck_hl(:,jlev+1,jcol), &
+                 &  reflectance(:,jlev), transmittance(:,jlev), &
+                 &  source_up(:,jlev), source_dn(:,jlev))
+          else
+            ! Non-scattering case: use simpler functions for
+            ! transmission and emission
+            call calc_no_scattering_transmittance_lw(ng, od(:,jlev,jcol), &
+                 &  planck_hl(:,jlev,jcol), planck_hl(:,jlev+1, jcol), &
+                 &  transmittance(:,jlev), source_up(:,jlev), source_dn(:,jlev))          
+            ! Ensure that clear-sky reflectance is zero since it may be
+            ! used in cloudy-sky case
+            reflectance(:,jlev) = 0.0_jprb
+          end if
+         
+        end if
+      end do
+
+      if (config%do_clear) then
+        if (config%do_lw_aerosol_scattering) then
+          ! Then use adding method to compute fluxes
+          call adding_ica_lw(ng, nlev, &
+               &  reflectance, transmittance, source_up, source_dn, &
+               &  emission(:,jcol), albedo(:,jcol), &
+               &  flux_up, flux_dn)
+        else
+          ! Simpler down-then-up method to compute fluxes
+          call calc_fluxes_no_scattering_lw(ng, nlev, &
+               &  transmittance, source_up, source_dn, &
+               &  emission(:,jcol), albedo(:,jcol), &
+               &  flux_up, flux_dn)
+          
+        end if
+
+        ! Sum over g-points to compute broadband fluxes
+        flux%lw_up_clear(jcol,:) = sum(flux_up,1)
+        flux%lw_dn_clear(jcol,:) = sum(flux_dn,1)
+        ! Store surface spectral downwelling fluxes
+        flux%lw_dn_surf_clear_g(:,jcol) = flux_dn(:,nlev+1)
+
+        ! Save the spectral fluxes if required
+        if (config%do_save_spectral_flux) then
+          call indexed_sum_profile(flux_up, config%i_spec_from_reordered_g_lw, &
+               &                   flux%lw_up_clear_band(:,jcol,:))
+          call indexed_sum_profile(flux_dn, config%i_spec_from_reordered_g_lw, &
+               &                   flux%lw_dn_clear_band(:,jcol,:))
+        end if
+
+      end if ! Do clear-sky calculations
+
+      ! Now the total-sky calculation.  If this is a clear profile and
+      ! clear-sky fluxes have been calculated then we can simply copy
+      ! over the clear-sky fluxes, otherwise we need to compute fluxes
+      ! now.
+      if (is_cloudy_profile .or. .not. config%do_clear) then
+        do jlev = 1,nlev
+          ! Compute combined gas+aerosol+cloud optical properties;
+          ! note that for clear layers, the reflectance and
+          ! transmittance have already been calculated
+          if (cloud%fraction(jcol,jlev) >= config%cloud_fraction_threshold) then
+            od_cloud_g = od_cloud(config%i_band_from_reordered_g_lw,jlev,jcol)
+            od_total = od(:,jlev,jcol) + od_cloud_g
+            ssa_total = 0.0_jprb
+            g_total   = 0.0_jprb
+
+            if (config%do_lw_cloud_scattering) then
+              ! Scattering case: calculate reflectance and
+              ! transmittance at each model level
+              if (config%do_lw_aerosol_scattering) then
+                where (od_total > 0.0_jprb)
+                  ssa_total = (ssa(:,jlev,jcol)*od(:,jlev,jcol) &
+                       &     + ssa_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
+                       &     *  od_cloud_g) & 
+                       &     / od_total
+                end where
+                where (ssa_total > 0.0_jprb .and. od_total > 0.0_jprb)
+                  g_total = (g(:,jlev,jcol)*ssa(:,jlev,jcol)*od(:,jlev,jcol) &
+                       &     +   g_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
+                       &     * ssa_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
+                       &     *  od_cloud_g) &
+                       &     / (ssa_total*od_total)
+                end where
+              else
+                where (od_total > 0.0_jprb)
+                  ssa_total = ssa_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
+                       &     * od_cloud_g / od_total
+                end where
+                where (ssa_total > 0.0_jprb .and. od_total > 0.0_jprb)
+                  g_total = g_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
+                       &     * ssa_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
+                       &     *  od_cloud_g / (ssa_total*od_total)
+                end where
+              end if
+            
+              ! Compute cloudy-sky reflectance, transmittance etc at
+              ! each model level
+              call calc_two_stream_gammas_lw(ng, ssa_total, g_total, &
+                   &  gamma1, gamma2)
+              call calc_reflectance_transmittance_lw(ng, &
+                   &  od_total, gamma1, gamma2, &
+                   &  planck_hl(:,jlev,jcol), planck_hl(:,jlev+1,jcol), &
+                   &  reflectance(:,jlev), transmittance(:,jlev), &
+                   &  source_up(:,jlev), source_dn(:,jlev))
+            else
+              ! No-scattering case: use simpler functions for
+              ! transmission and emission
+              call calc_no_scattering_transmittance_lw(ng, od_total, &
+                   &  planck_hl(:,jlev,jcol), planck_hl(:,jlev+1, jcol), &
+                   &  transmittance(:,jlev), source_up(:,jlev), source_dn(:,jlev))
+            end if
+          end if ! is cloudy layer
+        end do
+        
+        if (config%do_lw_cloud_scattering) then
+          ! Use adding method to compute fluxes for an overcast sky
+          call adding_ica_lw(ng, nlev, reflectance, transmittance, source_up, source_dn, &
+               &  emission(:,jcol), albedo(:,jcol), &
+               &  flux_up, flux_dn)
+        else
+          ! Simpler down-then-up method to compute fluxes
+          call calc_fluxes_no_scattering_lw(ng, nlev, &
+               &  transmittance, source_up, source_dn, emission(:,jcol), albedo(:,jcol), &
+               &  flux_up, flux_dn)
+        end if
+        
+        ! Store overcast broadband fluxes
+        flux%lw_up(jcol,:) = sum(flux_up,1)
+        flux%lw_dn(jcol,:) = sum(flux_dn,1)
+        ! Store surface spectral downwelling fluxes
+        flux%lw_dn_surf_g(:,jcol) = flux_dn(:,nlev+1)
+
+        ! Save the spectral fluxes if required
+        if (config%do_save_spectral_flux) then
+          call indexed_sum_profile(flux_up, config%i_spec_from_reordered_g_lw, &
+               &                   flux%lw_up_band(:,jcol,:))
+          call indexed_sum_profile(flux_dn, config%i_spec_from_reordered_g_lw, &
+               &                   flux%lw_dn_band(:,jcol,:))
+        end if
+
+      else
+        ! No cloud in profile and clear-sky fluxes already
+        ! calculated: copy them over
+        flux%lw_up(jcol,:) = flux%lw_up_clear(jcol,:)
+        flux%lw_dn(jcol,:) = flux%lw_dn_clear(jcol,:)
+        flux%lw_dn_surf_g(:,jcol) = flux%lw_dn_surf_clear_g(:,jcol)
+
+        if (config%do_save_spectral_flux) then
+          flux%lw_up_band(:,jcol,:) = flux%lw_up_clear_band(:,jcol,:)
+          flux%lw_dn_band(:,jcol,:) = flux%lw_dn_clear_band(:,jcol,:)
+        end if
+
+     end if
+
+      ! Compute the longwave derivatives needed by Hogan and Bozzo
+      ! (2015) approximate radiation update scheme, using clear-sky
+      ! transmittance if no clouds were present in the profile,
+      ! all-sky transmittance otherwise
+      if (config%do_lw_derivatives) then
+        call calc_lw_derivatives_ica(ng, nlev, jcol, transmittance, flux_up(:,nlev+1), &
+             &                       flux%lw_derivatives)
+ 
+      end if
+
+    end do
+
+    if (lhook) call dr_hook('radiation_homogeneous_lw:solver_homogeneous_lw',1,hook_handle)
+    
+  end subroutine solver_homogeneous_lw
+
+end module radiation_homogeneous_lw
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_homogeneous_sw.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_homogeneous_sw.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_homogeneous_sw.F90	(revision 3908)
@@ -0,0 +1,374 @@
+! radiation_homogeneous_sw.F90 - Shortwave homogeneous-column (no cloud fraction) solver
+!
+! (C) Copyright 2016- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2017-04-11  R. Hogan  Receive albedos at g-points
+!   2017-04-22  R. Hogan  Store surface fluxes at all g points
+!   2017-10-23  R. Hogan  Renamed single-character variables
+!   2019-01-14  R. Hogan  Save spectral flux profile if required
+
+module radiation_homogeneous_sw
+
+  public
+
+contains
+
+  ! Provides elemental function "delta_eddington"
+#include "radiation_delta_eddington.h"
+
+  !---------------------------------------------------------------------
+  ! Shortwave homogeneous solver, in which clouds are assumed to fill
+  ! the gridbox horizontally
+  subroutine solver_homogeneous_sw(nlev,istartcol,iendcol, &
+       &  config, single_level, cloud, & 
+       &  od, ssa, g, od_cloud, ssa_cloud, g_cloud, &
+       &  albedo_direct, albedo_diffuse, incoming_sw, &
+       &  flux)
+
+    use parkind1, only           : jprb
+    use yomhook,  only           : lhook, dr_hook
+
+    use radiation_config, only         : config_type
+    use radiation_single_level, only   : single_level_type
+    use radiation_cloud, only          : cloud_type
+    use radiation_flux, only           : flux_type, &
+         &                               indexed_sum_profile, add_indexed_sum_profile
+    use radiation_two_stream, only     : calc_two_stream_gammas_sw, &
+         &                       calc_reflectance_transmittance_sw
+    use radiation_constants, only      : Pi, GasConstantDryAir, &
+         &                               AccelDueToGravity
+    use radiation_adding_ica_sw, only  : adding_ica_sw
+
+    implicit none
+
+    ! Inputs
+    integer, intent(in) :: nlev               ! number of model levels
+    integer, intent(in) :: istartcol, iendcol ! range of columns to process
+    type(config_type),        intent(in) :: config
+    type(single_level_type),  intent(in) :: single_level
+    type(cloud_type),         intent(in) :: cloud
+
+    ! Gas and aerosol optical depth, single-scattering albedo and
+    ! asymmetry factor at each shortwave g-point
+    real(jprb), intent(in), dimension(config%n_g_sw, nlev, istartcol:iendcol) :: &
+         &  od, ssa, g
+
+    ! Cloud and precipitation optical depth, single-scattering albedo and
+    ! asymmetry factor in each shortwave band
+    real(jprb), intent(in), dimension(config%n_bands_sw,nlev,istartcol:iendcol)   :: &
+         &  od_cloud, ssa_cloud, g_cloud
+
+    ! Direct and diffuse surface albedos, and the incoming shortwave
+    ! flux into a plane perpendicular to the incoming radiation at
+    ! top-of-atmosphere in each of the shortwave g points
+    real(jprb), intent(in), dimension(config%n_g_sw,istartcol:iendcol) :: &
+         &  albedo_direct, albedo_diffuse, incoming_sw
+
+    ! Output
+    type(flux_type), intent(inout):: flux
+
+    ! Local variables
+
+    ! Cosine of solar zenith angle
+    real(jprb)                                 :: cos_sza
+
+    ! Diffuse reflectance and transmittance for each layer
+    real(jprb), dimension(config%n_g_sw, nlev) :: reflectance, transmittance
+
+    ! Fraction of direct beam scattered by a layer into the upwelling
+    ! or downwelling diffuse streams
+    real(jprb), dimension(config%n_g_sw, nlev) :: ref_dir, trans_dir_diff
+
+    ! Transmittance for the direct beam in clear and all skies
+    real(jprb), dimension(config%n_g_sw, nlev) :: trans_dir_dir
+
+    ! Fluxes per g point
+    real(jprb), dimension(config%n_g_sw, nlev+1) :: flux_up, flux_dn_diffuse, flux_dn_direct
+
+    ! Combined gas+aerosol+cloud optical depth, single scattering
+    ! albedo and asymmetry factor
+    real(jprb), dimension(config%n_g_sw) :: od_total, ssa_total, g_total
+
+    ! Two-stream coefficients
+    real(jprb), dimension(config%n_g_sw) :: gamma1, gamma2, gamma3
+
+    ! Optical depth of cloud in g-point space
+    real(jprb), dimension(config%n_g_sw) :: od_cloud_g
+
+    ! Is there any cloud in the profile?
+    logical :: is_cloudy_profile
+
+    ! Number of g points
+    integer :: ng
+
+    ! Loop indices for level and column
+    integer :: jlev, jcol
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_homogeneous_sw:solver_homogeneous_sw',0,hook_handle)
+
+    ng = config%n_g_sw
+
+    ! Loop through columns
+    do jcol = istartcol,iendcol
+      ! Only perform calculation if sun above the horizon
+      if (single_level%cos_sza(jcol) > 0.0_jprb) then
+
+        cos_sza = single_level%cos_sza(jcol)
+        
+        ! Is there any cloud in the profile?
+        is_cloudy_profile = .false.
+        do jlev = 1,nlev
+          if (cloud%fraction(jcol,jlev) >= config%cloud_fraction_threshold) then
+            is_cloudy_profile = .true.
+            exit
+          end if
+        end do
+
+        ! If clear-sky fluxes need to be computed then we first
+        ! compute the reflectance and transmittance of all layers,
+        ! neglecting clouds. If clear-sky fluxes are not required then
+        ! we only do the clear-sky layers since these will be needed
+        ! when we come to do the total-sky fluxes.
+        if (.not. config%do_sw_delta_scaling_with_gases) then
+          ! Delta-Eddington scaling has already been performed to the
+          ! aerosol part of od, ssa and g
+          do jlev = 1,nlev
+            if (config%do_clear .or. cloud%fraction(jcol,jlev) &
+                 &                 < config%cloud_fraction_threshold) then
+              call calc_two_stream_gammas_sw(ng, cos_sza, &
+                   &  ssa(:,jlev,jcol), g(:,jlev,jcol), &
+                   &  gamma1, gamma2, gamma3)
+              call calc_reflectance_transmittance_sw(ng, &
+                   &  cos_sza, &
+                   &  od(:,jlev,jcol), ssa(:,jlev,jcol), &
+                   &  gamma1, gamma2, gamma3, &
+                   &  reflectance(:,jlev), transmittance(:,jlev), &
+                   &  ref_dir(:,jlev), trans_dir_diff(:,jlev), &
+                   &  trans_dir_dir(:,jlev) )
+              
+            end if
+          end do
+        else
+          ! Apply delta-Eddington scaling to the aerosol-gas mixture
+          do jlev = 1,nlev
+            if (config%do_clear .or. cloud%fraction(jcol,jlev) &
+                 &                 < config%cloud_fraction_threshold) then
+              od_total  =  od(:,jlev,jcol)
+              ssa_total = ssa(:,jlev,jcol)
+              g_total   =   g(:,jlev,jcol)
+              call delta_eddington(od_total, ssa_total, g_total)
+              call calc_two_stream_gammas_sw(ng, &
+                   &  cos_sza, ssa_total, g_total, &
+                   &  gamma1, gamma2, gamma3)
+              call calc_reflectance_transmittance_sw(ng, &
+                   &  cos_sza, od_total, ssa_total, &
+                   &  gamma1, gamma2, gamma3, &
+                   &  reflectance(:,jlev), transmittance(:,jlev), &
+                   &  ref_dir(:,jlev), trans_dir_diff(:,jlev), &
+                   &  trans_dir_dir(:,jlev) )
+            end if
+          end do
+        end if
+          
+        if (config%do_clear) then
+          ! Use adding method to compute fluxes
+          call adding_ica_sw(ng, nlev, incoming_sw(:,jcol), &
+               &  albedo_diffuse(:,jcol), albedo_direct(:,jcol), &
+               &  spread(cos_sza,1,ng), reflectance, transmittance, ref_dir, trans_dir_diff, &
+               &  trans_dir_dir, flux_up, flux_dn_diffuse, flux_dn_direct)
+        
+          ! Sum over g-points to compute and save clear-sky broadband
+          ! fluxes
+          flux%sw_up_clear(jcol,:) = sum(flux_up,1)
+          if (allocated(flux%sw_dn_direct_clear)) then
+            flux%sw_dn_direct_clear(jcol,:) &
+                 &  = sum(flux_dn_direct,1)
+            flux%sw_dn_clear(jcol,:) = sum(flux_dn_diffuse,1) &
+                 &  + flux%sw_dn_direct_clear(jcol,:)
+          else
+            flux%sw_dn_clear(jcol,:) = sum(flux_dn_diffuse,1) &
+                 &  + sum(flux_dn_direct,1)
+          end if
+          ! Store spectral downwelling fluxes at surface
+          flux%sw_dn_diffuse_surf_clear_g(:,jcol) = flux_dn_diffuse(:,nlev+1)
+          flux%sw_dn_direct_surf_clear_g(:,jcol)  = flux_dn_direct(:,nlev+1)
+
+          ! Save the spectral fluxes if required
+          if (config%do_save_spectral_flux) then
+            call indexed_sum_profile(flux_up, config%i_spec_from_reordered_g_sw, &
+                 &                   flux%sw_up_clear_band(:,jcol,:))
+            call indexed_sum_profile(flux_dn_direct, config%i_spec_from_reordered_g_sw, &
+                 &                   flux%sw_dn_clear_band(:,jcol,:))
+            if (allocated(flux%sw_dn_direct_clear_band)) then
+              flux%sw_dn_direct_clear_band(:,jcol,:) &
+                   &  = flux%sw_dn_clear_band(:,jcol,:)
+            end if
+            call add_indexed_sum_profile(flux_dn_diffuse, &
+                 &                       config%i_spec_from_reordered_g_sw, &
+                 &                       flux%sw_dn_clear_band(:,jcol,:))
+          end if
+
+        end if ! Do clear-sky calculations
+  
+        ! Now the total-sky calculation.  If this is a clear profile
+        ! and clear-sky fluxes have been calculated then we can simply
+        ! copy over the clear-sky fluxes, otherwise we need to compute
+        ! fluxes now.
+        if (is_cloudy_profile .or. .not. config%do_clear) then
+          do jlev = 1,nlev
+            ! Compute combined gas+aerosol+cloud optical properties;
+            ! note that for clear layers, the reflectance and
+            ! transmittance have already been calculated
+            if (cloud%fraction(jcol,jlev) >= config%cloud_fraction_threshold) then
+              od_cloud_g = od_cloud(config%i_band_from_reordered_g_sw,jlev,jcol)
+              od_total  = od(:,jlev,jcol) + od_cloud_g
+              ssa_total = 0.0_jprb
+              g_total   = 0.0_jprb
+              where (od_total > 0.0_jprb)
+                ssa_total = (ssa(:,jlev,jcol)*od(:,jlev,jcol) &
+                     &     + ssa_cloud(config%i_band_from_reordered_g_sw,jlev,jcol) &
+                     &     *  od_cloud_g) & 
+                     &     / od_total
+              end where
+              where (ssa_total > 0.0_jprb .and. od_total > 0.0_jprb)
+                g_total = (g(:,jlev,jcol)*ssa(:,jlev,jcol)*od(:,jlev,jcol) &
+                     &     +   g_cloud(config%i_band_from_reordered_g_sw,jlev,jcol) &
+                     &     * ssa_cloud(config%i_band_from_reordered_g_sw,jlev,jcol) &
+                     &     *  od_cloud_g) &
+                     &     / (ssa_total*od_total)
+              end where
+
+              ! Apply delta-Eddington scaling to the cloud-aerosol-gas
+              ! mixture
+              if (config%do_sw_delta_scaling_with_gases) then
+                call delta_eddington(od_total, ssa_total, g_total)
+              end if
+
+              ! Compute cloudy-sky reflectance, transmittance etc at
+              ! each model level
+              call calc_two_stream_gammas_sw(ng, &
+                   &  cos_sza, ssa_total, g_total, &
+                   &  gamma1, gamma2, gamma3)
+              call calc_reflectance_transmittance_sw(ng, &
+                   &  cos_sza, od_total, ssa_total, &
+                   &  gamma1, gamma2, gamma3, &
+                   &  reflectance(:,jlev), transmittance(:,jlev), &
+                   &  ref_dir(:,jlev), trans_dir_diff(:,jlev), &
+                   &  trans_dir_dir(:,jlev) )
+
+            end if
+          end do
+            
+          ! Use adding method to compute fluxes for an overcast sky
+          call adding_ica_sw(ng, nlev, incoming_sw(:,jcol), &
+               &  albedo_diffuse(:,jcol), albedo_direct(:,jcol), &
+               &  spread(cos_sza,1,ng), reflectance, transmittance, ref_dir, trans_dir_diff, &
+               &  trans_dir_dir, flux_up, flux_dn_diffuse, flux_dn_direct)
+
+          ! Store overcast broadband fluxes
+          flux%sw_up(jcol,:) = sum(flux_up,1)
+          if (allocated(flux%sw_dn_direct)) then
+            flux%sw_dn_direct(jcol,:) = sum(flux_dn_direct,1)
+            flux%sw_dn(jcol,:) = sum(flux_dn_diffuse,1) &
+                 &  + flux%sw_dn_direct(jcol,:)
+          else
+            flux%sw_dn(jcol,:) = sum(flux_dn_diffuse,1) &
+                 &  + sum(flux_dn_direct,1)
+          end if
+
+          ! Likewise for surface spectral fluxes
+          flux%sw_dn_diffuse_surf_g(:,jcol) = flux_dn_diffuse(:,nlev+1)
+          flux%sw_dn_direct_surf_g(:,jcol)  = flux_dn_direct(:,nlev+1)
+
+          ! Save the spectral fluxes if required
+          if (config%do_save_spectral_flux) then
+            call indexed_sum_profile(flux_up, config%i_spec_from_reordered_g_sw, &
+                 &                   flux%sw_up_band(:,jcol,:))
+            call indexed_sum_profile(flux_dn_direct, config%i_spec_from_reordered_g_sw, &
+                 &                   flux%sw_dn_band(:,jcol,:))
+            if (allocated(flux%sw_dn_direct_band)) then
+              flux%sw_dn_direct_band(:,jcol,:) &
+                   &  = flux%sw_dn_band(:,jcol,:)
+            end if
+            call add_indexed_sum_profile(flux_dn_diffuse, &
+                 &                       config%i_spec_from_reordered_g_sw, &
+                 &                       flux%sw_dn_band(:,jcol,:))
+          end if
+
+        else
+          ! No cloud in profile and clear-sky fluxes already
+          ! calculated: copy them over
+          flux%sw_up(jcol,:) = flux%sw_up_clear(jcol,:)
+          flux%sw_dn(jcol,:) = flux%sw_dn_clear(jcol,:)
+          if (allocated(flux%sw_dn_direct)) then
+            flux%sw_dn_direct(jcol,:) = flux%sw_dn_direct_clear(jcol,:)
+          end if
+          flux%sw_dn_diffuse_surf_g(:,jcol) = flux%sw_dn_diffuse_surf_clear_g(:,jcol)
+          flux%sw_dn_direct_surf_g(:,jcol)  = flux%sw_dn_direct_surf_clear_g(:,jcol)
+
+          if (config%do_save_spectral_flux) then
+            flux%sw_up_band(:,jcol,:) = flux%sw_up_clear_band(:,jcol,:)
+            flux%sw_dn_band(:,jcol,:) = flux%sw_dn_clear_band(:,jcol,:)
+            if (allocated(flux%sw_dn_direct_band)) then
+              flux%sw_dn_direct_band(:,jcol,:) = flux%sw_dn_direct_clear_band(:,jcol,:)
+            end if
+          end if
+
+        end if ! Cloud is present in profile
+
+      else
+        ! Set fluxes to zero if sun is below the horizon
+        flux%sw_up(jcol,:) = 0.0_jprb
+        flux%sw_dn(jcol,:) = 0.0_jprb
+        if (allocated(flux%sw_dn_direct)) then
+          flux%sw_dn_direct(jcol,:) = 0.0_jprb
+        end if
+        flux%sw_dn_diffuse_surf_g(:,jcol) = 0.0_jprb
+        flux%sw_dn_direct_surf_g(:,jcol)  = 0.0_jprb
+
+        if (config%do_clear) then
+          flux%sw_up_clear(jcol,:) = 0.0_jprb
+          flux%sw_dn_clear(jcol,:) = 0.0_jprb
+          if (allocated(flux%sw_dn_direct_clear)) then
+            flux%sw_dn_direct_clear(jcol,:) = 0.0_jprb
+          end if
+          flux%sw_dn_diffuse_surf_clear_g(:,jcol) = 0.0_jprb
+          flux%sw_dn_direct_surf_clear_g(:,jcol)  = 0.0_jprb
+        end if
+
+        if (config%do_save_spectral_flux) then
+          flux%sw_dn_band(:,jcol,:) = 0.0_jprb
+          flux%sw_up_band(:,jcol,:) = 0.0_jprb
+          if (allocated(flux%sw_dn_direct_band)) then
+            flux%sw_dn_direct_band(:,jcol,:) = 0.0_jprb
+          end if
+          if (config%do_clear) then
+            flux%sw_dn_clear_band(:,jcol,:) = 0.0_jprb
+            flux%sw_up_clear_band(:,jcol,:) = 0.0_jprb
+            if (allocated(flux%sw_dn_direct_clear_band)) then
+              flux%sw_dn_direct_clear_band(:,jcol,:) = 0.0_jprb
+            end if
+          end if
+        end if
+
+      end if ! sun above horizon
+    end do
+
+    if (lhook) call dr_hook('radiation_homogeneous_sw:solver_homogeneous_sw',1,hook_handle)
+
+  end subroutine solver_homogeneous_sw
+
+end module radiation_homogeneous_sw
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_ice_optics_baran.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_ice_optics_baran.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_ice_optics_baran.F90	(revision 3908)
@@ -0,0 +1,111 @@
+! radiation_ice_optics_fu.F90 - Scheme for ice optical properties adapted from Baran's data
+!
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+
+module radiation_ice_optics_baran
+
+  implicit none
+  public
+
+  ! The number of ice coefficients depends on the parameterization
+  integer, parameter :: NIceOpticsCoeffsBaran = 9
+  integer, parameter :: NIceOpticsCoeffsBaran2016 = 5
+
+contains
+
+  
+  !---------------------------------------------------------------------
+  ! Compute ice-particle scattering properties using a
+  ! parameterization as a function of ice water mixing ratio only
+  subroutine calc_ice_optics_baran(nb, coeff, ice_wp, &
+       &  qi, od, scat_od, g)
+
+    use parkind1, only : jprb
+    !use yomhook,  only : lhook, dr_hook
+
+    ! Number of bands
+    integer, intent(in)  :: nb
+    ! Coefficients read from a data file
+    real(jprb), intent(in) :: coeff(:,:)
+    ! Ice water path (kg m-2) and mixing ratio (kg kg-1)
+    real(jprb), intent(in) :: ice_wp, qi
+    ! Total optical depth, scattering optical depth and asymmetry factor
+    real(jprb), intent(out) :: od(nb), scat_od(nb), g(nb)
+
+    !real(jprb) :: hook_handle
+
+    !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_baran',0,hook_handle)
+
+    od  = ice_wp * (coeff(1:nb,1) + coeff(1:nb,2) &
+         &      / (1.0_jprb + qi*coeff(1:nb,3)))
+    scat_od = od * (coeff(1:nb,4) + coeff(1:nb,5) &
+         &      / (1.0_jprb + qi*coeff(1:nb,6)))
+    ! To apply the simple parameterization in Baran et al. (2014), use the
+    ! following instead, but note that it overestimates shortwave absorption:
+    !    od = ice_wp * coeff(1:nb,1)
+    !    scat_od = od * coeff(1:nb,4)
+    g = coeff(1:nb,7) + coeff(1:nb,8) / (1.0_jprb + qi*coeff(1:nb,9))
+
+    !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_baran',1,hook_handle)
+
+  end subroutine calc_ice_optics_baran
+
+
+  !---------------------------------------------------------------------
+  ! Compute ice-particle scattering properties using a
+  ! parameterization as a function of ice water mixing ratio and
+  ! temperature
+  subroutine calc_ice_optics_baran2016(nb, coeff, ice_wp, &
+       &  qi, temperature, od, scat_od, g)
+
+    use parkind1, only : jprb
+    !use yomhook,  only : lhook, dr_hook
+
+    ! Number of bands
+    integer, intent(in)  :: nb
+    ! Coefficients read from a data file
+    real(jprb), intent(in) :: coeff(:,:)
+    ! Ice water path (kg m-2) and mixing ratio (kg kg-1)
+    real(jprb), intent(in) :: ice_wp, qi
+    ! Temperature (K)
+    real(jprb), intent(in) :: temperature
+    ! Total optical depth, scattering optical depth and asymmetry factor
+    real(jprb), intent(out) :: od(nb), scat_od(nb), g(nb)
+    
+    ! Powers of temperature, some multiplied by qi
+    real(jprb) :: qi_T, T2, qi_over_T4
+    
+    !real(jprb) :: hook_handle
+
+    !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_baran2016',0,hook_handle)
+
+    T2 = temperature * temperature
+
+    if (qi < 1.0e-3_jprb) then
+      qi_T = qi * temperature
+      qi_over_T4 = 1.0_jprb / (T2 * T2)
+    else
+      qi_T = 1.0e-3_jprb * temperature
+      qi_over_T4 = 1.0_jprb / (T2 * T2)
+    end if
+
+    od      = ice_wp * coeff(1:nb,1) * qi_over_T4
+    scat_od = od * (coeff(1:nb,2) + coeff(1:nb,3) * qi_T)
+    g       = coeff(1:nb,4) + coeff(1:nb,5) * qi_T
+
+    !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_baran2016',1,hook_handle)
+
+  end subroutine calc_ice_optics_baran2016
+
+end module radiation_ice_optics_baran
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_ice_optics_baran2016.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_ice_optics_baran2016.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_ice_optics_baran2016.F90	(revision 3908)
@@ -0,0 +1,72 @@
+! radiation_ice_optics_baran2016.F90 - Baran et al. (2016) scheme for ice optical properties
+!
+! (C) Copyright 2016- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+
+module radiation_ice_optics_baran2016
+
+  implicit none
+
+  ! The number of ice coefficients depends on the parameterization
+  integer, parameter :: NIceOpticsCoeffsBaran2016 = 5
+
+contains
+
+  
+  !---------------------------------------------------------------------
+  ! Compute ice-particle scattering properties using a
+  ! parameterization as a function of ice water mixing ratio and
+  ! temperature
+  subroutine calc_ice_optics_baran2016(nb, coeff, ice_wp, &
+       &  qi, temperature, od, scat_od, g)
+
+    use parkind1, only : jprb
+    !use yomhook,  only : lhook, dr_hook
+
+    ! Number of bands
+    integer, intent(in)  :: nb
+    ! Coefficients read from a data file
+    real(jprb), intent(in) :: coeff(:,:)
+    ! Ice water path (kg m-2) and mixing ratio (kg kg-1)
+    real(jprb), intent(in) :: ice_wp, qi
+    ! Temperature (K)
+    real(jprb), intent(in) :: temperature
+    ! Total optical depth, scattering optical depth and asymmetry factor
+    real(jprb), intent(out) :: od(nb), scat_od(nb), g(nb)
+    
+    ! Powers of temperature, some multiplied by qi
+    real(jprb) :: qi_T, T2, qi_over_T4
+    
+    !real(jprb) :: hook_handle
+
+    !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_baran2016',0,hook_handle)
+
+    T2 = temperature * temperature
+
+    if (qi < 1.0e-3_jprb) then
+      qi_T = qi * temperature
+      qi_over_T4 = 1.0_jprb / (T2 * T2)
+    else
+      qi_T = 1.0e-3_jprb * temperature
+      qi_over_T4 = 1.0_jprb / (T2 * T2)
+    end if
+
+    od      = ice_wp * coeff(1:nb,1) * qi_over_T4
+    scat_od = od * (coeff(1:nb,2) + coeff(1:nb,3) * qi_T)
+    g       = coeff(1:nb,4) + coeff(1:nb,5) * qi_T
+
+    !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_baran2016',1,hook_handle)
+
+  end subroutine calc_ice_optics_baran2016
+
+end module radiation_ice_optics_baran2016
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_ice_optics_baran2017.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_ice_optics_baran2017.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_ice_optics_baran2017.F90	(revision 3908)
@@ -0,0 +1,71 @@
+! radiation_ice_optics_baran2017.F90 - 2017 parameterization of Baran's ice optical properties
+!
+! (C) Copyright 2017- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+
+module radiation_ice_optics_baran2017
+
+  implicit none
+  public
+
+  ! The number of ice coefficients depends on the parameterization
+  integer, parameter :: NIceOpticsCoeffsBaran2017 = 9
+  integer, parameter :: NIceOpticsGeneralCoeffsBaran2017 = 5
+
+contains
+
+  
+  !---------------------------------------------------------------------
+  ! Compute ice-particle scattering properties using a
+  ! parameterization as a function of ice water mixing ratio and
+  ! temperature
+  subroutine calc_ice_optics_baran2017(nb, coeff_gen, coeff, ice_wp, &
+       &  qi, temperature, od, scat_od, g)
+
+    use parkind1, only : jprb
+    !use yomhook,  only : lhook, dr_hook
+
+    ! Number of bands
+    integer, intent(in)  :: nb
+    ! General coefficients read from a data file
+    real(jprb), intent(in) :: coeff_gen(:)
+    ! Band-specific coefficients read from a data file
+    real(jprb), intent(in) :: coeff(:,:)
+    ! Ice water path (kg m-2) and mixing ratio (kg kg-1)
+    real(jprb), intent(in) :: ice_wp, qi
+    ! Temperature (K)
+    real(jprb), intent(in) :: temperature
+    ! Total optical depth, scattering optical depth and asymmetry factor
+    real(jprb), intent(out) :: od(nb), scat_od(nb), g(nb)
+    
+    ! Modified ice mixing ratio, and the same raised to an appropriate power
+    real(jprb) :: qi_mod, qi_mod_od, qi_mod_ssa, qi_mod_g
+    
+    !real(jprb) :: hook_handle
+
+    !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_baran2017',0,hook_handle)
+
+    qi_mod     = qi * exp(coeff_gen(1)*(temperature-coeff_gen(2)))
+    qi_mod_od  = qi_mod ** coeff_gen(3)
+    qi_mod_ssa = qi_mod ** coeff_gen(4)
+    qi_mod_g   = qi_mod ** coeff_gen(5)
+
+    od      = ice_wp * (coeff(1:nb,1) + coeff(1:nb,2)/(1.0_jprb+qi_mod_od *coeff(1:nb,3)))
+    scat_od = od     * (coeff(1:nb,4) + coeff(1:nb,5)/(1.0_jprb+qi_mod_ssa*coeff(1:nb,6)))
+    g       =           coeff(1:nb,7) + coeff(1:nb,8)/(1.0_jprb+qi_mod_g  *coeff(1:nb,9))
+
+    !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_baran2017',1,hook_handle)
+
+  end subroutine calc_ice_optics_baran2017
+
+end module radiation_ice_optics_baran2017
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_ice_optics_fu.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_ice_optics_fu.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_ice_optics_fu.F90	(revision 3908)
@@ -0,0 +1,130 @@
+! radiation_ice_optics_fu.F90 - Fu's scheme for ice optical properties
+!
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2020-08-10  R. Hogan  Bounded re to be <= 100um and g to be < 1.0
+
+module radiation_ice_optics_fu
+
+  use parkind1, only : jprb
+
+  implicit none
+  public
+
+  ! The number of ice coefficients depends on the parameterization
+  integer, parameter :: NIceOpticsCoeffsFuSW  = 10
+  integer, parameter :: NIceOpticsCoeffsFuLW  = 11
+
+  ! Limits based on the range of validity of the parameterizations
+  real(jprb), parameter :: MaxAsymmetryFactor = 1.0_jprb - 10.0_jprb*epsilon(1.0_jprb)
+  real(jprb), parameter :: MaxEffectiveRadius = 100.0e-6_jprb ! metres
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Compute shortwave ice-particle scattering properties using Fu
+  ! (1996) parameterization.  The asymmetry factor in band 14 goes
+  ! larger than one for re > 100.8 um, so we cap re at 100 um.
+  ! Asymmetry factor is capped at just less than 1 because if it is
+  ! exactly 1 then delta-Eddington scaling leads to a zero scattering
+  ! optical depth and then division by zero.
+  subroutine calc_ice_optics_fu_sw(nb, coeff, ice_wp, &
+       &  re, od, scat_od, g)
+
+    !use yomhook,  only : lhook, dr_hook
+
+    ! Number of bands
+    integer, intent(in)  :: nb
+    ! Coefficients read from a data file
+    real(jprb), intent(in) :: coeff(:,:)
+    ! Ice water path (kg m-2)
+    real(jprb), intent(in) :: ice_wp
+    ! Effective radius (m)
+    real(jprb), intent(in) :: re
+    ! Total optical depth, scattering optical depth and asymmetry factor
+    real(jprb), intent(out) :: od(nb), scat_od(nb), g(nb)
+
+    ! Fu's effective diameter (microns) and its inverse
+    real(jprb) :: de_um, inv_de_um
+    ! Ice water path in g m-2
+    real (jprb) :: iwp_gm_2
+
+    !real(jprb)  :: hook_handle
+
+    !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_fu_sw',0,hook_handle)
+
+    ! Convert to effective diameter using the relationship in the IFS
+    de_um     = min(re, MaxEffectiveRadius) * (1.0e6_jprb / 0.64952_jprb)
+    inv_de_um = 1.0_jprb / de_um
+    iwp_gm_2  = ice_wp * 1000.0_jprb
+
+    od = iwp_gm_2 * (coeff(1:nb,1) + coeff(1:nb,2) * inv_de_um)
+    scat_od = od * (1.0_jprb - (coeff(1:nb,3) + de_um*(coeff(1:nb,4) &
+         &  + de_um*(coeff(1:nb,5) + de_um*coeff(1:nb,6)))))
+    g = min(coeff(1:nb,7) + de_um*(coeff(1:nb,8) &
+         &  + de_um*(coeff(1:nb,9) + de_um*coeff(1:nb,10))), &
+         &  MaxAsymmetryFactor)
+
+    !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_fu_sw',1,hook_handle)
+
+  end subroutine calc_ice_optics_fu_sw
+
+
+  !---------------------------------------------------------------------
+  ! Compute longwave ice-particle scattering properties using Fu et
+  ! al. (1998) parameterization
+  subroutine calc_ice_optics_fu_lw(nb, coeff, ice_wp, &
+       &  re, od, scat_od, g)
+
+    !use yomhook,  only : lhook, dr_hook
+
+    ! Number of bands
+    integer, intent(in)  :: nb
+    ! Coefficients read from a data file
+    real(jprb), intent(in) :: coeff(:,:)
+    ! Ice water path (kg m-2)
+    real(jprb), intent(in) :: ice_wp
+    ! Effective radius (m)
+    real(jprb), intent(in) :: re
+    ! Total optical depth, scattering optical depth and asymmetry factor
+    real(jprb), intent(out) :: od(nb), scat_od(nb), g(nb)
+
+    ! Fu's effective diameter (microns) and its inverse
+    real(jprb) :: de_um, inv_de_um
+    ! Ice water path in g m-2
+    real (jprb) :: iwp_gm_2
+
+    !real(jprb)  :: hook_handle
+
+    !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_fu_lw',0,hook_handle)
+
+    ! Convert to effective diameter using the relationship in the IFS
+    de_um = min(re, MaxEffectiveRadius) * (1.0e6_jprb / 0.64952_jprb)
+
+    inv_de_um = 1.0_jprb / de_um
+    iwp_gm_2  = ice_wp * 1000.0_jprb
+
+    od = iwp_gm_2 * (coeff(1:nb,1) + inv_de_um*(coeff(1:nb,2) &
+         &  + inv_de_um*coeff(1:nb,3)))
+    scat_od = od - iwp_gm_2*inv_de_um*(coeff(1:nb,4) + de_um*(coeff(1:nb,5) &
+         &  + de_um*(coeff(1:nb,6) + de_um*coeff(1:nb,7))))
+    g = min(coeff(1:nb,8) + de_um*(coeff(1:nb,9) &
+         &  + de_um*(coeff(1:nb,10) + de_um*coeff(1:nb,11))), &
+         &  MaxAsymmetryFactor)
+
+    !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_fu_lw',1,hook_handle)
+
+  end subroutine calc_ice_optics_fu_lw
+
+end module radiation_ice_optics_fu
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_ice_optics_yi.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_ice_optics_yi.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_ice_optics_yi.F90	(revision 3908)
@@ -0,0 +1,148 @@
+! radiation_ice_optics_yi.F90 - Yi et al. (2013) ice optical properties
+!
+! (C) Copyright 2017- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Authors: Mark Fielding and Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! The reference for this ice optics parameterization is Yi, B.,
+! P. Yang, B.A. Baum, T. L'Ecuyer, L. Oreopoulos, E.J. Mlawer,
+! A.J. Heymsfield, and K. Liou, 2013: Influence of Ice Particle
+! Surface Roughening on the Global Cloud Radiative
+! Effect. J. Atmos. Sci., 70, 2794–2807,
+! https://doi.org/10.1175/JAS-D-13-020.1
+
+module radiation_ice_optics_yi
+
+  implicit none
+  public
+
+  ! The number of ice coefficients depends on the parameterization
+  integer, parameter :: NIceOpticsCoeffsYiSW  = 69
+  integer, parameter :: NIceOpticsCoeffsYiLW  = 69
+
+  integer, parameter :: NSingleCoeffs = 23
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Compute shortwave ice-particle scattering properties using Yi et
+  ! al. (2013) parameterization
+  subroutine calc_ice_optics_yi_sw(nb, coeff, ice_wp, &
+       &  re, od, scat_od, g)
+
+    use parkind1, only : jprb, jpim
+    !use yomhook,  only : lhook, dr_hook
+
+    ! Number of bands
+    integer, intent(in)  :: nb
+    ! Coefficients read from a data file
+    real(jprb), intent(in) :: coeff(:,:)
+    ! Ice water path (kg m-2)
+    real(jprb), intent(in) :: ice_wp
+    ! Effective radius (m)
+    real(jprb), intent(in) :: re
+    ! Total optical depth, scattering optical depth and asymmetry factor
+    real(jprb), intent(out) :: od(nb), scat_od(nb), g(nb)
+
+    ! Yi's effective diameter (microns)
+    real(jprb) :: de_um
+    ! Ice water path in g m-2
+    real (jprb) :: iwp_gm_2
+    ! LUT temp variables
+    real(jprb) :: wts_1, wts_2
+    integer(jpim) :: lu_idx
+    real(kind=jprb), parameter    :: lu_scale  = 0.2_jprb
+    real(kind=jprb), parameter    :: lu_offset = 1.0_jprb
+    !real(jprb)  :: hook_handle
+
+    !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_yi_sw',0,hook_handle)
+
+    ! Convert to effective diameter using the relationship in the IFS
+    !de_um     = re * (1.0e6_jprb / 0.64952_jprb)
+    de_um     = re * 2.0e6_jprb
+
+    ! limit de_um to validity of LUT
+    de_um = max(de_um,10.0_jprb)
+    de_um = min(de_um,119.99_jprb) !avoid greater than or equal to 120 um
+
+    iwp_gm_2  = ice_wp * 1000.0_jprb
+
+    lu_idx = floor(de_um * lu_scale - lu_offset)
+    wts_2  = (de_um * lu_scale - lu_offset) - lu_idx
+    wts_1  = 1.0_jprb - wts_2
+    od     = 0.001_jprb * iwp_gm_2 * & 
+             & ( wts_1 * coeff(1:nb,lu_idx) + wts_2 * coeff(1:nb,lu_idx+1) )
+    scat_od = od * & 
+             & ( wts_1 * coeff(1:nb,lu_idx+NSingleCoeffs) + wts_2 * coeff(1:nb,lu_idx+NSingleCoeffs+1) )
+    g = wts_1 * coeff(1:nb,lu_idx+2*NSingleCoeffs) + wts_2 * coeff(1:nb,lu_idx+2*NSingleCoeffs+1)
+
+    !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_yi_sw',1,hook_handle)
+
+  end subroutine calc_ice_optics_yi_sw
+
+
+  !---------------------------------------------------------------------
+  ! Compute longwave ice-particle scattering properties using Yi et
+  ! al. (2013) parameterization
+  subroutine calc_ice_optics_yi_lw(nb, coeff, ice_wp, &
+       &  re, od, scat_od, g)
+
+    use parkind1, only : jprb, jpim
+    !use yomhook,  only : lhook, dr_hook
+
+    ! Number of bands
+    integer, intent(in)  :: nb
+    ! Coefficients read from a data file
+    real(jprb), intent(in) :: coeff(:,:)
+    ! Ice water path (kg m-2)
+    real(jprb), intent(in) :: ice_wp
+    ! Effective radius (m)
+    real(jprb), intent(in) :: re
+    ! Total optical depth, scattering optical depth and asymmetry factor
+    real(jprb), intent(out) :: od(nb), scat_od(nb), g(nb)
+
+    ! Yi's effective diameter (microns)
+    real(jprb) :: de_um
+    ! Ice water path in g m-2
+    real (jprb) :: iwp_gm_2
+    ! LUT temp variables
+    real(jprb) :: wts_1, wts_2
+    integer(jpim) :: lu_idx
+    real(kind=jprb), parameter    :: lu_scale  = 0.2_jprb
+    real(kind=jprb), parameter    :: lu_offset = 1.0_jprb
+    !real(jprb)  :: hook_handle
+
+    !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_yi_sw',0,hook_handle)
+
+    ! Convert to effective diameter using the relationship in the IFS
+    !de_um     = re * (1.0e6_jprb / 0.64952_jprb)
+    de_um     = re * 2.0e6_jprb
+
+    ! limit de_um to validity of LUT
+    de_um = max(de_um,10.0_jprb)
+    de_um = min(de_um,119.99_jprb) !avoid greater than or equal to 120 um
+
+    iwp_gm_2  = ice_wp * 1000.0_jprb
+
+    lu_idx = floor(de_um * lu_scale - lu_offset)
+    wts_2  = (de_um * lu_scale - lu_offset) - lu_idx
+    wts_1  = 1.0_jprb - wts_2
+    od     = 0.001_jprb * iwp_gm_2 * & 
+             & ( wts_1 * coeff(1:nb,lu_idx) + wts_2 * coeff(1:nb,lu_idx+1) )
+    scat_od = od * & 
+             & ( wts_1 * coeff(1:nb,lu_idx+NSingleCoeffs) + wts_2 * coeff(1:nb,lu_idx+NSingleCoeffs+1) )
+    g = wts_1 * coeff(1:nb,lu_idx+2*NSingleCoeffs) + wts_2 * coeff(1:nb,lu_idx+2*NSingleCoeffs+1)
+
+     !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_yi_lw',1,hook_handle)
+
+  end subroutine calc_ice_optics_yi_lw
+
+end module radiation_ice_optics_yi
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_ifs_rrtm.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_ifs_rrtm.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_ifs_rrtm.F90	(revision 3908)
@@ -0,0 +1,871 @@
+! radiation_ifs_rrtm.F90 - Interface to IFS implementation of RRTM-G
+!
+! (C) Copyright 2015- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2017-04-11  R. Hogan  Receive "surface" dummy argument
+!   2017-09-08  R. Hogan  Reverted some changes
+!   2017-10-18  R. Hogan  Added planck_function public function
+!   2018-01-11  R. Hogan  Added optional spectral scaling of incoming solar radiation
+!   2018-02-22  R. Hogan  Optimized reverse indexing of heights
+!   2018-05-05  R. Hogan  gas_optics can be called for reduced number of levels
+!   2019-01-02  R. Hogan  Initialize shortwave props to zero in case sun below horizon
+
+module radiation_ifs_rrtm
+
+  implicit none
+
+  public  :: setup_gas_optics, gas_optics, planck_function, set_gas_units
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Setup the IFS implementation of RRTM-G gas absorption model
+  subroutine setup_gas_optics(config, directory)
+
+    use yoerrtm,   only : jpglw
+    use yoesrtm,   only : jpgsw
+    use yoerrtftr, only : ngb_lw => ngb
+    use yoesrtm,   only : ngb_sw => ngbsw
+    use yomhook,   only : lhook, dr_hook
+
+    use radiation_config
+
+    type(config_type), intent(inout), target :: config
+    character(len=*), intent(in)     :: directory
+
+    integer :: irep ! For implied do
+
+    integer, parameter :: RRTM_GPOINT_REORDERING_LW(140) = (/ &
+          &   89, 90, 139, 77, 137, 69, 131, 97, 91, 70, 78, 71, 53, 72, 123, 54, 79, 98,  &
+          &   92, 55, 80, 132, 124, 81, 73, 56, 99, 82, 57, 23, 125, 100, 24, 74, 93, 58, 25,  &
+          &   83, 126, 75, 26, 11, 101, 133, 59, 27, 76, 140, 12, 84, 102, 94, 28, 127, 85,  &
+          &   13, 39, 60, 86, 103, 87, 109, 14, 29, 115, 40, 95, 15, 61, 88, 41, 110, 104, 1,  &
+          &   116, 42, 30, 134, 128, 138, 96, 62, 16, 43, 117, 63, 111, 44, 2, 64, 31, 65,  &
+          &   105, 17, 45, 66, 118, 32, 3, 33, 67, 18, 129, 135, 46, 112, 34, 106, 68, 35, 4,  &
+          &   119, 36, 47, 107, 19, 37, 38, 113, 48, 130, 5, 120, 49, 108, 20, 50, 51, 114,  &
+          &   21, 121, 52, 136, 122, 6, 22, 7, 8, 9, 10 &
+          & /)
+    integer, parameter :: RRTM_GPOINT_REORDERING_SW(112) = (/ &
+          &   35, 45, 19, 27, 36, 57, 20, 46, 58, 21, 28, 67, 55, 68, 37, 1, 69, 22, 29, 59,  &
+          &   78, 101, 79, 77, 70, 76, 47, 75, 30, 81, 60, 102, 80, 82, 23, 2, 83, 84, 85,  &
+          &   86, 103, 61, 31, 87, 56, 38, 71, 48, 88, 3, 62, 89, 24, 7, 49, 32, 104, 72, 90,  &
+          &   63, 39, 4, 8, 50, 91, 64, 40, 33, 25, 51, 95, 96, 73, 65, 9, 41, 97, 92, 105,  &
+          &   52, 5, 98, 10, 42, 99, 100, 66, 11, 74, 34, 53, 26, 6, 106, 12, 43, 13, 54, 93,  &
+          &   44, 107, 94, 14, 108, 15, 16, 109, 17, 18, 110, 111, 112 &
+          & /)
+    
+    real(jprb) :: hook_handle
+
+#include "surdi.intfb.h"
+#include "surrtab.intfb.h"
+#include "surrtpk.intfb.h"
+#include "surrtrf.intfb.h"
+#include "rrtm_init_140gp.intfb.h"
+#include "srtm_init.intfb.h"
+
+    if (lhook) call dr_hook('radiation_ifs_rrtm:setup_gas_optics',0,hook_handle)
+
+    ! The IFS implementation of RRTMG uses many global variables.  In
+    ! the IFS these will have been set up already; otherwise set them
+    ! up now.
+    if (config%do_setup_ifsrrtm) then
+      call SURDI
+      call SURRTAB
+      call SURRTPK
+      call SURRTRF
+      call RRTM_INIT_140GP(directory)
+      call SRTM_INIT(directory)
+    end if
+
+    config%n_g_sw = jpgsw
+    config%n_g_lw = jpglw
+    config%n_bands_sw = 14
+    config%n_bands_lw = 16
+
+    ! Wavenumber ranges of each band may be needed so that the user
+    ! can compute UV and photosynthetically active radiation for a
+    ! particular wavelength range
+   if (.not.allocated(config%wavenumber1_sw)) then
+    allocate(config%wavenumber1_sw(config%n_bands_sw))
+   end if
+   if (.not.allocated(config%wavenumber2_sw)) then
+    allocate(config%wavenumber2_sw(config%n_bands_sw))
+   end if
+   if (.not.allocated(config%wavenumber1_lw)) then
+    allocate(config%wavenumber1_lw(config%n_bands_lw))
+   end if
+   if (.not.allocated(config%wavenumber2_lw)) then
+    allocate(config%wavenumber2_lw(config%n_bands_lw))
+   end if
+    config%wavenumber1_lw = (/ 10, 350, 500, 630, 700, 820, 980, 1080, 1180, 1390, 1480, &
+         &  1800, 2080, 2250, 2380, 2600 /)
+    config%wavenumber2_lw = (/ 350, 500, 630, 700, 820, 980, 1080, 1180, 1390, 1480, 1800, &
+         &  2080, 2250, 2380, 2600, 3250 /)
+    config%wavenumber1_sw = (/ 2600, 3250, 4000, 4650, 5150, 6150, 7700, 8050, 12850, &
+         &  16000 , 22650, 29000, 38000, 820 /)
+    config%wavenumber2_sw = (/ 3250, 4000, 4650, 5150, 6150, 7700, 8050, 12850, 16000, &
+         &  22650, 29000, 38000, 50000, 2600 /)
+
+   if (.not.allocated(config%i_band_from_g_sw)) then
+    allocate(config%i_band_from_g_sw          (config%n_g_sw))
+   end if
+   if (.not.allocated(config%i_band_from_g_lw)) then
+    allocate(config%i_band_from_g_lw          (config%n_g_lw))
+   end if
+   if (.not.allocated(config%i_band_from_reordered_g_sw)) then
+    allocate(config%i_band_from_reordered_g_sw(config%n_g_sw))
+   end if
+   if (.not.allocated(config%i_band_from_reordered_g_lw)) then
+    allocate(config%i_band_from_reordered_g_lw(config%n_g_lw))
+   end if
+   if (.not.allocated(config%i_g_from_reordered_g_sw)) then
+    allocate(config%i_g_from_reordered_g_sw(config%n_g_sw))
+   end if
+   if (.not.allocated(config%i_g_from_reordered_g_lw)) then
+    allocate(config%i_g_from_reordered_g_lw(config%n_g_lw))
+   end if
+
+    ! Shortwave starts at 16: need to start at 1
+    config%i_band_from_g_sw = ngb_sw - ngb_sw(1)+1
+    config%i_band_from_g_lw = ngb_lw
+
+    if (config%i_solver_sw == ISolverSpartacus) then
+      ! SPARTACUS requires g points ordered in approximately
+      ! increasing order of optical depth
+      config%i_g_from_reordered_g_sw = RRTM_GPOINT_REORDERING_SW
+    else
+      ! Implied-do for no reordering
+!      config%i_g_from_reordered_g_sw = RRTM_GPOINT_REORDERING_SW
+      config%i_g_from_reordered_g_sw = (/ (irep, irep=1,config%n_g_sw) /)
+    end if
+
+    if (config%i_solver_lw == ISolverSpartacus) then
+      ! SPARTACUS requires g points ordered in approximately
+      ! increasing order of optical depth
+      config%i_g_from_reordered_g_lw = RRTM_GPOINT_REORDERING_LW
+    else
+      ! Implied-do for no reordering
+      config%i_g_from_reordered_g_lw = (/ (irep, irep=1,config%n_g_lw) /)
+    end if
+
+    config%i_band_from_reordered_g_sw &
+         = config%i_band_from_g_sw(config%i_g_from_reordered_g_sw)
+
+    config%i_band_from_reordered_g_lw &
+         = config%i_band_from_g_lw(config%i_g_from_reordered_g_lw)
+
+    ! The i_spec_* variables are used solely for storing spectral
+    ! data, and this can either be by band or by g-point
+    if (config%do_save_spectral_flux) then
+      if (config%do_save_gpoint_flux) then
+        config%n_spec_sw = config%n_g_sw
+        config%n_spec_lw = config%n_g_lw
+        config%i_spec_from_reordered_g_sw => config%i_g_from_reordered_g_sw
+        config%i_spec_from_reordered_g_lw => config%i_g_from_reordered_g_lw
+      else
+        config%n_spec_sw = config%n_bands_sw
+        config%n_spec_lw = config%n_bands_lw
+        config%i_spec_from_reordered_g_sw => config%i_band_from_reordered_g_sw
+        config%i_spec_from_reordered_g_lw => config%i_band_from_reordered_g_lw
+      end if
+    else
+      config%n_spec_sw = 0
+      config%n_spec_lw = 0
+      nullify(config%i_spec_from_reordered_g_sw)
+      nullify(config%i_spec_from_reordered_g_lw)
+    end if
+
+    if (lhook) call dr_hook('radiation_ifs_rrtm:setup_gas_optics',1,hook_handle)
+
+  end subroutine setup_gas_optics
+
+
+  !---------------------------------------------------------------------
+  ! Scale gas mixing ratios according to required units
+  subroutine set_gas_units(gas)
+
+    use radiation_gas,           only : gas_type, IMassMixingRatio
+    type(gas_type),    intent(inout) :: gas
+
+    call gas%set_units(IMassMixingRatio)
+
+  end subroutine set_gas_units
+
+
+  !---------------------------------------------------------------------
+  ! Compute gas optical depths, shortwave scattering, Planck function
+  ! and incoming shortwave radiation at top-of-atmosphere
+  subroutine gas_optics(ncol,nlev,istartcol,iendcol, &
+       &  config, single_level, thermodynamics, gas, & 
+       &  od_lw, od_sw, ssa_sw, lw_albedo, planck_hl, lw_emission, &
+       &  incoming_sw)
+
+    use parkind1,                 only : jprb, jpim
+
+    USE PARRRTM  , ONLY : JPBAND, JPXSEC, JPINPX 
+    USE YOERRTM  , ONLY : JPGPT_LW => JPGPT
+    USE YOESRTM  , ONLY : JPGPT_SW => JPGPT  
+    !USE YOMDIMV  , ONLY : YRDIMV
+    use yomhook  , only : lhook, dr_hook
+
+    use radiation_config,         only : config_type, ISolverSpartacus
+    use radiation_thermodynamics, only : thermodynamics_type
+    use radiation_single_level,   only : single_level_type
+    use radiation_gas
+
+    integer, intent(in) :: ncol               ! number of columns
+    integer, intent(in) :: nlev               ! number of model levels
+    integer, intent(in) :: istartcol, iendcol ! range of columns to process
+    type(config_type), intent(in) :: config
+    type(single_level_type),  intent(in) :: single_level
+    type(thermodynamics_type),intent(in) :: thermodynamics
+    type(gas_type),           intent(in) :: gas
+
+    ! Longwave albedo of the surface
+    real(jprb), dimension(config%n_g_lw,istartcol:iendcol), &
+         &  intent(in), optional :: lw_albedo
+
+    ! Gaseous layer optical depth in longwave and shortwave, and
+    ! shortwave single scattering albedo (i.e. fraction of extinction
+    ! due to Rayleigh scattering) at each g-point
+    real(jprb), dimension(config%n_g_lw,nlev,istartcol:iendcol), intent(out) :: &
+         &   od_lw
+    real(jprb), dimension(config%n_g_sw,nlev,istartcol:iendcol), intent(out) :: &
+         &   od_sw, ssa_sw
+
+    ! The Planck function (emitted flux from a black body) at half
+    ! levels at each longwave g-point
+    real(jprb), dimension(config%n_g_lw,nlev+1,istartcol:iendcol), &
+         &   intent(out), optional :: planck_hl
+    ! Planck function for the surface (W m-2)
+    real(jprb), dimension(config%n_g_lw,istartcol:iendcol), &
+         &   intent(out), optional :: lw_emission
+
+    ! The incoming shortwave flux into a plane perpendicular to the
+    ! incoming radiation at top-of-atmosphere in each of the shortwave
+    ! g-points
+    real(jprb), dimension(config%n_g_sw,istartcol:iendcol), &
+         &   intent(out), optional :: incoming_sw
+
+    real(jprb) :: incoming_sw_scale(istartcol:iendcol)
+
+    ! The variables in capitals are used in the same way as the
+    ! equivalent routine in the IFS
+
+    real(jprb) :: ZOD_LW(JPGPT_LW,nlev,istartcol:iendcol) ! Note ordering of dimensions
+    real(jprb) :: ZOD_SW(istartcol:iendcol,nlev,JPGPT_SW)
+    real(jprb) :: ZSSA_SW(istartcol:iendcol,nlev,JPGPT_SW)
+    real(jprb) :: ZINCSOL(istartcol:iendcol,JPGPT_SW)
+
+    real(jprb) :: ZCOLMOL(istartcol:iendcol,nlev)
+    real(jprb) :: ZCOLDRY(istartcol:iendcol,nlev)
+    real(jprb) :: ZWBRODL(istartcol:iendcol,nlev) !BROADENING GASES,column density (mol/cm2)
+    real(jprb) :: ZCOLBRD(istartcol:iendcol,nlev) !BROADENING GASES, column amount
+    real(jprb) :: ZWKL(istartcol:iendcol,JPINPX,nlev)
+
+    real(jprb) :: ZWX(istartcol:iendcol,JPXSEC,nlev) ! Amount of trace gases
+    
+    real(jprb) :: ZFLUXFAC, ZPI
+
+    ! - from AER
+    real(jprb) :: ZTAUAERL(istartcol:iendcol,nlev,JPBAND)
+
+    !- from INTFAC      
+    real(jprb) :: ZFAC00(istartcol:iendcol,nlev)
+    real(jprb) :: ZFAC01(istartcol:iendcol,nlev)
+    real(jprb) :: ZFAC10(istartcol:iendcol,nlev)
+    real(jprb) :: ZFAC11(istartcol:iendcol,nlev)
+    
+    !- from FOR
+    real(jprb) :: ZFORFAC(istartcol:iendcol,nlev)
+    real(jprb) :: ZFORFRAC(istartcol:iendcol,nlev)
+    integer    :: INDFOR(istartcol:iendcol,nlev) 
+
+    !- from MINOR
+    integer    :: INDMINOR(istartcol:iendcol,nlev) 
+    real(jprb) :: ZSCALEMINOR(istartcol:iendcol,nlev) 
+    real(jprb) :: ZSCALEMINORN2(istartcol:iendcol,nlev) 
+    real(jprb) :: ZMINORFRAC(istartcol:iendcol,nlev) 
+    
+    real(jprb)     :: &                 
+         &  ZRAT_H2OCO2(istartcol:iendcol,nlev),ZRAT_H2OCO2_1(istartcol:iendcol,nlev), &
+         &  ZRAT_H2OO3(istartcol:iendcol,nlev) ,ZRAT_H2OO3_1(istartcol:iendcol,nlev), & 
+         &  ZRAT_H2ON2O(istartcol:iendcol,nlev),ZRAT_H2ON2O_1(istartcol:iendcol,nlev), &
+         &  ZRAT_H2OCH4(istartcol:iendcol,nlev),ZRAT_H2OCH4_1(istartcol:iendcol,nlev), &
+         &  ZRAT_N2OCO2(istartcol:iendcol,nlev),ZRAT_N2OCO2_1(istartcol:iendcol,nlev), &
+         &  ZRAT_O3CO2(istartcol:iendcol,nlev) ,ZRAT_O3CO2_1(istartcol:iendcol,nlev)
+    
+    !- from INTIND
+    integer :: JP(istartcol:iendcol,nlev)
+    integer :: JT(istartcol:iendcol,nlev)
+    integer :: JT1(istartcol:iendcol,nlev)
+
+    !- from PRECISE             
+    real(jprb) :: ZONEMINUS, ZONEMINUS_ARRAY(istartcol:iendcol)
+
+    !- from PROFDATA             
+    real(jprb) :: ZCOLH2O(istartcol:iendcol,nlev)
+    real(jprb) :: ZCOLCO2(istartcol:iendcol,nlev)
+    real(jprb) :: ZCOLO3(istartcol:iendcol,nlev)
+    real(jprb) :: ZCOLN2O(istartcol:iendcol,nlev)
+    real(jprb) :: ZCOLCH4(istartcol:iendcol,nlev)
+    real(jprb) :: ZCOLO2(istartcol:iendcol,nlev)
+    real(jprb) :: ZCO2MULT(istartcol:iendcol,nlev)
+    integer    :: ILAYTROP(istartcol:iendcol)
+    integer    :: ILAYSWTCH(istartcol:iendcol)
+    integer    :: ILAYLOW(istartcol:iendcol)
+
+    !- from PROFILE             
+    real(jprb) :: ZPAVEL(istartcol:iendcol,nlev)
+    real(jprb) :: ZTAVEL(istartcol:iendcol,nlev)
+    real(jprb) :: ZPZ(istartcol:iendcol,0:nlev)
+    real(jprb) :: ZTZ(istartcol:iendcol,0:nlev)
+    
+    !- from SELF             
+    real(jprb) :: ZSELFFAC(istartcol:iendcol,nlev)
+    real(jprb) :: ZSELFFRAC(istartcol:iendcol,nlev)
+    integer :: INDSELF(istartcol:iendcol,nlev)
+
+    !- from SP             
+    real(jprb) :: ZPFRAC(istartcol:iendcol,JPGPT_LW,nlev)
+    
+    !- from SURFACE             
+    integer :: IREFLECT(istartcol:iendcol)
+
+    real(jprb) :: pressure_fl(ncol, nlev), temperature_fl(ncol, nlev)
+
+    ! If nlev is less than the number of heights at which gas mixing
+    ! ratios are stored, then we assume that the lower part of the
+    ! atmosphere is required. This enables nlev=1 to be passed in to
+    ! the routine, in which case the gas properties of the lowest
+    ! layer are provided, useful for canopy radiative transfer.
+    integer :: istartlev, iendlev
+
+    integer :: jlev, jgreorder, jg, ig, iband, jcol
+
+    real(jprb) :: hook_handle
+
+#include "rrtm_prepare_gases.intfb.h"
+#include "rrtm_setcoef_140gp.intfb.h"
+#include "rrtm_gas_optical_depth.intfb.h"
+#include "srtm_setcoef.intfb.h"
+#include "srtm_gas_optical_depth.intfb.h"
+
+    if (lhook) call dr_hook('radiation_ifs_rrtm:gas_optics',0,hook_handle)
+
+    ! Compute start and end levels for indexing the gas mixing ratio
+    ! and thermodynamics arrays
+    iendlev   = ubound(gas%mixing_ratio,2)
+    istartlev = iendlev - nlev + 1
+
+    ZPI = 2.0_jprb*ASIN(1.0_jprb)
+    ZFLUXFAC = ZPI * 1.E+4
+    ZONEMINUS = 1.0_jprb - 1.0e-6_jprb
+    ZONEMINUS_ARRAY = ZONEMINUS
+
+!    if (.not. associated(YRDIMV)) then
+!      allocate(YRDIMV)
+!      YRDIMV%NFLEVG = nlev
+!    end if
+
+    pressure_fl(istartcol:iendcol,:) &
+         &  = 0.5_jprb * (thermodynamics%pressure_hl(istartcol:iendcol,istartlev:iendlev) &
+         &               +thermodynamics%pressure_hl(istartcol:iendcol,istartlev+1:iendlev+1))
+    temperature_fl(istartcol:iendcol,:) &
+         &  = 0.5_jprb * (thermodynamics%temperature_hl(istartcol:iendcol,istartlev:iendlev) &
+         &               +thermodynamics%temperature_hl(istartcol:iendcol,istartlev+1:iendlev+1))
+    
+    ! Check we have gas mixing ratios in the right units
+    call gas%assert_units(IMassMixingRatio)
+
+    ! Warning: O2 is hard-coded within the following function so the
+    ! user-provided concentrations of this gas are ignored for both
+    ! the longwave and shortwave
+    CALL RRTM_PREPARE_GASES &
+         & ( istartcol, iendcol, ncol, nlev, &
+         &   thermodynamics%pressure_hl(:,istartlev:iendlev+1), &
+         &   pressure_fl, &
+         &   thermodynamics%temperature_hl(:,istartlev:iendlev+1), &
+         &   temperature_fl, &
+         &   gas%mixing_ratio(:,istartlev:iendlev,IH2O), &
+         &   gas%mixing_ratio(:,istartlev:iendlev,ICO2), &
+         &   gas%mixing_ratio(:,istartlev:iendlev,ICH4), &
+         &   gas%mixing_ratio(:,istartlev:iendlev,IN2O), &
+         &   gas%mixing_ratio(:,istartlev:iendlev,INO2), &
+         &   gas%mixing_ratio(:,istartlev:iendlev,ICFC11), &
+         &   gas%mixing_ratio(:,istartlev:iendlev,ICFC12), &
+         &   gas%mixing_ratio(:,istartlev:iendlev,IHCFC22), &
+         &   gas%mixing_ratio(:,istartlev:iendlev,ICCl4), &
+         &   gas%mixing_ratio(:,istartlev:iendlev,IO3), &
+         &  ZCOLDRY, ZWBRODL,ZWKL, ZWX, &
+         &  ZPAVEL , ZTAVEL , ZPZ , ZTZ, IREFLECT)  
+
+    CALL RRTM_SETCOEF_140GP &
+         &( istartcol, iendcol, nlev , ZCOLDRY  , ZWBRODL , ZWKL , &
+         &  ZFAC00 , ZFAC01   , ZFAC10 , ZFAC11 , ZFORFAC,ZFORFRAC,INDFOR, JP, JT, JT1 , &
+         &  ZCOLH2O, ZCOLCO2  , ZCOLO3 , ZCOLN2O, ZCOLCH4, ZCOLO2,ZCO2MULT , ZCOLBRD, & 
+         &  ILAYTROP,ILAYSWTCH, ILAYLOW, ZPAVEL , ZTAVEL , ZSELFFAC, ZSELFFRAC, INDSELF, &
+         &  INDMINOR,ZSCALEMINOR,ZSCALEMINORN2,ZMINORFRAC,&
+         &  ZRAT_H2OCO2, ZRAT_H2OCO2_1, ZRAT_H2OO3, ZRAT_H2OO3_1, &
+         &  ZRAT_H2ON2O, ZRAT_H2ON2O_1, ZRAT_H2OCH4, ZRAT_H2OCH4_1, &
+         &  ZRAT_N2OCO2, ZRAT_N2OCO2_1, ZRAT_O3CO2, ZRAT_O3CO2_1)   
+
+    ZTAUAERL = 0.0_jprb
+
+    CALL RRTM_GAS_OPTICAL_DEPTH &
+         &( istartcol, iendcol, nlev, ZOD_LW, ZPAVEL, ZCOLDRY, ZCOLBRD, ZWX ,&
+         &  ZTAUAERL, ZFAC00 , ZFAC01, ZFAC10 , ZFAC11 , ZFORFAC,ZFORFRAC,INDFOR, &
+         &  JP, JT, JT1, ZONEMINUS ,&
+         &  ZCOLH2O , ZCOLCO2, ZCOLO3, ZCOLN2O, ZCOLCH4, ZCOLO2,ZCO2MULT ,&
+         &  ILAYTROP, ILAYSWTCH,ILAYLOW, ZSELFFAC, ZSELFFRAC, INDSELF, ZPFRAC, &
+         &  INDMINOR,ZSCALEMINOR,ZSCALEMINORN2,ZMINORFRAC,&
+         &  ZRAT_H2OCO2, ZRAT_H2OCO2_1, ZRAT_H2OO3, ZRAT_H2OO3_1, &
+         &  ZRAT_H2ON2O, ZRAT_H2ON2O_1, ZRAT_H2OCH4, ZRAT_H2OCH4_1, &
+         &  ZRAT_N2OCO2, ZRAT_N2OCO2_1, ZRAT_O3CO2, ZRAT_O3CO2_1)      
+
+    if (present(lw_albedo)) then
+    
+      call planck_function_atmos(nlev, istartcol, iendcol, config, &
+           &                     thermodynamics, ZPFRAC, planck_hl)
+
+      if (single_level%is_simple_surface) then
+        call planck_function_surf(istartcol, iendcol, config, &
+             &                    single_level%skin_temperature, ZPFRAC(:,:,1), &
+             &                    lw_emission)
+        
+        ! The following can be used to extract the parameters defined at
+        ! the top of the planck_function routine below:
+        !write(*,'(a,140(e12.5,","),a)') 'ZPFRAC_surf=[', &
+        !&  sum(ZPFRAC(istartcol:iendcol,:,1),1) / (iendcol+1-istartcol), ']'
+        
+        ! lw_emission at this point is actually the planck function of
+        ! the surface
+        lw_emission = lw_emission * (1.0_jprb - lw_albedo)
+      else
+      ! Longwave emission has already been computed
+        if (config%use_canopy_full_spectrum_lw) then
+          lw_emission = transpose(single_level%lw_emission(istartcol:iendcol,:))
+        else
+          lw_emission = transpose(single_level%lw_emission(istartcol:iendcol, &
+               & config%i_emiss_from_band_lw(config%i_band_from_reordered_g_lw)))
+        end if
+      end if
+
+    end if
+
+    if (config%i_solver_lw == ISolverSpartacus) then
+      !    if (.true.) then
+      ! We need to rearrange the gas optics info in memory: reordering
+      ! the g points in order of approximately increasing optical
+      ! depth (for efficient 3D processing on only the regions of the
+      ! spectrum that are optically thin for gases) and reorder in
+      ! pressure since the the functions above treat pressure
+      ! decreasing with increasing index.  Note that the output gas
+      ! arrays have dimensions in a different order to the inputs,
+      ! so there is some inefficiency here.
+      do jgreorder = 1,config%n_g_lw
+        iband = config%i_band_from_reordered_g_lw(jgreorder)
+        ig = config%i_g_from_reordered_g_lw(jgreorder)
+        
+        ! Top-of-atmosphere half level
+        do jlev = 1,nlev
+          do jcol = istartcol,iendcol
+            ! Some g points can return negative optical depths;
+            ! specifically original g points 54-56 which causes
+            ! unphysical single-scattering albedo when combined with
+            ! aerosol
+            od_lw(jgreorder,jlev,jcol) &
+                 &   = max(config%min_gas_od_lw, ZOD_LW(ig,nlev+1-jlev,jcol))
+          end do
+        end do
+      end do
+    else
+      ! G points have not been reordered 
+      do jcol = istartcol,iendcol
+        do jlev = 1,nlev
+          ! Check for negative optical depth
+          od_lw(:,jlev,jcol) = max(config%min_gas_od_lw, ZOD_LW(:,nlev+1-jlev,jcol))
+        end do
+      end do
+    end if
+    
+    CALL SRTM_SETCOEF &
+         & ( istartcol, iendcol, nlev,&
+         & ZPAVEL  , ZTAVEL,&
+         & ZCOLDRY , ZWKL,&
+         & ILAYTROP,&
+         & ZCOLCH4  , ZCOLCO2 , ZCOLH2O , ZCOLMOL  , ZCOLO2 , ZCOLO3,&
+         & ZFORFAC , ZFORFRAC , INDFOR  , ZSELFFAC, ZSELFFRAC, INDSELF, &
+         & ZFAC00  , ZFAC01   , ZFAC10  , ZFAC11,&
+         & JP      , JT       , JT1     , single_level%cos_sza(istartcol:iendcol)  &
+         & )  
+    
+    ! SRTM_GAS_OPTICAL_DEPTH will not initialize profiles when the sun
+    ! is below the horizon, so we do it here
+    ZOD_SW(istartcol:iendcol,:,:)  = 0.0_jprb
+    ZSSA_SW(istartcol:iendcol,:,:) = 0.0_jprb
+    ZINCSOL(istartcol:iendcol,:)   = 0.0_jprb
+
+    CALL SRTM_GAS_OPTICAL_DEPTH &
+         &( istartcol, iendcol , nlev  , ZONEMINUS_ARRAY,&
+         & single_level%cos_sza(istartcol:iendcol), ILAYTROP,&
+         & ZCOLCH4 , ZCOLCO2  , ZCOLH2O, ZCOLMOL , ZCOLO2   , ZCOLO3,&
+         & ZFORFAC , ZFORFRAC , INDFOR , ZSELFFAC, ZSELFFRAC, INDSELF,&
+         & ZFAC00  , ZFAC01   , ZFAC10 , ZFAC11  ,&
+         & JP      , JT       , JT1    ,&
+         & ZOD_SW  , ZSSA_SW  , ZINCSOL )
+    
+    ! Scale the incoming solar per band, if requested
+    if (config%use_spectral_solar_scaling) then
+      ZINCSOL(istartcol:iendcol,:) = ZINCSOL(istartcol:iendcol,:) &
+         & * spread(single_level%spectral_solar_scaling(config%i_band_from_reordered_g_sw), &
+         &                                              1,iendcol-istartcol+1)
+    end if
+
+    ! Scaling factor to ensure that the total solar irradiance is as
+    ! requested.  Note that if the sun is below the horizon then
+    ! ZINCSOL will be zero.
+    if (present(incoming_sw)) then
+      incoming_sw_scale = 1.0_jprb
+      do jcol = istartcol,iendcol
+        if (single_level%cos_sza(jcol) > 0.0_jprb) then
+          incoming_sw_scale(jcol) = single_level%solar_irradiance / sum(ZINCSOL(jcol,:))
+        end if
+      end do
+    end if
+
+    if (config%i_solver_sw == ISolverSpartacus) then
+!    if (.true.) then
+      ! Account for reordered g points
+      do jgreorder = 1,config%n_g_sw
+        ig = config%i_g_from_reordered_g_sw(jgreorder)
+        do jlev = 1,nlev
+          do jcol = istartcol,iendcol
+            ! Check for negative optical depth
+            od_sw (jgreorder,nlev+1-jlev,jcol) &
+                 &  = max(config%min_gas_od_sw, ZOD_SW (jcol,jlev,ig))
+            ssa_sw(jgreorder,nlev+1-jlev,jcol) = ZSSA_SW(jcol,jlev,ig)
+           end do
+        end do
+        if (present(incoming_sw)) then
+          incoming_sw(jgreorder,:) &
+               &  = incoming_sw_scale(:) * ZINCSOL(:,ig)
+        end if
+      end do
+    else
+      ! G points have not been reordered
+      do jg = 1,config%n_g_sw
+        do jlev = 1,nlev
+          do jcol = istartcol,iendcol
+            ! Check for negative optical depth
+            od_sw (jg,nlev+1-jlev,jcol) = max(config%min_gas_od_sw, ZOD_SW(jcol,jlev,jg))
+            ssa_sw(jg,nlev+1-jlev,jcol) = ZSSA_SW(jcol,jlev,jg)
+          end do
+        end do
+        if (present(incoming_sw)) then
+          incoming_sw(jg,:) &
+               &  = incoming_sw_scale(:) * ZINCSOL(:,jg)
+        end if
+      end do
+    end if
+    
+    if (lhook) call dr_hook('radiation_ifs_rrtm:gas_optics',1,hook_handle)
+    
+  end subroutine gas_optics
+  
+
+  !---------------------------------------------------------------------
+  ! Compute Planck function of the atmosphere
+  subroutine planck_function_atmos(nlev,istartcol,iendcol, &
+       config, thermodynamics, PFRAC, &
+       planck_hl)
+
+    use parkind1,                 only : jprb, jpim
+
+    USE YOERRTM  , ONLY : JPGPT_LW => JPGPT
+    use yoerrtwn, only : totplnk, delwave
+
+    use yomhook, only : lhook, dr_hook
+
+    use radiation_config,         only : config_type, ISolverSpartacus
+    use radiation_thermodynamics, only : thermodynamics_type
+    !use radiation_gas
+
+    integer, intent(in) :: nlev               ! number of model levels
+    integer, intent(in) :: istartcol, iendcol ! range of columns to process
+    type(config_type), intent(in) :: config
+    type(thermodynamics_type),intent(in) :: thermodynamics
+    real(jprb), intent(in) :: PFRAC(istartcol:iendcol,JPGPT_LW,nlev)
+
+    ! The Planck function (emitted flux from a black body) at half
+    ! levels at each longwave g-point
+    real(jprb), dimension(config%n_g_lw,nlev+1,istartcol:iendcol), intent(out) :: &
+         &   planck_hl
+
+    ! Planck function values per band
+    real(jprb), dimension(istartcol:iendcol, config%n_bands_lw) :: planck_store
+
+    ! Look-up table variables for Planck function
+    real(jprb), dimension(istartcol:iendcol) :: frac
+    integer,    dimension(istartcol:iendcol) :: ind
+
+    ! Temperature (K) of a half-level
+    real(jprb) :: temperature
+
+    real(jprb) :: factor
+    real(jprb) :: ZFLUXFAC
+
+    integer :: jlev, jgreorder, jg, ig, iband, jband, jcol, ilevoffset
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_ifs_rrtm:planck_function_atmos',0,hook_handle)
+
+    ZFLUXFAC = 2.0_jprb*ASIN(1.0_jprb) * 1.0e4_jprb
+    
+    ! nlev may be less than the number of original levels, in which
+    ! case we assume that the user wants the lower part of the
+    ! atmosphere
+    ilevoffset = ubound(thermodynamics%temperature_hl,2)-nlev-1
+
+    ! Work out interpolations: for each half level, the index of the
+    ! lowest interpolation bound, and the fraction into interpolation
+    ! interval
+    do jlev = 1,nlev+1
+      do jcol = istartcol,iendcol
+        temperature = thermodynamics%temperature_hl(jcol,jlev+ilevoffset)
+        if (temperature < 339.0_jprb .and. temperature >= 160.0_jprb) then
+          ! Linear interpolation between -113 and 66 degC
+          ind(jcol)  = int(temperature - 159.0_jprb)
+          frac(jcol) = temperature - int(temperature)
+        else if(temperature >= 339.0_jprb) then
+          ! Extrapolation above 66 degC
+          ind(jcol)  = 180
+          frac(jcol) = temperature - 339.0_jprb
+        else
+          ! Cap below -113 degC (to avoid possible negative Planck
+          ! function values)
+          ind(jcol)  = 1
+          frac(jcol) = 0.0_jprb
+        end if
+      end do
+
+      ! Calculate Planck functions per band
+      do jband = 1,config%n_bands_lw
+        factor = zfluxfac * delwave(jband)
+        do jcol = istartcol,iendcol
+          planck_store(jcol,jband) = factor &
+               &  * (totplnk(ind(jcol),jband) &
+               &  + frac(jcol)*(totplnk(ind(jcol)+1,jband)-totplnk(ind(jcol),jband)))
+        end do
+      end do
+
+      if (config%i_solver_lw == ISolverSpartacus) then
+        ! We need to rearrange the gas optics info in memory:
+        ! reordering the g points in order of approximately increasing
+        ! optical depth (for efficient 3D processing on only the
+        ! regions of the spectrum that are optically thin for gases)
+        ! and reorder in pressure since the the functions above treat
+        ! pressure decreasing with increasing index.
+        if (jlev == 1) then
+          ! Top-of-atmosphere half level - note that PFRAC is on model
+          ! levels not half levels
+          do jgreorder = 1,config%n_g_lw
+            iband = config%i_band_from_reordered_g_lw(jgreorder)
+            ig = config%i_g_from_reordered_g_lw(jgreorder)
+            planck_hl(jgreorder,1,:) = planck_store(:,iband) &
+                 &   * PFRAC(:,ig,nlev)
+          end do
+        else
+          do jgreorder = 1,config%n_g_lw
+            iband = config%i_band_from_reordered_g_lw(jgreorder)
+            ig = config%i_g_from_reordered_g_lw(jgreorder)
+            planck_hl(jgreorder,jlev,:) &
+                   &   = planck_store(:,iband) &
+                   &   * PFRAC(:,ig,nlev+2-jlev)
+          end do
+        end if
+      else
+        ! G points have not been reordered 
+        if (jlev == 1) then
+          ! Top-of-atmosphere half level - note that PFRAC is on model
+          ! levels not half levels
+          do jg = 1,config%n_g_lw
+            iband = config%i_band_from_g_lw(jg)
+            planck_hl(jg,1,:) = planck_store(:,iband) * PFRAC(:,jg,nlev)
+          end do
+        else
+          do jg = 1,config%n_g_lw
+            iband = config%i_band_from_g_lw(jg)
+            planck_hl(jg,jlev,:) = planck_store(:,iband) * PFRAC(:,jg,nlev+2-jlev)
+          end do
+        end if
+      end if
+    end do
+
+    if (lhook) call dr_hook('radiation_ifs_rrtm:planck_function_atmos',1,hook_handle)
+
+  end subroutine planck_function_atmos
+
+
+  !---------------------------------------------------------------------
+  ! Compute Planck function of the surface
+  subroutine planck_function_surf(istartcol, iendcol, config, temperature, PFRAC, &
+       &  planck_surf)
+
+    use parkind1,                 only : jprb, jpim
+
+    USE YOERRTM  , ONLY : JPGPT_LW => JPGPT
+    use yoerrtwn, only : totplnk, delwave
+
+    use yomhook, only : lhook, dr_hook
+
+    use radiation_config,         only : config_type, ISolverSpartacus
+    !    use radiation_gas
+
+    integer, intent(in) :: istartcol, iendcol ! range of columns to process
+    type(config_type), intent(in) :: config
+    real(jprb), intent(in) :: temperature(:)
+
+    real(jprb), intent(in) :: PFRAC(istartcol:iendcol,JPGPT_LW)
+
+    ! Planck function of the surface (W m-2)
+    real(jprb), dimension(config%n_g_lw,istartcol:iendcol), &
+         &  intent(out) :: planck_surf
+
+    ! Planck function values per band
+    real(jprb), dimension(istartcol:iendcol, config%n_bands_lw) :: planck_store
+
+    ! Look-up table variables for Planck function
+    real(jprb), dimension(istartcol:iendcol) :: frac
+    integer,    dimension(istartcol:iendcol) :: ind
+
+    ! Temperature (K)
+    real(jprb) :: Tsurf
+
+    real(jprb) :: factor
+    real(jprb) :: ZFLUXFAC
+
+    integer :: jgreorder, jg, ig, iband, jband, jcol
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_ifs_rrtm:planck_function_surf',0,hook_handle)
+
+    ZFLUXFAC = 2.0_jprb*ASIN(1.0_jprb) * 1.0e4_jprb
+
+    ! Work out surface interpolations
+    do jcol = istartcol,iendcol
+      Tsurf = temperature(jcol)
+      if (Tsurf < 339.0_jprb .and. Tsurf >= 160.0_jprb) then
+        ! Linear interpolation between -113 and 66 degC
+        ind(jcol)  = int(Tsurf - 159.0_jprb)
+        frac(jcol) = Tsurf - int(Tsurf)
+      else if(Tsurf >= 339.0_jprb) then
+        ! Extrapolation above 66 degC
+        ind(jcol)  = 180
+        frac(jcol) = Tsurf - 339.0_jprb
+      else
+        ! Cap below -113 degC (to avoid possible negative Planck
+        ! function values)
+        ind(jcol)  = 1
+        frac(jcol) = 0.0_jprb
+      end if
+    end do
+
+    ! Calculate Planck functions per band
+    do jband = 1,config%n_bands_lw
+      factor = zfluxfac * delwave(jband)
+      do jcol = istartcol,iendcol
+        planck_store(jcol,jband) = factor &
+             &  * (totplnk(ind(jcol),jband) &
+             &  + frac(jcol)*(totplnk(ind(jcol)+1,jband)-totplnk(ind(jcol),jband)))
+      end do
+    end do
+
+    if (config%i_solver_lw == ISolverSpartacus) then
+      ! We need to rearrange the gas optics info in memory: reordering
+      ! the g points in order of approximately increasing optical
+      ! depth (for efficient 3D processing on only the regions of
+      ! the spectrum that are optically thin for gases) and reorder
+      ! in pressure since the the functions above treat pressure
+      ! decreasing with increasing index.
+      do jgreorder = 1,config%n_g_lw
+        iband = config%i_band_from_reordered_g_lw(jgreorder)
+        ig = config%i_g_from_reordered_g_lw(jgreorder)
+        planck_surf(jgreorder,:) = planck_store(:,iband) * PFRAC(:,ig)
+      end do
+    else
+      ! G points have not been reordered 
+      do jg = 1,config%n_g_lw
+        iband = config%i_band_from_g_lw(jg)
+        planck_surf(jg,:) = planck_store(:,iband) * PFRAC(:,jg)
+      end do
+    end if
+
+    if (lhook) call dr_hook('radiation_ifs_rrtm:planck_function_surf',1,hook_handle)
+    
+  end subroutine planck_function_surf
+
+
+  !---------------------------------------------------------------------
+  ! Externally facing function for computing the Planck function
+  ! without reference to any gas profile; typically this would be used
+  ! for computing the emission by facets of a complex surface.  Note
+  ! that this uses fixed "PFRAC" values, obtained by averaging over
+  ! those derived from RRTM-G for near-surface conditions over a line
+  ! of meridian from the ECMWF model.
+  subroutine planck_function(config, temperature, planck_surf)
+
+    use parkind1,                 only : jprb, jpim
+
+    use radiation_config,         only : config_type
+
+    type(config_type), intent(in) :: config
+    real(jprb), intent(in) :: temperature
+
+    ! Planck function of the surface (W m-2)
+    real(jprb), dimension(config%n_g_lw), &
+         &  intent(out) :: planck_surf
+
+    ! Fraction of each band contributed by each g-point within
+    ! it. Since there are 16 bands, this array sums to 16
+    real(jprb), parameter, dimension(1,140) :: frac &
+         = reshape( (/ 0.21227E+00, 0.18897E+00, 0.25491E+00, 0.17864E+00, 0.11735E+00, 0.38298E-01, 0.57871E-02, &
+         &    0.31753E-02, 0.53169E-03, 0.76476E-04, 0.16388E+00, 0.15241E+00, 0.14290E+00, 0.12864E+00, &
+         &    0.11615E+00, 0.10047E+00, 0.80013E-01, 0.60445E-01, 0.44918E-01, 0.63395E-02, 0.32942E-02, &
+         &    0.54541E-03, 0.15380E+00, 0.15194E+00, 0.14339E+00, 0.13138E+00, 0.11701E+00, 0.10081E+00, &
+         &    0.82296E-01, 0.61735E-01, 0.41918E-01, 0.45918E-02, 0.37743E-02, 0.30121E-02, 0.22500E-02, &
+         &    0.14490E-02, 0.55410E-03, 0.78364E-04, 0.15938E+00, 0.15146E+00, 0.14213E+00, 0.13079E+00, &
+         &    0.11672E+00, 0.10053E+00, 0.81566E-01, 0.61126E-01, 0.41150E-01, 0.44488E-02, 0.36950E-02, &
+         &    0.29101E-02, 0.21357E-02, 0.19609E-02, 0.14134E+00, 0.14390E+00, 0.13913E+00, 0.13246E+00, &
+         &    0.12185E+00, 0.10596E+00, 0.87518E-01, 0.66164E-01, 0.44862E-01, 0.49402E-02, 0.40857E-02, &
+         &    0.32288E-02, 0.23613E-02, 0.15406E-02, 0.58258E-03, 0.82171E-04, 0.29127E+00, 0.28252E+00, &
+         &    0.22590E+00, 0.14314E+00, 0.45494E-01, 0.71792E-02, 0.38483E-02, 0.65712E-03, 0.29810E+00, &
+         &    0.27559E+00, 0.11997E+00, 0.10351E+00, 0.84515E-01, 0.62253E-01, 0.41050E-01, 0.44217E-02, &
+         &    0.36946E-02, 0.29113E-02, 0.34290E-02, 0.55993E-03, 0.31441E+00, 0.27586E+00, 0.21297E+00, &
+         &    0.14064E+00, 0.45588E-01, 0.65665E-02, 0.34232E-02, 0.53199E-03, 0.19811E+00, 0.16833E+00, &
+         &    0.13536E+00, 0.11549E+00, 0.10649E+00, 0.93264E-01, 0.75720E-01, 0.56405E-01, 0.41865E-01, &
+         &    0.59331E-02, 0.26510E-02, 0.40040E-03, 0.32328E+00, 0.26636E+00, 0.21397E+00, 0.14038E+00, &
+         &    0.52142E-01, 0.38852E-02, 0.14601E+00, 0.13824E+00, 0.27703E+00, 0.22388E+00, 0.15446E+00, &
+         &    0.48687E-01, 0.98054E-02, 0.18870E-02, 0.11961E+00, 0.12106E+00, 0.13215E+00, 0.13516E+00, &
+         &    0.25249E+00, 0.16542E+00, 0.68157E-01, 0.59725E-02, 0.49258E+00, 0.33651E+00, 0.16182E+00, &
+         &    0.90984E-02, 0.95202E+00, 0.47978E-01, 0.91716E+00, 0.82857E-01, 0.77464E+00, 0.22536E+00 /), (/ 1,140 /) )
+
+    call planck_function_surf(1, 1, config, spread(temperature,1,1), &
+         &                    frac, planck_surf)
+
+  end subroutine planck_function
+
+end module radiation_ifs_rrtm
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_ifs_rrtm.F90.or
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_ifs_rrtm.F90.or	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_ifs_rrtm.F90.or	(revision 3908)
@@ -0,0 +1,851 @@
+! radiation_ifs_rrtm.F90 - Interface to IFS implementation of RRTM-G
+!
+! (C) Copyright 2015- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2017-04-11  R. Hogan  Receive "surface" dummy argument
+!   2017-09-08  R. Hogan  Reverted some changes
+!   2017-10-18  R. Hogan  Added planck_function public function
+!   2018-01-11  R. Hogan  Added optional spectral scaling of incoming solar radiation
+!   2018-02-22  R. Hogan  Optimized reverse indexing of heights
+!   2018-05-05  R. Hogan  gas_optics can be called for reduced number of levels
+!   2019-01-02  R. Hogan  Initialize shortwave props to zero in case sun below horizon
+
+module radiation_ifs_rrtm
+
+  implicit none
+
+  public  :: setup_gas_optics, gas_optics, planck_function, set_gas_units
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Setup the IFS implementation of RRTM-G gas absorption model
+  subroutine setup_gas_optics(config, directory)
+
+    use yoerrtm,   only : jpglw
+    use yoesrtm,   only : jpgsw
+    use yoerrtftr, only : ngb_lw => ngb
+    use yoesrtm,   only : ngb_sw => ngbsw
+    use yomhook,   only : lhook, dr_hook
+
+    use radiation_config
+
+    type(config_type), intent(inout), target :: config
+    character(len=*), intent(in)     :: directory
+
+    integer :: irep ! For implied do
+
+    integer, parameter :: RRTM_GPOINT_REORDERING_LW(140) = (/ &
+          &   89, 90, 139, 77, 137, 69, 131, 97, 91, 70, 78, 71, 53, 72, 123, 54, 79, 98,  &
+          &   92, 55, 80, 132, 124, 81, 73, 56, 99, 82, 57, 23, 125, 100, 24, 74, 93, 58, 25,  &
+          &   83, 126, 75, 26, 11, 101, 133, 59, 27, 76, 140, 12, 84, 102, 94, 28, 127, 85,  &
+          &   13, 39, 60, 86, 103, 87, 109, 14, 29, 115, 40, 95, 15, 61, 88, 41, 110, 104, 1,  &
+          &   116, 42, 30, 134, 128, 138, 96, 62, 16, 43, 117, 63, 111, 44, 2, 64, 31, 65,  &
+          &   105, 17, 45, 66, 118, 32, 3, 33, 67, 18, 129, 135, 46, 112, 34, 106, 68, 35, 4,  &
+          &   119, 36, 47, 107, 19, 37, 38, 113, 48, 130, 5, 120, 49, 108, 20, 50, 51, 114,  &
+          &   21, 121, 52, 136, 122, 6, 22, 7, 8, 9, 10 &
+          & /)
+    integer, parameter :: RRTM_GPOINT_REORDERING_SW(112) = (/ &
+          &   35, 45, 19, 27, 36, 57, 20, 46, 58, 21, 28, 67, 55, 68, 37, 1, 69, 22, 29, 59,  &
+          &   78, 101, 79, 77, 70, 76, 47, 75, 30, 81, 60, 102, 80, 82, 23, 2, 83, 84, 85,  &
+          &   86, 103, 61, 31, 87, 56, 38, 71, 48, 88, 3, 62, 89, 24, 7, 49, 32, 104, 72, 90,  &
+          &   63, 39, 4, 8, 50, 91, 64, 40, 33, 25, 51, 95, 96, 73, 65, 9, 41, 97, 92, 105,  &
+          &   52, 5, 98, 10, 42, 99, 100, 66, 11, 74, 34, 53, 26, 6, 106, 12, 43, 13, 54, 93,  &
+          &   44, 107, 94, 14, 108, 15, 16, 109, 17, 18, 110, 111, 112 &
+          & /)
+    
+    real(jprb) :: hook_handle
+
+#include "surdi.intfb.h"
+#include "surrtab.intfb.h"
+#include "surrtpk.intfb.h"
+#include "surrtrf.intfb.h"
+#include "rrtm_init_140gp.intfb.h"
+#include "srtm_init.intfb.h"
+
+    if (lhook) call dr_hook('radiation_ifs_rrtm:setup_gas_optics',0,hook_handle)
+
+    ! The IFS implementation of RRTMG uses many global variables.  In
+    ! the IFS these will have been set up already; otherwise set them
+    ! up now.
+    if (config%do_setup_ifsrrtm) then
+      call SURDI
+      call SURRTAB
+      call SURRTPK
+      call SURRTRF
+      call RRTM_INIT_140GP(directory)
+      call SRTM_INIT(directory)
+    end if
+
+    config%n_g_sw = jpgsw
+    config%n_g_lw = jpglw
+    config%n_bands_sw = 14
+    config%n_bands_lw = 16
+
+    ! Wavenumber ranges of each band may be needed so that the user
+    ! can compute UV and photosynthetically active radiation for a
+    ! particular wavelength range
+    allocate(config%wavenumber1_sw(config%n_bands_sw))
+    allocate(config%wavenumber2_sw(config%n_bands_sw))
+    allocate(config%wavenumber1_lw(config%n_bands_lw))
+    allocate(config%wavenumber2_lw(config%n_bands_lw))
+    config%wavenumber1_lw = (/ 10, 350, 500, 630, 700, 820, 980, 1080, 1180, 1390, 1480, &
+         &  1800, 2080, 2250, 2380, 2600 /)
+    config%wavenumber2_lw = (/ 350, 500, 630, 700, 820, 980, 1080, 1180, 1390, 1480, 1800, &
+         &  2080, 2250, 2380, 2600, 3250 /)
+    config%wavenumber1_sw = (/ 2600, 3250, 4000, 4650, 5150, 6150, 7700, 8050, 12850, &
+         &  16000 , 22650, 29000, 38000, 820 /)
+    config%wavenumber2_sw = (/ 3250, 4000, 4650, 5150, 6150, 7700, 8050, 12850, 16000, &
+         &  22650, 29000, 38000, 50000, 2600 /)
+
+    allocate(config%i_band_from_g_sw          (config%n_g_sw))
+    allocate(config%i_band_from_g_lw          (config%n_g_lw))
+    allocate(config%i_band_from_reordered_g_sw(config%n_g_sw))
+    allocate(config%i_band_from_reordered_g_lw(config%n_g_lw))
+    allocate(config%i_g_from_reordered_g_sw(config%n_g_sw))
+    allocate(config%i_g_from_reordered_g_lw(config%n_g_lw))
+
+    ! Shortwave starts at 16: need to start at 1
+    config%i_band_from_g_sw = ngb_sw - ngb_sw(1)+1
+    config%i_band_from_g_lw = ngb_lw
+
+    if (config%i_solver_sw == ISolverSpartacus) then
+      ! SPARTACUS requires g points ordered in approximately
+      ! increasing order of optical depth
+      config%i_g_from_reordered_g_sw = RRTM_GPOINT_REORDERING_SW
+    else
+      ! Implied-do for no reordering
+!      config%i_g_from_reordered_g_sw = RRTM_GPOINT_REORDERING_SW
+      config%i_g_from_reordered_g_sw = (/ (irep, irep=1,config%n_g_sw) /)
+    end if
+
+    if (config%i_solver_lw == ISolverSpartacus) then
+      ! SPARTACUS requires g points ordered in approximately
+      ! increasing order of optical depth
+      config%i_g_from_reordered_g_lw = RRTM_GPOINT_REORDERING_LW
+    else
+      ! Implied-do for no reordering
+      config%i_g_from_reordered_g_lw = (/ (irep, irep=1,config%n_g_lw) /)
+    end if
+
+    config%i_band_from_reordered_g_sw &
+         = config%i_band_from_g_sw(config%i_g_from_reordered_g_sw)
+
+    config%i_band_from_reordered_g_lw &
+         = config%i_band_from_g_lw(config%i_g_from_reordered_g_lw)
+
+    ! The i_spec_* variables are used solely for storing spectral
+    ! data, and this can either be by band or by g-point
+    if (config%do_save_spectral_flux) then
+      if (config%do_save_gpoint_flux) then
+        config%n_spec_sw = config%n_g_sw
+        config%n_spec_lw = config%n_g_lw
+        config%i_spec_from_reordered_g_sw => config%i_g_from_reordered_g_sw
+        config%i_spec_from_reordered_g_lw => config%i_g_from_reordered_g_lw
+      else
+        config%n_spec_sw = config%n_bands_sw
+        config%n_spec_lw = config%n_bands_lw
+        config%i_spec_from_reordered_g_sw => config%i_band_from_reordered_g_sw
+        config%i_spec_from_reordered_g_lw => config%i_band_from_reordered_g_lw
+      end if
+    else
+      config%n_spec_sw = 0
+      config%n_spec_lw = 0
+      nullify(config%i_spec_from_reordered_g_sw)
+      nullify(config%i_spec_from_reordered_g_lw)
+    end if
+
+    if (lhook) call dr_hook('radiation_ifs_rrtm:setup_gas_optics',1,hook_handle)
+
+  end subroutine setup_gas_optics
+
+
+  !---------------------------------------------------------------------
+  ! Scale gas mixing ratios according to required units
+  subroutine set_gas_units(gas)
+
+    use radiation_gas,           only : gas_type, IMassMixingRatio
+    type(gas_type),    intent(inout) :: gas
+
+    call gas%set_units(IMassMixingRatio)
+
+  end subroutine set_gas_units
+
+
+  !---------------------------------------------------------------------
+  ! Compute gas optical depths, shortwave scattering, Planck function
+  ! and incoming shortwave radiation at top-of-atmosphere
+  subroutine gas_optics(ncol,nlev,istartcol,iendcol, &
+       &  config, single_level, thermodynamics, gas, & 
+       &  od_lw, od_sw, ssa_sw, lw_albedo, planck_hl, lw_emission, &
+       &  incoming_sw)
+
+    use parkind1,                 only : jprb, jpim
+
+    USE PARRRTM  , ONLY : JPBAND, JPXSEC, JPINPX 
+    USE YOERRTM  , ONLY : JPGPT_LW => JPGPT
+    USE YOESRTM  , ONLY : JPGPT_SW => JPGPT  
+    !USE YOMDIMV  , ONLY : YRDIMV
+    use yomhook  , only : lhook, dr_hook
+
+    use radiation_config,         only : config_type, ISolverSpartacus
+    use radiation_thermodynamics, only : thermodynamics_type
+    use radiation_single_level,   only : single_level_type
+    use radiation_gas
+
+    integer, intent(in) :: ncol               ! number of columns
+    integer, intent(in) :: nlev               ! number of model levels
+    integer, intent(in) :: istartcol, iendcol ! range of columns to process
+    type(config_type), intent(in) :: config
+    type(single_level_type),  intent(in) :: single_level
+    type(thermodynamics_type),intent(in) :: thermodynamics
+    type(gas_type),           intent(in) :: gas
+
+    ! Longwave albedo of the surface
+    real(jprb), dimension(config%n_g_lw,istartcol:iendcol), &
+         &  intent(in), optional :: lw_albedo
+
+    ! Gaseous layer optical depth in longwave and shortwave, and
+    ! shortwave single scattering albedo (i.e. fraction of extinction
+    ! due to Rayleigh scattering) at each g-point
+    real(jprb), dimension(config%n_g_lw,nlev,istartcol:iendcol), intent(out) :: &
+         &   od_lw
+    real(jprb), dimension(config%n_g_sw,nlev,istartcol:iendcol), intent(out) :: &
+         &   od_sw, ssa_sw
+
+    ! The Planck function (emitted flux from a black body) at half
+    ! levels at each longwave g-point
+    real(jprb), dimension(config%n_g_lw,nlev+1,istartcol:iendcol), &
+         &   intent(out), optional :: planck_hl
+    ! Planck function for the surface (W m-2)
+    real(jprb), dimension(config%n_g_lw,istartcol:iendcol), &
+         &   intent(out), optional :: lw_emission
+
+    ! The incoming shortwave flux into a plane perpendicular to the
+    ! incoming radiation at top-of-atmosphere in each of the shortwave
+    ! g-points
+    real(jprb), dimension(config%n_g_sw,istartcol:iendcol), &
+         &   intent(out), optional :: incoming_sw
+
+    real(jprb) :: incoming_sw_scale(istartcol:iendcol)
+
+    ! The variables in capitals are used in the same way as the
+    ! equivalent routine in the IFS
+
+    real(jprb) :: ZOD_LW(JPGPT_LW,nlev,istartcol:iendcol) ! Note ordering of dimensions
+    real(jprb) :: ZOD_SW(istartcol:iendcol,nlev,JPGPT_SW)
+    real(jprb) :: ZSSA_SW(istartcol:iendcol,nlev,JPGPT_SW)
+    real(jprb) :: ZINCSOL(istartcol:iendcol,JPGPT_SW)
+
+    real(jprb) :: ZCOLMOL(istartcol:iendcol,nlev)
+    real(jprb) :: ZCOLDRY(istartcol:iendcol,nlev)
+    real(jprb) :: ZWBRODL(istartcol:iendcol,nlev) !BROADENING GASES,column density (mol/cm2)
+    real(jprb) :: ZCOLBRD(istartcol:iendcol,nlev) !BROADENING GASES, column amount
+    real(jprb) :: ZWKL(istartcol:iendcol,JPINPX,nlev)
+
+    real(jprb) :: ZWX(istartcol:iendcol,JPXSEC,nlev) ! Amount of trace gases
+    
+    real(jprb) :: ZFLUXFAC, ZPI
+
+    ! - from AER
+    real(jprb) :: ZTAUAERL(istartcol:iendcol,nlev,JPBAND)
+
+    !- from INTFAC      
+    real(jprb) :: ZFAC00(istartcol:iendcol,nlev)
+    real(jprb) :: ZFAC01(istartcol:iendcol,nlev)
+    real(jprb) :: ZFAC10(istartcol:iendcol,nlev)
+    real(jprb) :: ZFAC11(istartcol:iendcol,nlev)
+    
+    !- from FOR
+    real(jprb) :: ZFORFAC(istartcol:iendcol,nlev)
+    real(jprb) :: ZFORFRAC(istartcol:iendcol,nlev)
+    integer    :: INDFOR(istartcol:iendcol,nlev) 
+
+    !- from MINOR
+    integer    :: INDMINOR(istartcol:iendcol,nlev) 
+    real(jprb) :: ZSCALEMINOR(istartcol:iendcol,nlev) 
+    real(jprb) :: ZSCALEMINORN2(istartcol:iendcol,nlev) 
+    real(jprb) :: ZMINORFRAC(istartcol:iendcol,nlev) 
+    
+    real(jprb)     :: &                 
+         &  ZRAT_H2OCO2(istartcol:iendcol,nlev),ZRAT_H2OCO2_1(istartcol:iendcol,nlev), &
+         &  ZRAT_H2OO3(istartcol:iendcol,nlev) ,ZRAT_H2OO3_1(istartcol:iendcol,nlev), & 
+         &  ZRAT_H2ON2O(istartcol:iendcol,nlev),ZRAT_H2ON2O_1(istartcol:iendcol,nlev), &
+         &  ZRAT_H2OCH4(istartcol:iendcol,nlev),ZRAT_H2OCH4_1(istartcol:iendcol,nlev), &
+         &  ZRAT_N2OCO2(istartcol:iendcol,nlev),ZRAT_N2OCO2_1(istartcol:iendcol,nlev), &
+         &  ZRAT_O3CO2(istartcol:iendcol,nlev) ,ZRAT_O3CO2_1(istartcol:iendcol,nlev)
+    
+    !- from INTIND
+    integer :: JP(istartcol:iendcol,nlev)
+    integer :: JT(istartcol:iendcol,nlev)
+    integer :: JT1(istartcol:iendcol,nlev)
+
+    !- from PRECISE             
+    real(jprb) :: ZONEMINUS, ZONEMINUS_ARRAY(istartcol:iendcol)
+
+    !- from PROFDATA             
+    real(jprb) :: ZCOLH2O(istartcol:iendcol,nlev)
+    real(jprb) :: ZCOLCO2(istartcol:iendcol,nlev)
+    real(jprb) :: ZCOLO3(istartcol:iendcol,nlev)
+    real(jprb) :: ZCOLN2O(istartcol:iendcol,nlev)
+    real(jprb) :: ZCOLCH4(istartcol:iendcol,nlev)
+    real(jprb) :: ZCOLO2(istartcol:iendcol,nlev)
+    real(jprb) :: ZCO2MULT(istartcol:iendcol,nlev)
+    integer    :: ILAYTROP(istartcol:iendcol)
+    integer    :: ILAYSWTCH(istartcol:iendcol)
+    integer    :: ILAYLOW(istartcol:iendcol)
+
+    !- from PROFILE             
+    real(jprb) :: ZPAVEL(istartcol:iendcol,nlev)
+    real(jprb) :: ZTAVEL(istartcol:iendcol,nlev)
+    real(jprb) :: ZPZ(istartcol:iendcol,0:nlev)
+    real(jprb) :: ZTZ(istartcol:iendcol,0:nlev)
+    
+    !- from SELF             
+    real(jprb) :: ZSELFFAC(istartcol:iendcol,nlev)
+    real(jprb) :: ZSELFFRAC(istartcol:iendcol,nlev)
+    integer :: INDSELF(istartcol:iendcol,nlev)
+
+    !- from SP             
+    real(jprb) :: ZPFRAC(istartcol:iendcol,JPGPT_LW,nlev)
+    
+    !- from SURFACE             
+    integer :: IREFLECT(istartcol:iendcol)
+
+    real(jprb) :: pressure_fl(ncol, nlev), temperature_fl(ncol, nlev)
+
+    ! If nlev is less than the number of heights at which gas mixing
+    ! ratios are stored, then we assume that the lower part of the
+    ! atmosphere is required. This enables nlev=1 to be passed in to
+    ! the routine, in which case the gas properties of the lowest
+    ! layer are provided, useful for canopy radiative transfer.
+    integer :: istartlev, iendlev
+
+    integer :: jlev, jgreorder, jg, ig, iband, jcol
+
+    real(jprb) :: hook_handle
+
+#include "rrtm_prepare_gases.intfb.h"
+#include "rrtm_setcoef_140gp.intfb.h"
+#include "rrtm_gas_optical_depth.intfb.h"
+#include "srtm_setcoef.intfb.h"
+#include "srtm_gas_optical_depth.intfb.h"
+
+    if (lhook) call dr_hook('radiation_ifs_rrtm:gas_optics',0,hook_handle)
+
+    ! Compute start and end levels for indexing the gas mixing ratio
+    ! and thermodynamics arrays
+    iendlev   = ubound(gas%mixing_ratio,2)
+    istartlev = iendlev - nlev + 1
+
+    ZPI = 2.0_jprb*ASIN(1.0_jprb)
+    ZFLUXFAC = ZPI * 1.E+4
+    ZONEMINUS = 1.0_jprb - 1.0e-6_jprb
+    ZONEMINUS_ARRAY = ZONEMINUS
+
+!    if (.not. associated(YRDIMV)) then
+!      allocate(YRDIMV)
+!      YRDIMV%NFLEVG = nlev
+!    end if
+
+    pressure_fl(istartcol:iendcol,:) &
+         &  = 0.5_jprb * (thermodynamics%pressure_hl(istartcol:iendcol,istartlev:iendlev) &
+         &               +thermodynamics%pressure_hl(istartcol:iendcol,istartlev+1:iendlev+1))
+    temperature_fl(istartcol:iendcol,:) &
+         &  = 0.5_jprb * (thermodynamics%temperature_hl(istartcol:iendcol,istartlev:iendlev) &
+         &               +thermodynamics%temperature_hl(istartcol:iendcol,istartlev+1:iendlev+1))
+    
+    ! Check we have gas mixing ratios in the right units
+    call gas%assert_units(IMassMixingRatio)
+
+    ! Warning: O2 is hard-coded within the following function so the
+    ! user-provided concentrations of this gas are ignored for both
+    ! the longwave and shortwave
+    CALL RRTM_PREPARE_GASES &
+         & ( istartcol, iendcol, ncol, nlev, &
+         &   thermodynamics%pressure_hl(:,istartlev:iendlev+1), &
+         &   pressure_fl, &
+         &   thermodynamics%temperature_hl(:,istartlev:iendlev+1), &
+         &   temperature_fl, &
+         &   gas%mixing_ratio(:,istartlev:iendlev,IH2O), &
+         &   gas%mixing_ratio(:,istartlev:iendlev,ICO2), &
+         &   gas%mixing_ratio(:,istartlev:iendlev,ICH4), &
+         &   gas%mixing_ratio(:,istartlev:iendlev,IN2O), &
+         &   gas%mixing_ratio(:,istartlev:iendlev,INO2), &
+         &   gas%mixing_ratio(:,istartlev:iendlev,ICFC11), &
+         &   gas%mixing_ratio(:,istartlev:iendlev,ICFC12), &
+         &   gas%mixing_ratio(:,istartlev:iendlev,IHCFC22), &
+         &   gas%mixing_ratio(:,istartlev:iendlev,ICCl4), &
+         &   gas%mixing_ratio(:,istartlev:iendlev,IO3), &
+         &  ZCOLDRY, ZWBRODL,ZWKL, ZWX, &
+         &  ZPAVEL , ZTAVEL , ZPZ , ZTZ, IREFLECT)  
+
+    CALL RRTM_SETCOEF_140GP &
+         &( istartcol, iendcol, nlev , ZCOLDRY  , ZWBRODL , ZWKL , &
+         &  ZFAC00 , ZFAC01   , ZFAC10 , ZFAC11 , ZFORFAC,ZFORFRAC,INDFOR, JP, JT, JT1 , &
+         &  ZCOLH2O, ZCOLCO2  , ZCOLO3 , ZCOLN2O, ZCOLCH4, ZCOLO2,ZCO2MULT , ZCOLBRD, & 
+         &  ILAYTROP,ILAYSWTCH, ILAYLOW, ZPAVEL , ZTAVEL , ZSELFFAC, ZSELFFRAC, INDSELF, &
+         &  INDMINOR,ZSCALEMINOR,ZSCALEMINORN2,ZMINORFRAC,&
+         &  ZRAT_H2OCO2, ZRAT_H2OCO2_1, ZRAT_H2OO3, ZRAT_H2OO3_1, &
+         &  ZRAT_H2ON2O, ZRAT_H2ON2O_1, ZRAT_H2OCH4, ZRAT_H2OCH4_1, &
+         &  ZRAT_N2OCO2, ZRAT_N2OCO2_1, ZRAT_O3CO2, ZRAT_O3CO2_1)   
+
+    ZTAUAERL = 0.0_jprb
+
+    CALL RRTM_GAS_OPTICAL_DEPTH &
+         &( istartcol, iendcol, nlev, ZOD_LW, ZPAVEL, ZCOLDRY, ZCOLBRD, ZWX ,&
+         &  ZTAUAERL, ZFAC00 , ZFAC01, ZFAC10 , ZFAC11 , ZFORFAC,ZFORFRAC,INDFOR, &
+         &  JP, JT, JT1, ZONEMINUS ,&
+         &  ZCOLH2O , ZCOLCO2, ZCOLO3, ZCOLN2O, ZCOLCH4, ZCOLO2,ZCO2MULT ,&
+         &  ILAYTROP, ILAYSWTCH,ILAYLOW, ZSELFFAC, ZSELFFRAC, INDSELF, ZPFRAC, &
+         &  INDMINOR,ZSCALEMINOR,ZSCALEMINORN2,ZMINORFRAC,&
+         &  ZRAT_H2OCO2, ZRAT_H2OCO2_1, ZRAT_H2OO3, ZRAT_H2OO3_1, &
+         &  ZRAT_H2ON2O, ZRAT_H2ON2O_1, ZRAT_H2OCH4, ZRAT_H2OCH4_1, &
+         &  ZRAT_N2OCO2, ZRAT_N2OCO2_1, ZRAT_O3CO2, ZRAT_O3CO2_1)      
+
+    if (present(lw_albedo)) then
+    
+      call planck_function_atmos(nlev, istartcol, iendcol, config, &
+           &                     thermodynamics, ZPFRAC, planck_hl)
+
+      if (single_level%is_simple_surface) then
+        call planck_function_surf(istartcol, iendcol, config, &
+             &                    single_level%skin_temperature, ZPFRAC(:,:,1), &
+             &                    lw_emission)
+        
+        ! The following can be used to extract the parameters defined at
+        ! the top of the planck_function routine below:
+        !write(*,'(a,140(e12.5,","),a)') 'ZPFRAC_surf=[', &
+        !&  sum(ZPFRAC(istartcol:iendcol,:,1),1) / (iendcol+1-istartcol), ']'
+        
+        ! lw_emission at this point is actually the planck function of
+        ! the surface
+        lw_emission = lw_emission * (1.0_jprb - lw_albedo)
+      else
+      ! Longwave emission has already been computed
+        if (config%use_canopy_full_spectrum_lw) then
+          lw_emission = transpose(single_level%lw_emission(istartcol:iendcol,:))
+        else
+          lw_emission = transpose(single_level%lw_emission(istartcol:iendcol, &
+               & config%i_emiss_from_band_lw(config%i_band_from_reordered_g_lw)))
+        end if
+      end if
+
+    end if
+
+    if (config%i_solver_lw == ISolverSpartacus) then
+      !    if (.true.) then
+      ! We need to rearrange the gas optics info in memory: reordering
+      ! the g points in order of approximately increasing optical
+      ! depth (for efficient 3D processing on only the regions of the
+      ! spectrum that are optically thin for gases) and reorder in
+      ! pressure since the the functions above treat pressure
+      ! decreasing with increasing index.  Note that the output gas
+      ! arrays have dimensions in a different order to the inputs,
+      ! so there is some inefficiency here.
+      do jgreorder = 1,config%n_g_lw
+        iband = config%i_band_from_reordered_g_lw(jgreorder)
+        ig = config%i_g_from_reordered_g_lw(jgreorder)
+        
+        ! Top-of-atmosphere half level
+        do jlev = 1,nlev
+          do jcol = istartcol,iendcol
+            ! Some g points can return negative optical depths;
+            ! specifically original g points 54-56 which causes
+            ! unphysical single-scattering albedo when combined with
+            ! aerosol
+            od_lw(jgreorder,jlev,jcol) &
+                 &   = max(config%min_gas_od_lw, ZOD_LW(ig,nlev+1-jlev,jcol))
+          end do
+        end do
+      end do
+    else
+      ! G points have not been reordered 
+      do jcol = istartcol,iendcol
+        do jlev = 1,nlev
+          ! Check for negative optical depth
+          od_lw(:,jlev,jcol) = max(config%min_gas_od_lw, ZOD_LW(:,nlev+1-jlev,jcol))
+        end do
+      end do
+    end if
+    
+    CALL SRTM_SETCOEF &
+         & ( istartcol, iendcol, nlev,&
+         & ZPAVEL  , ZTAVEL,&
+         & ZCOLDRY , ZWKL,&
+         & ILAYTROP,&
+         & ZCOLCH4  , ZCOLCO2 , ZCOLH2O , ZCOLMOL  , ZCOLO2 , ZCOLO3,&
+         & ZFORFAC , ZFORFRAC , INDFOR  , ZSELFFAC, ZSELFFRAC, INDSELF, &
+         & ZFAC00  , ZFAC01   , ZFAC10  , ZFAC11,&
+         & JP      , JT       , JT1     , single_level%cos_sza(istartcol:iendcol)  &
+         & )  
+    
+    ! SRTM_GAS_OPTICAL_DEPTH will not initialize profiles when the sun
+    ! is below the horizon, so we do it here
+    ZOD_SW(istartcol:iendcol,:,:)  = 0.0_jprb
+    ZSSA_SW(istartcol:iendcol,:,:) = 0.0_jprb
+    ZINCSOL(istartcol:iendcol,:)   = 0.0_jprb
+
+    CALL SRTM_GAS_OPTICAL_DEPTH &
+         &( istartcol, iendcol , nlev  , ZONEMINUS_ARRAY,&
+         & single_level%cos_sza(istartcol:iendcol), ILAYTROP,&
+         & ZCOLCH4 , ZCOLCO2  , ZCOLH2O, ZCOLMOL , ZCOLO2   , ZCOLO3,&
+         & ZFORFAC , ZFORFRAC , INDFOR , ZSELFFAC, ZSELFFRAC, INDSELF,&
+         & ZFAC00  , ZFAC01   , ZFAC10 , ZFAC11  ,&
+         & JP      , JT       , JT1    ,&
+         & ZOD_SW  , ZSSA_SW  , ZINCSOL )
+    
+    ! Scale the incoming solar per band, if requested
+    if (config%use_spectral_solar_scaling) then
+      ZINCSOL(istartcol:iendcol,:) = ZINCSOL(istartcol:iendcol,:) &
+         & * spread(single_level%spectral_solar_scaling(config%i_band_from_reordered_g_sw), &
+         &                                              1,iendcol-istartcol+1)
+    end if
+
+    ! Scaling factor to ensure that the total solar irradiance is as
+    ! requested.  Note that if the sun is below the horizon then
+    ! ZINCSOL will be zero.
+    if (present(incoming_sw)) then
+      incoming_sw_scale = 1.0_jprb
+      do jcol = istartcol,iendcol
+        if (single_level%cos_sza(jcol) > 0.0_jprb) then
+          incoming_sw_scale(jcol) = single_level%solar_irradiance / sum(ZINCSOL(jcol,:))
+        end if
+      end do
+    end if
+
+    if (config%i_solver_sw == ISolverSpartacus) then
+!    if (.true.) then
+      ! Account for reordered g points
+      do jgreorder = 1,config%n_g_sw
+        ig = config%i_g_from_reordered_g_sw(jgreorder)
+        do jlev = 1,nlev
+          do jcol = istartcol,iendcol
+            ! Check for negative optical depth
+            od_sw (jgreorder,nlev+1-jlev,jcol) &
+                 &  = max(config%min_gas_od_sw, ZOD_SW (jcol,jlev,ig))
+            ssa_sw(jgreorder,nlev+1-jlev,jcol) = ZSSA_SW(jcol,jlev,ig)
+           end do
+        end do
+        if (present(incoming_sw)) then
+          incoming_sw(jgreorder,:) &
+               &  = incoming_sw_scale(:) * ZINCSOL(:,ig)
+        end if
+      end do
+    else
+      ! G points have not been reordered
+      do jg = 1,config%n_g_sw
+        do jlev = 1,nlev
+          do jcol = istartcol,iendcol
+            ! Check for negative optical depth
+            od_sw (jg,nlev+1-jlev,jcol) = max(config%min_gas_od_sw, ZOD_SW(jcol,jlev,jg))
+            ssa_sw(jg,nlev+1-jlev,jcol) = ZSSA_SW(jcol,jlev,jg)
+          end do
+        end do
+        if (present(incoming_sw)) then
+          incoming_sw(jg,:) &
+               &  = incoming_sw_scale(:) * ZINCSOL(:,jg)
+        end if
+      end do
+    end if
+    
+    if (lhook) call dr_hook('radiation_ifs_rrtm:gas_optics',1,hook_handle)
+    
+  end subroutine gas_optics
+  
+
+  !---------------------------------------------------------------------
+  ! Compute Planck function of the atmosphere
+  subroutine planck_function_atmos(nlev,istartcol,iendcol, &
+       config, thermodynamics, PFRAC, &
+       planck_hl)
+
+    use parkind1,                 only : jprb, jpim
+
+    USE YOERRTM  , ONLY : JPGPT_LW => JPGPT
+    use yoerrtwn, only : totplnk, delwave
+
+    use yomhook, only : lhook, dr_hook
+
+    use radiation_config,         only : config_type, ISolverSpartacus
+    use radiation_thermodynamics, only : thermodynamics_type
+    !use radiation_gas
+
+    integer, intent(in) :: nlev               ! number of model levels
+    integer, intent(in) :: istartcol, iendcol ! range of columns to process
+    type(config_type), intent(in) :: config
+    type(thermodynamics_type),intent(in) :: thermodynamics
+    real(jprb), intent(in) :: PFRAC(istartcol:iendcol,JPGPT_LW,nlev)
+
+    ! The Planck function (emitted flux from a black body) at half
+    ! levels at each longwave g-point
+    real(jprb), dimension(config%n_g_lw,nlev+1,istartcol:iendcol), intent(out) :: &
+         &   planck_hl
+
+    ! Planck function values per band
+    real(jprb), dimension(istartcol:iendcol, config%n_bands_lw) :: planck_store
+
+    ! Look-up table variables for Planck function
+    real(jprb), dimension(istartcol:iendcol) :: frac
+    integer,    dimension(istartcol:iendcol) :: ind
+
+    ! Temperature (K) of a half-level
+    real(jprb) :: temperature
+
+    real(jprb) :: factor
+    real(jprb) :: ZFLUXFAC
+
+    integer :: jlev, jgreorder, jg, ig, iband, jband, jcol, ilevoffset
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_ifs_rrtm:planck_function_atmos',0,hook_handle)
+
+    ZFLUXFAC = 2.0_jprb*ASIN(1.0_jprb) * 1.0e4_jprb
+    
+    ! nlev may be less than the number of original levels, in which
+    ! case we assume that the user wants the lower part of the
+    ! atmosphere
+    ilevoffset = ubound(thermodynamics%temperature_hl,2)-nlev-1
+
+    ! Work out interpolations: for each half level, the index of the
+    ! lowest interpolation bound, and the fraction into interpolation
+    ! interval
+    do jlev = 1,nlev+1
+      do jcol = istartcol,iendcol
+        temperature = thermodynamics%temperature_hl(jcol,jlev+ilevoffset)
+        if (temperature < 339.0_jprb .and. temperature >= 160.0_jprb) then
+          ! Linear interpolation between -113 and 66 degC
+          ind(jcol)  = int(temperature - 159.0_jprb)
+          frac(jcol) = temperature - int(temperature)
+        else if(temperature >= 339.0_jprb) then
+          ! Extrapolation above 66 degC
+          ind(jcol)  = 180
+          frac(jcol) = temperature - 339.0_jprb
+        else
+          ! Cap below -113 degC (to avoid possible negative Planck
+          ! function values)
+          ind(jcol)  = 1
+          frac(jcol) = 0.0_jprb
+        end if
+      end do
+
+      ! Calculate Planck functions per band
+      do jband = 1,config%n_bands_lw
+        factor = zfluxfac * delwave(jband)
+        do jcol = istartcol,iendcol
+          planck_store(jcol,jband) = factor &
+               &  * (totplnk(ind(jcol),jband) &
+               &  + frac(jcol)*(totplnk(ind(jcol)+1,jband)-totplnk(ind(jcol),jband)))
+        end do
+      end do
+
+      if (config%i_solver_lw == ISolverSpartacus) then
+        ! We need to rearrange the gas optics info in memory:
+        ! reordering the g points in order of approximately increasing
+        ! optical depth (for efficient 3D processing on only the
+        ! regions of the spectrum that are optically thin for gases)
+        ! and reorder in pressure since the the functions above treat
+        ! pressure decreasing with increasing index.
+        if (jlev == 1) then
+          ! Top-of-atmosphere half level - note that PFRAC is on model
+          ! levels not half levels
+          do jgreorder = 1,config%n_g_lw
+            iband = config%i_band_from_reordered_g_lw(jgreorder)
+            ig = config%i_g_from_reordered_g_lw(jgreorder)
+            planck_hl(jgreorder,1,:) = planck_store(:,iband) &
+                 &   * PFRAC(:,ig,nlev)
+          end do
+        else
+          do jgreorder = 1,config%n_g_lw
+            iband = config%i_band_from_reordered_g_lw(jgreorder)
+            ig = config%i_g_from_reordered_g_lw(jgreorder)
+            planck_hl(jgreorder,jlev,:) &
+                   &   = planck_store(:,iband) &
+                   &   * PFRAC(:,ig,nlev+2-jlev)
+          end do
+        end if
+      else
+        ! G points have not been reordered 
+        if (jlev == 1) then
+          ! Top-of-atmosphere half level - note that PFRAC is on model
+          ! levels not half levels
+          do jg = 1,config%n_g_lw
+            iband = config%i_band_from_g_lw(jg)
+            planck_hl(jg,1,:) = planck_store(:,iband) * PFRAC(:,jg,nlev)
+          end do
+        else
+          do jg = 1,config%n_g_lw
+            iband = config%i_band_from_g_lw(jg)
+            planck_hl(jg,jlev,:) = planck_store(:,iband) * PFRAC(:,jg,nlev+2-jlev)
+          end do
+        end if
+      end if
+    end do
+
+    if (lhook) call dr_hook('radiation_ifs_rrtm:planck_function_atmos',1,hook_handle)
+
+  end subroutine planck_function_atmos
+
+
+  !---------------------------------------------------------------------
+  ! Compute Planck function of the surface
+  subroutine planck_function_surf(istartcol, iendcol, config, temperature, PFRAC, &
+       &  planck_surf)
+
+    use parkind1,                 only : jprb, jpim
+
+    USE YOERRTM  , ONLY : JPGPT_LW => JPGPT
+    use yoerrtwn, only : totplnk, delwave
+
+    use yomhook, only : lhook, dr_hook
+
+    use radiation_config,         only : config_type, ISolverSpartacus
+    !    use radiation_gas
+
+    integer, intent(in) :: istartcol, iendcol ! range of columns to process
+    type(config_type), intent(in) :: config
+    real(jprb), intent(in) :: temperature(:)
+
+    real(jprb), intent(in) :: PFRAC(istartcol:iendcol,JPGPT_LW)
+
+    ! Planck function of the surface (W m-2)
+    real(jprb), dimension(config%n_g_lw,istartcol:iendcol), &
+         &  intent(out) :: planck_surf
+
+    ! Planck function values per band
+    real(jprb), dimension(istartcol:iendcol, config%n_bands_lw) :: planck_store
+
+    ! Look-up table variables for Planck function
+    real(jprb), dimension(istartcol:iendcol) :: frac
+    integer,    dimension(istartcol:iendcol) :: ind
+
+    ! Temperature (K)
+    real(jprb) :: Tsurf
+
+    real(jprb) :: factor
+    real(jprb) :: ZFLUXFAC
+
+    integer :: jgreorder, jg, ig, iband, jband, jcol
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_ifs_rrtm:planck_function_surf',0,hook_handle)
+
+    ZFLUXFAC = 2.0_jprb*ASIN(1.0_jprb) * 1.0e4_jprb
+
+    ! Work out surface interpolations
+    do jcol = istartcol,iendcol
+      Tsurf = temperature(jcol)
+      if (Tsurf < 339.0_jprb .and. Tsurf >= 160.0_jprb) then
+        ! Linear interpolation between -113 and 66 degC
+        ind(jcol)  = int(Tsurf - 159.0_jprb)
+        frac(jcol) = Tsurf - int(Tsurf)
+      else if(Tsurf >= 339.0_jprb) then
+        ! Extrapolation above 66 degC
+        ind(jcol)  = 180
+        frac(jcol) = Tsurf - 339.0_jprb
+      else
+        ! Cap below -113 degC (to avoid possible negative Planck
+        ! function values)
+        ind(jcol)  = 1
+        frac(jcol) = 0.0_jprb
+      end if
+    end do
+
+    ! Calculate Planck functions per band
+    do jband = 1,config%n_bands_lw
+      factor = zfluxfac * delwave(jband)
+      do jcol = istartcol,iendcol
+        planck_store(jcol,jband) = factor &
+             &  * (totplnk(ind(jcol),jband) &
+             &  + frac(jcol)*(totplnk(ind(jcol)+1,jband)-totplnk(ind(jcol),jband)))
+      end do
+    end do
+
+    if (config%i_solver_lw == ISolverSpartacus) then
+      ! We need to rearrange the gas optics info in memory: reordering
+      ! the g points in order of approximately increasing optical
+      ! depth (for efficient 3D processing on only the regions of
+      ! the spectrum that are optically thin for gases) and reorder
+      ! in pressure since the the functions above treat pressure
+      ! decreasing with increasing index.
+      do jgreorder = 1,config%n_g_lw
+        iband = config%i_band_from_reordered_g_lw(jgreorder)
+        ig = config%i_g_from_reordered_g_lw(jgreorder)
+        planck_surf(jgreorder,:) = planck_store(:,iband) * PFRAC(:,ig)
+      end do
+    else
+      ! G points have not been reordered 
+      do jg = 1,config%n_g_lw
+        iband = config%i_band_from_g_lw(jg)
+        planck_surf(jg,:) = planck_store(:,iband) * PFRAC(:,jg)
+      end do
+    end if
+
+    if (lhook) call dr_hook('radiation_ifs_rrtm:planck_function_surf',1,hook_handle)
+    
+  end subroutine planck_function_surf
+
+
+  !---------------------------------------------------------------------
+  ! Externally facing function for computing the Planck function
+  ! without reference to any gas profile; typically this would be used
+  ! for computing the emission by facets of a complex surface.  Note
+  ! that this uses fixed "PFRAC" values, obtained by averaging over
+  ! those derived from RRTM-G for near-surface conditions over a line
+  ! of meridian from the ECMWF model.
+  subroutine planck_function(config, temperature, planck_surf)
+
+    use parkind1,                 only : jprb, jpim
+
+    use radiation_config,         only : config_type
+
+    type(config_type), intent(in) :: config
+    real(jprb), intent(in) :: temperature
+
+    ! Planck function of the surface (W m-2)
+    real(jprb), dimension(config%n_g_lw), &
+         &  intent(out) :: planck_surf
+
+    ! Fraction of each band contributed by each g-point within
+    ! it. Since there are 16 bands, this array sums to 16
+    real(jprb), parameter, dimension(1,140) :: frac &
+         = reshape( (/ 0.21227E+00, 0.18897E+00, 0.25491E+00, 0.17864E+00, 0.11735E+00, 0.38298E-01, 0.57871E-02, &
+         &    0.31753E-02, 0.53169E-03, 0.76476E-04, 0.16388E+00, 0.15241E+00, 0.14290E+00, 0.12864E+00, &
+         &    0.11615E+00, 0.10047E+00, 0.80013E-01, 0.60445E-01, 0.44918E-01, 0.63395E-02, 0.32942E-02, &
+         &    0.54541E-03, 0.15380E+00, 0.15194E+00, 0.14339E+00, 0.13138E+00, 0.11701E+00, 0.10081E+00, &
+         &    0.82296E-01, 0.61735E-01, 0.41918E-01, 0.45918E-02, 0.37743E-02, 0.30121E-02, 0.22500E-02, &
+         &    0.14490E-02, 0.55410E-03, 0.78364E-04, 0.15938E+00, 0.15146E+00, 0.14213E+00, 0.13079E+00, &
+         &    0.11672E+00, 0.10053E+00, 0.81566E-01, 0.61126E-01, 0.41150E-01, 0.44488E-02, 0.36950E-02, &
+         &    0.29101E-02, 0.21357E-02, 0.19609E-02, 0.14134E+00, 0.14390E+00, 0.13913E+00, 0.13246E+00, &
+         &    0.12185E+00, 0.10596E+00, 0.87518E-01, 0.66164E-01, 0.44862E-01, 0.49402E-02, 0.40857E-02, &
+         &    0.32288E-02, 0.23613E-02, 0.15406E-02, 0.58258E-03, 0.82171E-04, 0.29127E+00, 0.28252E+00, &
+         &    0.22590E+00, 0.14314E+00, 0.45494E-01, 0.71792E-02, 0.38483E-02, 0.65712E-03, 0.29810E+00, &
+         &    0.27559E+00, 0.11997E+00, 0.10351E+00, 0.84515E-01, 0.62253E-01, 0.41050E-01, 0.44217E-02, &
+         &    0.36946E-02, 0.29113E-02, 0.34290E-02, 0.55993E-03, 0.31441E+00, 0.27586E+00, 0.21297E+00, &
+         &    0.14064E+00, 0.45588E-01, 0.65665E-02, 0.34232E-02, 0.53199E-03, 0.19811E+00, 0.16833E+00, &
+         &    0.13536E+00, 0.11549E+00, 0.10649E+00, 0.93264E-01, 0.75720E-01, 0.56405E-01, 0.41865E-01, &
+         &    0.59331E-02, 0.26510E-02, 0.40040E-03, 0.32328E+00, 0.26636E+00, 0.21397E+00, 0.14038E+00, &
+         &    0.52142E-01, 0.38852E-02, 0.14601E+00, 0.13824E+00, 0.27703E+00, 0.22388E+00, 0.15446E+00, &
+         &    0.48687E-01, 0.98054E-02, 0.18870E-02, 0.11961E+00, 0.12106E+00, 0.13215E+00, 0.13516E+00, &
+         &    0.25249E+00, 0.16542E+00, 0.68157E-01, 0.59725E-02, 0.49258E+00, 0.33651E+00, 0.16182E+00, &
+         &    0.90984E-02, 0.95202E+00, 0.47978E-01, 0.91716E+00, 0.82857E-01, 0.77464E+00, 0.22536E+00 /), (/ 1,140 /) )
+
+    call planck_function_surf(1, 1, config, spread(temperature,1,1), &
+         &                    frac, planck_surf)
+
+  end subroutine planck_function
+
+end module radiation_ifs_rrtm
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_interface.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_interface.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_interface.F90	(revision 3908)
@@ -0,0 +1,619 @@
+! radiation_interface.F90 - Public interface to radiation scheme
+!
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2017-04-11  R. Hogan  Changes to enable generalized surface description
+!   2017-09-08  R. Hogan  Reverted some changes
+!
+! To use the radiation scheme, create a configuration_type object,
+! call "setup_radiation" on it once to load the look-up-tables and
+! data describing how gas and hydrometeor absorption/scattering are to
+! be represented, and call "radiation" multiple times on different
+! input profiles.
+
+module radiation_interface
+
+  implicit none
+
+  public  :: setup_radiation, set_gas_units, radiation
+  private :: radiation_reverse
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Load the look-up-tables and data describing how gas and
+  ! hydrometeor absorption/scattering are to be represented
+  subroutine setup_radiation(config)
+
+    use parkind1,         only : jprb
+    use yomhook,          only : lhook, dr_hook
+    use radiation_config, only : config_type, ISolverMcICA, &
+         &   IGasModelMonochromatic, IGasModelIFSRRTMG
+
+    ! Currently there are two gas absorption models: RRTMG (default)
+    ! and monochromatic
+    use radiation_monochromatic,  only : &
+         &   setup_gas_optics_mono     => setup_gas_optics, &
+         &   setup_cloud_optics_mono   => setup_cloud_optics, &
+         &   setup_aerosol_optics_mono => setup_aerosol_optics
+    use radiation_ifs_rrtm,       only :  setup_gas_optics
+    use radiation_cloud_optics,   only :  setup_cloud_optics
+    use radiation_aerosol_optics, only :  setup_aerosol_optics
+
+    type(config_type), intent(inout) :: config
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_interface:setup_radiation',0,hook_handle)
+
+    ! Consolidate configuration data, including setting data file
+    ! names
+    call config%consolidate()
+
+    ! Load the look-up tables from files in the specified directory
+    if (config%i_gas_model == IGasModelMonochromatic) then
+      call setup_gas_optics_mono(config, trim(config%directory_name))
+    else if (config%i_gas_model == IGasModelIFSRRTMG) then
+      call setup_gas_optics(config, trim(config%directory_name))
+    end if
+
+    ! Whether or not the "radiation" subroutine needs ssa_lw and g_lw
+    ! arrays depends on whether longwave scattering by aerosols is to
+    ! be included.  If not, one of the array dimensions will be set to
+    ! zero.
+    if (config%do_lw_aerosol_scattering) then
+      config%n_g_lw_if_scattering = config%n_g_lw
+    else
+      config%n_g_lw_if_scattering = 0
+    end if
+
+    ! Whether or not the "radiation" subroutine needs ssa_lw_cloud and
+    ! g_lw_cloud arrays depends on whether longwave scattering by
+    ! hydrometeors is to be included.  If not, one of the array
+    ! dimensions will be set to zero.
+    if (config%do_lw_cloud_scattering) then
+      config%n_bands_lw_if_scattering = config%n_bands_lw
+    else
+      config%n_bands_lw_if_scattering = 0
+    end if
+
+    ! If we have longwave scattering and McICA then even if there is
+    ! no aerosol, it is convenient if single scattering albedo and
+    ! g factor arrays are allocated before the call to
+    ! solver_lw as they will be needed.
+    if (config%do_lw_cloud_scattering &
+         &  .and. config%i_solver_lw == ISolverMcICA) then
+      config%n_g_lw_if_scattering = config%n_g_lw
+    end if
+
+    ! Consolidate the albedo/emissivity intervals with the shortwave
+    ! and longwave spectral bands
+    call config%consolidate_intervals(.true., &
+           &  config%do_nearest_spectral_sw_albedo, &
+           &  config%sw_albedo_wavelength_bound, config%i_sw_albedo_index, &
+           &  config%wavenumber1_sw, config%wavenumber2_sw, &
+           &  config%i_albedo_from_band_sw, config%sw_albedo_weights)
+    call config%consolidate_intervals(.false., &
+           &  config%do_nearest_spectral_lw_emiss, &
+           &  config%lw_emiss_wavelength_bound, config%i_lw_emiss_index, &
+           &  config%wavenumber1_lw, config%wavenumber2_lw, &
+           &  config%i_emiss_from_band_lw, config%lw_emiss_weights)
+
+    if (config%do_clouds) then
+      if (config%i_gas_model == IGasModelMonochromatic) then
+        !      call setup_cloud_optics_mono(config)
+      else
+        call setup_cloud_optics(config)
+      end if
+    end if
+
+    if (config%use_aerosols) then
+      if (config%i_gas_model == IGasModelMonochromatic) then
+!        call setup_aerosol_optics_mono(config)
+      else 
+        call setup_aerosol_optics(config)
+      end if
+    end if
+
+    ! Load cloud water PDF look-up table for McICA
+    if (         config%i_solver_sw == ISolverMcICA &
+         &  .or. config%i_solver_lw == ISolverMcICA) then
+      call config%pdf_sampler%setup(config%cloud_pdf_file_name, &
+           &                        iverbose=config%iverbosesetup)
+    end if
+
+    if (lhook) call dr_hook('radiation_interface:setup_radiation',1,hook_handle)
+
+  end subroutine setup_radiation
+
+
+  !---------------------------------------------------------------------
+  ! Scale the gas mixing ratios so that they have the units (and
+  ! possibly scale factors) required by the specific gas absorption
+  ! model.  This subroutine simply passes the gas object on to the
+  ! module of the currently active gas model.
+  subroutine set_gas_units(config, gas)
+    
+    use radiation_config
+    use radiation_gas,           only : gas_type
+    use radiation_monochromatic, only : set_gas_units_mono  => set_gas_units
+    use radiation_ifs_rrtm,      only : set_gas_units_ifs   => set_gas_units
+
+    type(config_type), intent(in)    :: config
+    type(gas_type),    intent(inout) :: gas
+
+    if (config%i_gas_model == IGasModelMonochromatic) then
+      call set_gas_units_mono(gas)
+    else
+      call set_gas_units_ifs(gas)
+    end if
+
+  end subroutine set_gas_units
+
+
+  !---------------------------------------------------------------------
+  ! Run the radiation scheme according to the configuration in the
+  ! config object. There are ncol profiles of which only istartcol to
+  ! iendcol are to be processed, and there are nlev model levels.  The
+  ! output fluxes are written to the flux object, and all other
+  ! objects contain the input variables.  The variables may be defined
+  ! either in order of increasing or decreasing pressure, but if in
+  ! order of decreasing pressure then radiation_reverse will be called
+  ! to reverse the order for the computation and then reverse the
+  ! order of the output fluxes to match the inputs.
+  subroutine radiation(ncol, nlev, istartcol, iendcol, config, &
+       &  single_level, thermodynamics, gas, cloud, aerosol, flux)
+
+    use parkind1,                 only : jprb
+    use yomhook,                  only : lhook, dr_hook
+
+    use radiation_io,             only : nulout
+    use radiation_config,         only : config_type, &
+         &   IGasModelMonochromatic, IGasModelIFSRRTMG, &
+         &   ISolverMcICA, ISolverSpartacus, ISolverHomogeneous, &
+         &   ISolverTripleclouds
+    use radiation_single_level,   only : single_level_type
+    use radiation_thermodynamics, only : thermodynamics_type
+    use radiation_gas,            only : gas_type
+    use radiation_cloud,          only : cloud_type
+    use radiation_aerosol,        only : aerosol_type
+    use radiation_flux,           only : flux_type
+    use radiation_spartacus_sw,   only : solver_spartacus_sw
+    use radiation_spartacus_lw,   only : solver_spartacus_lw
+    use radiation_tripleclouds_sw,only : solver_tripleclouds_sw
+    use radiation_tripleclouds_lw,only : solver_tripleclouds_lw
+    use radiation_mcica_sw,       only : solver_mcica_sw
+    use radiation_mcica_lw,       only : solver_mcica_lw
+    use radiation_cloudless_sw,   only : solver_cloudless_sw
+    use radiation_cloudless_lw,   only : solver_cloudless_lw
+    use radiation_homogeneous_sw, only : solver_homogeneous_sw
+    use radiation_homogeneous_lw, only : solver_homogeneous_lw
+    use radiation_save,           only : save_radiative_properties
+
+    ! Treatment of gas and hydrometeor optics 
+    use radiation_monochromatic,  only : &
+         &   gas_optics_mono         => gas_optics, &
+         &   cloud_optics_mono       => cloud_optics, &
+         &   add_aerosol_optics_mono => add_aerosol_optics
+    use radiation_ifs_rrtm,       only : gas_optics
+    use radiation_cloud_optics,   only : cloud_optics
+    use radiation_aerosol_optics, only : add_aerosol_optics
+
+    ! Inputs
+    integer, intent(in) :: ncol               ! number of columns
+    integer, intent(in) :: nlev               ! number of model levels
+    integer, intent(in) :: istartcol, iendcol ! range of columns to process
+    type(config_type),        intent(in)   :: config
+    type(single_level_type),  intent(in)   :: single_level
+    type(thermodynamics_type),intent(in)   :: thermodynamics
+    type(gas_type),           intent(in)   :: gas
+    type(cloud_type),         intent(inout):: cloud
+    type(aerosol_type),       intent(in)   :: aerosol
+    ! Output
+    type(flux_type),          intent(inout):: flux
+
+
+    ! Local variables
+
+    ! Layer optical depth, single scattering albedo and asymmetry factor of
+    ! gases and aerosols at each longwave g-point, where the latter
+    ! two variables are only defined if aerosol longwave scattering is
+    ! enabled (otherwise both are treated as zero).
+    real(jprb), dimension(config%n_g_lw,nlev,istartcol:iendcol) :: od_lw
+    real(jprb), dimension(config%n_g_lw_if_scattering,nlev,istartcol:iendcol) :: &
+         &  ssa_lw, g_lw
+
+    ! Layer in-cloud optical depth, single scattering albedo and
+    ! asymmetry factor of hydrometeors in each longwave band, where
+    ! the latter two variables are only defined if hydrometeor
+    ! longwave scattering is enabled (otherwise both are treated as
+    ! zero).
+    real(jprb), dimension(config%n_bands_lw,nlev,istartcol:iendcol) :: od_lw_cloud
+    real(jprb), dimension(config%n_bands_lw_if_scattering,nlev,istartcol:iendcol) :: &
+         &  ssa_lw_cloud, g_lw_cloud
+
+    ! Layer optical depth, single scattering albedo and asymmetry factor of
+    ! gases and aerosols at each shortwave g-point
+    real(jprb), dimension(config%n_g_sw,nlev,istartcol:iendcol) :: od_sw, ssa_sw, g_sw
+
+    ! Layer in-cloud optical depth, single scattering albedo and
+    ! asymmetry factor of hydrometeors in each shortwave band
+    real(jprb), dimension(config%n_bands_sw,nlev,istartcol:iendcol)   :: &
+         &  od_sw_cloud, ssa_sw_cloud, g_sw_cloud
+
+    ! The Planck function (emitted flux from a black body) at half
+    ! levels
+    real(jprb), dimension(config%n_g_lw,nlev+1,istartcol:iendcol) :: planck_hl
+
+    ! The longwave emission from and albedo of the surface in each
+    ! longwave g-point; note that these are weighted averages of the
+    ! values from individual tiles
+    real(jprb), dimension(config%n_g_lw, istartcol:iendcol) :: lw_emission
+    real(jprb), dimension(config%n_g_lw, istartcol:iendcol) :: lw_albedo
+
+    ! Direct and diffuse shortwave surface albedo in each shortwave
+    ! g-point; note that these are weighted averages of the values
+    ! from individual tiles
+    real(jprb), dimension(config%n_g_sw, istartcol:iendcol) :: sw_albedo_direct
+    real(jprb), dimension(config%n_g_sw, istartcol:iendcol) :: sw_albedo_diffuse
+
+    ! The incoming shortwave flux into a plane perpendicular to the
+    ! incoming radiation at top-of-atmosphere in each of the shortwave
+    ! g-points
+    real(jprb), dimension(config%n_g_sw,istartcol:iendcol) :: incoming_sw
+
+    character(len=100) :: rad_prop_file_name
+    character(*), parameter :: rad_prop_base_file_name = "radiative_properties"
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_interface:radiation',0,hook_handle)
+
+    if (thermodynamics%pressure_hl(istartcol,2) &
+         &  < thermodynamics%pressure_hl(istartcol,1)) then
+      ! Input arrays are arranged in order of decreasing pressure /
+      ! increasing height: the following subroutine reverses them,
+      ! call the radiation scheme and then reverses the returned
+      ! fluxes
+      call radiation_reverse(ncol, nlev, istartcol, iendcol, config, &
+           &  single_level, thermodynamics, gas, cloud, aerosol, flux)
+    else
+
+      ! Input arrays arranged in order of increasing pressure /
+      ! decreasing height: progress normally
+
+      ! Extract surface albedos at each gridpoint
+      call single_level%get_albedos(istartcol, iendcol, config, &
+           &                        sw_albedo_direct, sw_albedo_diffuse, &
+           &                        lw_albedo)
+
+      ! Compute gas absorption optical depth in shortwave and
+      ! longwave, shortwave single scattering albedo (i.e. fraction of
+      ! extinction due to Rayleigh scattering), Planck functions and
+      ! incoming shortwave flux at each g-point, for the specified
+      ! range of atmospheric columns
+      if (config%i_gas_model == IGasModelMonochromatic) then
+        call gas_optics_mono(ncol,nlev,istartcol,iendcol, config, &
+             &  single_level, thermodynamics, gas, lw_albedo, &
+             &  od_lw, od_sw, ssa_sw, &
+             &  planck_hl, lw_emission, incoming_sw)
+      else
+        call gas_optics(ncol,nlev,istartcol,iendcol, config, &
+             &  single_level, thermodynamics, gas, &
+             &  od_lw, od_sw, ssa_sw, lw_albedo=lw_albedo, &
+             &  planck_hl=planck_hl, lw_emission=lw_emission, &
+             &  incoming_sw=incoming_sw)
+      end if
+
+      if (config%do_clouds) then
+        ! Crop the cloud fraction to remove clouds that have too small
+        ! a fraction or water content; after this, we can safely
+        ! assume that a cloud is present if cloud%fraction > 0.0.
+        call cloud%crop_cloud_fraction(istartcol, iendcol, &
+             &            config%cloud_fraction_threshold, &
+             &            config%cloud_mixing_ratio_threshold)
+
+        ! Compute hydrometeor absorption/scattering properties in each
+        ! shortwave and longwave band
+        if (config%i_gas_model == IGasModelMonochromatic) then
+          call cloud_optics_mono(nlev, istartcol, iendcol, &
+               &  config, thermodynamics, cloud, &
+               &  od_lw_cloud, ssa_lw_cloud, g_lw_cloud, &
+               &  od_sw_cloud, ssa_sw_cloud, g_sw_cloud)
+        else
+          call cloud_optics(nlev, istartcol, iendcol, &
+               &  config, thermodynamics, cloud, & 
+               &  od_lw_cloud, ssa_lw_cloud, g_lw_cloud, &
+               &  od_sw_cloud, ssa_sw_cloud, g_sw_cloud)
+        end if
+      end if ! do_clouds
+
+      if (config%use_aerosols) then
+        if (config%i_gas_model == IGasModelMonochromatic) then
+!          call add_aerosol_optics_mono(nlev,istartcol,iendcol, &
+!               &  config, thermodynamics, gas, aerosol, & 
+!               &  od_lw, ssa_lw, g_lw, od_sw, ssa_sw, g_sw)
+        else
+          call add_aerosol_optics(nlev,istartcol,iendcol, &
+               &  config, thermodynamics, gas, aerosol, & 
+               &  od_lw, ssa_lw, g_lw, od_sw, ssa_sw, g_sw)
+        end if
+      else
+        g_sw = 0.0_jprb
+        if (config%do_lw_aerosol_scattering) then
+          ssa_lw = 0.0_jprb
+          g_lw   = 0.0_jprb
+        end if
+      end if
+
+      ! For diagnostic purposes, save these intermediate variables to
+      ! a NetCDF file
+      if (config%do_save_radiative_properties) then
+        if (istartcol == 1 .and. iendcol == ncol) then
+          rad_prop_file_name = rad_prop_base_file_name // ".nc"
+        else
+          write(rad_prop_file_name,'(a,a,i4.4,a,i4.4,a)') &
+               &  rad_prop_base_file_name, '_', istartcol, '-',iendcol,'.nc'
+        end if
+        call save_radiative_properties(trim(rad_prop_file_name), &
+             &  nlev, istartcol, iendcol, &
+             &  config, single_level, thermodynamics, cloud, &
+             &  planck_hl, lw_emission, lw_albedo, &
+             &  sw_albedo_direct, sw_albedo_diffuse, incoming_sw, &
+             &  od_lw, ssa_lw, g_lw, od_sw, ssa_sw, g_sw, &
+             &  od_lw_cloud, ssa_lw_cloud, g_lw_cloud, &
+             &  od_sw_cloud, ssa_sw_cloud, g_sw_cloud)
+      end if
+
+      if (config%do_lw) then
+        if (config%iverbose >= 2) then
+          write(nulout,'(a)') 'Computing longwave fluxes'
+        end if
+
+        if (config%i_solver_lw == ISolverMcICA) then
+          ! Compute fluxes using the McICA longwave solver
+          call solver_mcica_lw(nlev,istartcol,iendcol, &
+               &  config, single_level, cloud, & 
+               &  od_lw, ssa_lw, g_lw, od_lw_cloud, ssa_lw_cloud, &
+               &  g_lw_cloud, planck_hl, lw_emission, lw_albedo, flux)
+        else if (config%i_solver_lw == ISolverSPARTACUS) then
+          ! Compute fluxes using the SPARTACUS longwave solver
+          call solver_spartacus_lw(nlev,istartcol,iendcol, &
+               &  config, thermodynamics, cloud, & 
+               &  od_lw, ssa_lw, g_lw, od_lw_cloud, ssa_lw_cloud, g_lw_cloud, &
+               &  planck_hl, lw_emission, lw_albedo, flux)
+        else if (config%i_solver_lw == ISolverTripleclouds) then
+          ! Compute fluxes using the Tripleclouds longwave solver
+          call solver_tripleclouds_lw(nlev,istartcol,iendcol, &
+               &  config, cloud, & 
+               &  od_lw, ssa_lw, g_lw, od_lw_cloud, ssa_lw_cloud, g_lw_cloud, &
+               &  planck_hl, lw_emission, lw_albedo, flux)
+        elseif (config%i_solver_lw == ISolverHomogeneous) then
+          ! Compute fluxes using the homogeneous solver
+          call solver_homogeneous_lw(nlev,istartcol,iendcol, &
+               &  config, cloud, & 
+               &  od_lw, ssa_lw, g_lw, od_lw_cloud, ssa_lw_cloud, &
+               &  g_lw_cloud, planck_hl, lw_emission, lw_albedo, flux)
+        else
+          ! Compute fluxes using the cloudless solver
+          call solver_cloudless_lw(nlev,istartcol,iendcol, &
+               &  config, od_lw, ssa_lw, g_lw, &
+               &  planck_hl, lw_emission, lw_albedo, flux)
+        end if
+      end if
+
+      if (config%do_sw) then
+        if (config%iverbose >= 2) then
+          write(nulout,'(a)') 'Computing shortwave fluxes'
+        end if
+
+        if (config%i_solver_sw == ISolverMcICA) then
+          ! Compute fluxes using the McICA shortwave solver
+          call solver_mcica_sw(nlev,istartcol,iendcol, &
+               &  config, single_level, cloud, & 
+               &  od_sw, ssa_sw, g_sw, od_sw_cloud, ssa_sw_cloud, &
+               &  g_sw_cloud, sw_albedo_direct, sw_albedo_diffuse, &
+               &  incoming_sw, flux)
+        else if (config%i_solver_sw == ISolverSPARTACUS) then
+          ! Compute fluxes using the SPARTACUS shortwave solver
+          call solver_spartacus_sw(nlev,istartcol,iendcol, &
+               &  config, single_level, thermodynamics, cloud, & 
+               &  od_sw, ssa_sw, g_sw, od_sw_cloud, ssa_sw_cloud, &
+               &  g_sw_cloud, sw_albedo_direct, sw_albedo_diffuse, &
+               &  incoming_sw, flux)
+        else if (config%i_solver_sw == ISolverTripleclouds) then
+          ! Compute fluxes using the Tripleclouds shortwave solver
+          call solver_tripleclouds_sw(nlev,istartcol,iendcol, &
+               &  config, single_level, cloud, & 
+               &  od_sw, ssa_sw, g_sw, od_sw_cloud, ssa_sw_cloud, &
+               &  g_sw_cloud, sw_albedo_direct, sw_albedo_diffuse, &
+               &  incoming_sw, flux)
+        elseif (config%i_solver_sw == ISolverHomogeneous) then
+          ! Compute fluxes using the homogeneous solver
+          call solver_homogeneous_sw(nlev,istartcol,iendcol, &
+               &  config, single_level, cloud, & 
+               &  od_sw, ssa_sw, g_sw, od_sw_cloud, ssa_sw_cloud, &
+               &  g_sw_cloud, sw_albedo_direct, sw_albedo_diffuse, &
+               &  incoming_sw, flux)
+        else
+          ! Compute fluxes using the cloudless solver
+          call solver_cloudless_sw(nlev,istartcol,iendcol, &
+               &  config, single_level, od_sw, ssa_sw, g_sw, &
+               &  sw_albedo_direct, sw_albedo_diffuse, &
+               &  incoming_sw, flux)
+        end if
+      end if
+
+      ! Store surface downwelling fluxes in bands from fluxes in g
+      ! points
+      call flux%calc_surface_spectral(config, istartcol, iendcol)
+
+    end if
+    
+    if (lhook) call dr_hook('radiation_interface:radiation',1,hook_handle)
+
+  end subroutine radiation
+
+
+  !---------------------------------------------------------------------
+  ! If the input arrays are arranged in order of decreasing pressure /
+  ! increasing height then this subroutine reverses them, calls the
+  ! radiation scheme and then reverses the returned fluxes. Since this
+  ! subroutine calls, and is called by "radiation", it must be in this
+  ! module to avoid circular dependencies.
+  subroutine radiation_reverse(ncol, nlev, istartcol, iendcol, config, &
+       &  single_level, thermodynamics, gas, cloud, aerosol, flux)
+ 
+    use parkind1, only : jprb
+
+    use radiation_io,             only : nulout
+    use radiation_config,         only : config_type
+    use radiation_single_level,   only : single_level_type
+    use radiation_thermodynamics, only : thermodynamics_type
+    use radiation_gas,            only : gas_type
+    use radiation_cloud,          only : cloud_type
+    use radiation_aerosol,        only : aerosol_type
+    use radiation_flux,           only : flux_type
+
+    ! Inputs
+    integer, intent(in) :: ncol               ! number of columns
+    integer, intent(in) :: nlev               ! number of model levels
+    integer, intent(in) :: istartcol, iendcol ! range of columns to process
+    type(config_type),        intent(in) :: config
+    type(single_level_type),  intent(in) :: single_level
+    type(thermodynamics_type),intent(in) :: thermodynamics
+    type(gas_type),           intent(in) :: gas
+    type(cloud_type),         intent(in) :: cloud
+    type(aerosol_type),       intent(in) :: aerosol
+    ! Output
+    type(flux_type),          intent(inout):: flux
+
+    ! Reversed data structures
+    type(thermodynamics_type) :: thermodynamics_rev
+    type(gas_type)            :: gas_rev
+    type(cloud_type)          :: cloud_rev
+    type(aerosol_type)        :: aerosol_rev
+    type(flux_type)           :: flux_rev
+
+    ! Start and end levels for aerosol data
+    integer :: istartlev, iendlev
+
+    if (config%iverbose >= 2) then
+      write(nulout,'(a)') 'Reversing arrays to be in order of increasing pressure'
+    end if
+
+    ! Allocate reversed arrays
+    call thermodynamics_rev%allocate(ncol, nlev)
+    call cloud_rev%allocate(ncol, nlev)
+    call flux_rev%allocate(config, istartcol, iendcol, nlev)
+    if (allocated(aerosol%mixing_ratio)) then
+      istartlev = nlev + 1 - aerosol%iendlev
+      iendlev   = nlev + 1 - aerosol%istartlev
+      call aerosol_rev%allocate(ncol, istartlev, iendlev, &
+           &                    config%n_aerosol_types)
+    end if
+
+    ! Fill reversed thermodynamic arrays
+    thermodynamics_rev%pressure_hl(istartcol:iendcol,:) &
+         &  = thermodynamics%pressure_hl(istartcol:iendcol, nlev+1:1:-1)
+    thermodynamics_rev%temperature_hl(istartcol:iendcol,:) &
+         &  = thermodynamics%temperature_hl(istartcol:iendcol, nlev+1:1:-1)
+
+    ! Fill reversed gas arrays
+    call gas%reverse(istartcol, iendcol, gas_rev)
+
+    if (config%do_clouds) then
+      ! Fill reversed cloud arrays
+      cloud_rev%q_liq(istartcol:iendcol,:) &
+           &  = cloud%q_liq(istartcol:iendcol,nlev:1:-1)
+      cloud_rev%re_liq(istartcol:iendcol,:) &
+           &  = cloud%re_liq(istartcol:iendcol,nlev:1:-1)
+      cloud_rev%q_ice(istartcol:iendcol,:) &
+           &  = cloud%q_ice(istartcol:iendcol,nlev:1:-1)
+      cloud_rev%re_ice(istartcol:iendcol,:) &
+           &  = cloud%re_ice(istartcol:iendcol,nlev:1:-1)
+      cloud_rev%fraction(istartcol:iendcol,:) &
+           &  = cloud%fraction(istartcol:iendcol,nlev:1:-1)
+      cloud_rev%overlap_param(istartcol:iendcol,:) &
+           &  = cloud%overlap_param(istartcol:iendcol,nlev-1:1:-1)
+      if (allocated(cloud%fractional_std)) then
+        cloud_rev%fractional_std(istartcol:iendcol,:) &
+             &  = cloud%fractional_std(istartcol:iendcol,nlev:1:-1)
+      else
+        cloud_rev%fractional_std(istartcol:iendcol,:) = 0.0_jprb       
+      end if
+      if (allocated(cloud%inv_cloud_effective_size)) then
+        cloud_rev%inv_cloud_effective_size(istartcol:iendcol,:) &
+             &  = cloud%inv_cloud_effective_size(istartcol:iendcol,nlev:1:-1)
+      else
+        cloud_rev%inv_cloud_effective_size(istartcol:iendcol,:) = 0.0_jprb
+      end if
+    end if
+
+    if (allocated(aerosol%mixing_ratio)) then
+      aerosol_rev%mixing_ratio(:,istartlev:iendlev,:) &
+           &  = aerosol%mixing_ratio(:,aerosol%iendlev:aerosol%istartlev:-1,:)
+    end if
+
+    ! Run radiation scheme on reversed profiles
+    call radiation(ncol, nlev,istartcol,iendcol, &
+         &  config, single_level, thermodynamics_rev, gas_rev, &
+         &  cloud_rev, aerosol_rev, flux_rev)
+
+    ! Reorder fluxes
+    if (allocated(flux%lw_up)) then
+      flux%lw_up(istartcol:iendcol,:) &
+           &  = flux_rev%lw_up(istartcol:iendcol,nlev+1:1:-1)
+      flux%lw_dn(istartcol:iendcol,:) &
+           &  = flux_rev%lw_dn(istartcol:iendcol,nlev+1:1:-1)
+      if (allocated(flux%lw_up_clear)) then
+        flux%lw_up_clear(istartcol:iendcol,:) &
+             &  = flux_rev%lw_up_clear(istartcol:iendcol,nlev+1:1:-1)
+        flux%lw_dn_clear(istartcol:iendcol,:) &
+             &  = flux_rev%lw_dn_clear(istartcol:iendcol,nlev+1:1:-1)
+      end if
+    end if
+    if (allocated(flux%sw_up)) then
+      flux%sw_up(istartcol:iendcol,:) &
+           &  = flux_rev%sw_up(istartcol:iendcol,nlev+1:1:-1)
+      flux%sw_dn(istartcol:iendcol,:) &
+           &  = flux_rev%sw_dn(istartcol:iendcol,nlev+1:1:-1)
+      if (allocated(flux%sw_dn_direct)) then
+        flux%sw_dn_direct(istartcol:iendcol,:) &
+             &  = flux_rev%sw_dn_direct(istartcol:iendcol,nlev+1:1:-1)
+      end if
+      if (allocated(flux%sw_up_clear)) then
+        flux%sw_up_clear(istartcol:iendcol,:) &
+             &  = flux_rev%sw_up_clear(istartcol:iendcol,nlev+1:1:-1)
+        flux%sw_dn_clear(istartcol:iendcol,:) &
+             &  = flux_rev%sw_dn_clear(istartcol:iendcol,nlev+1:1:-1)
+        if (allocated(flux%sw_dn_direct_clear)) then
+          flux%sw_dn_direct_clear(istartcol:iendcol,:) &
+               &  = flux_rev%sw_dn_direct_clear(istartcol:iendcol,nlev+1:1:-1)
+        end if
+      end if
+    end if
+
+    ! Deallocate reversed arrays
+    call thermodynamics_rev%deallocate
+    call gas_rev%deallocate
+    call cloud_rev%deallocate
+    call flux_rev%deallocate
+    if (allocated(aerosol%mixing_ratio)) then
+      call aerosol_rev%deallocate
+    end if
+
+  end subroutine radiation_reverse
+
+end module radiation_interface
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_io.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_io.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_io.F90	(revision 3908)
@@ -0,0 +1,63 @@
+! radiation_io.F90 - Provides logging and abort functionality
+!
+! (C) Copyright 2015- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+!  This file provides an interface to the provision of file units used
+!  for logging (nulout and nulerr) and for reading data files
+!  (nulrad), as well as an abort routine that should do clean-up
+!  appropriate for the environment in which the radiation scheme is
+!  embedded.
+!
+!  Rewrite this file as appropriate if the radiation scheme is to be
+!  embedded into a model other than the ECMWF Integrated Forecasting
+!  System.
+
+module radiation_io
+
+  ! In the IFS, nulout is equivalent to standard output but only
+  ! output from the primary node will be logged, while nulerr is
+  ! equivalent to standard error, and text sent to this unit from any
+  ! node will be logged. Normally, nulerr should only be used before
+  ! calling radiation_abort.
+  use yomlun_ifsaux, only : nulout, nulerr
+
+  implicit none
+  public
+
+  ! This unit may be used for reading radiation configuration files,
+  ! but should be closed as soon as the file is read
+  integer :: nulrad = 25
+
+contains
+
+  ! Abort the program with optional error message. Normally you would
+  ! log details of the error to nulerr before calling this subroutine.
+  subroutine radiation_abort(text)
+    character(len=*), intent(in), optional :: text
+    if (present(text)) then
+      write(nulerr,'(a)') text
+#ifdef __PGI
+      stop 1
+#else
+      error stop 1
+#endif
+    else
+#ifdef __PGI
+      stop 'Error in radiation scheme'
+#else
+      error stop 'Error in radiation scheme'
+#endif
+    end if
+  end subroutine radiation_abort
+
+end module radiation_io
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_liquid_optics_slingo.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_liquid_optics_slingo.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_liquid_optics_slingo.F90	(revision 3908)
@@ -0,0 +1,109 @@
+! radiation_liquid_optics_slingo.F90 - Slingo SW & Lindner-Li LW parameterization of liquid droplet optics
+!
+! (C) Copyright 2016- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+
+module radiation_liquid_optics_slingo
+
+  implicit none
+  public
+
+  integer, parameter :: NLiqOpticsCoeffsSlingoSW = 6
+  integer, parameter :: NLiqOpticsCoeffsLindnerLiLW = 13
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Compute liquid-droplet scattering properties in the shortwave from
+  ! Slingo (1989). WARNING: this parameterization is known not to be
+  ! very accurate: see Nielsen et al. (GMD 2014).
+  subroutine calc_liq_optics_slingo(nb, coeff, lwp, re, od, scat_od, g)
+
+    use parkind1, only : jprb
+    !use yomhook,  only : lhook, dr_hook
+
+    ! Number of bands
+    integer, intent(in)  :: nb
+    ! Coefficients read from a data file
+    real(jprb), intent(in) :: coeff(:,:)
+    ! Liquid water path (kg m-2) and effective radius (m)
+    real(jprb), intent(in) :: lwp, re
+    ! Total optical depth, scattering optical depth and asymmetry factor
+    real(jprb), intent(out) :: od(nb), scat_od(nb), g(nb)
+
+    ! Liquid water path in g m-2
+    real(jprb) :: lwp_gm_2
+    ! Effective radius in microns, and its inverse
+    real(jprb) :: re_um, inv_re_um
+
+    !real(jprb) :: hook_handle
+
+    !if (lhook) call dr_hook('radiation_liquid_optics_slingo:calc_liq_optics_slingo',0,hook_handle)
+
+    lwp_gm_2 = lwp * 1000.0_jprb
+    ! Range of validity reported by Slingo (1989): 4.2-16.6 microns
+    re_um = min(max(4.2_jprb, re * 1.0e6_jprb), 16.6_jprb)
+    inv_re_um = 1.0_jprb / re_um
+
+    od = lwp_gm_2 * (coeff(1:nb,1) + inv_re_um*coeff(1:nb,2))
+    scat_od = od * (1.0_jprb - coeff(1:nb,3) - re_um*coeff(1:nb,4))
+    g = coeff(1:nb,5) + re_um*coeff(1:nb,6)
+
+    !if (lhook) call dr_hook('radiation_liquid_optics_slingo:calc_liq_optics_slingo',1,hook_handle)
+
+  end subroutine calc_liq_optics_slingo
+
+
+  !---------------------------------------------------------------------
+  ! Compute liquid-droplet scattering properties in the longwave from
+  ! Lindner & Li (2000)
+  subroutine calc_liq_optics_lindner_li(nb, coeff, lwp, re, od, scat_od, g)
+
+    use parkind1, only : jprb
+    use yomhook,  only : lhook, dr_hook
+
+    ! Number of bands
+    integer, intent(in)  :: nb
+    ! Coefficients read from a data file
+    real(jprb), intent(in) :: coeff(:,:)
+    ! Liquid water path (kg m-2) and effective radius (m)
+    real(jprb), intent(in) :: lwp, re
+    ! Total optical depth, scattering optical depth and asymmetry factor
+    real(jprb), intent(out) :: od(nb), scat_od(nb), g(nb)
+
+    ! Liquid water path in g m-2
+    real(jprb) :: lwp_gm_2
+    ! Effective radius in microns, and its inverse
+    real(jprb) :: re_um, inv_re_um
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_liquid_optics_slingo:calc_liq_optics_lindner_li',0,hook_handle)
+
+    lwp_gm_2 = lwp * 1000.0_jprb
+    ! Range of validity reported by Lindner and Li (2000): 2-40 microns
+    re_um = min(max(2.0_jprb, re * 1.0e6_jprb), 40.0_jprb)
+    inv_re_um = 1.0_jprb / re_um
+
+    od = lwp_gm_2 * (coeff(1:nb,1) + re_um*coeff(1:nb,2) + inv_re_um*(coeff(1:nb,3) &
+         &  + inv_re_um*(coeff(1:nb,4) + inv_re_um*coeff(1:nb,5))))
+    scat_od = od * (1.0_jprb - (coeff(1:nb,6) + inv_re_um*coeff(1:nb,7) &
+         &                      + re_um*(coeff(1:nb,8) + re_um*coeff(1:nb,9))))
+    g = coeff(1:nb,10) + inv_re_um*coeff(1:nb,11) &
+         &  + re_um*(coeff(1:nb,12) + re_um*coeff(1:nb,13))
+
+    if (lhook) call dr_hook('radiation_liquid_optics_slingo:calc_liq_optics_lindner_li',1,hook_handle)
+
+  end subroutine calc_liq_optics_lindner_li
+
+end module radiation_liquid_optics_slingo
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_liquid_optics_socrates.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_liquid_optics_socrates.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_liquid_optics_socrates.F90	(revision 3908)
@@ -0,0 +1,77 @@
+! radiation_liquid_optics_socrates.F90 - SOCRATES method for parameterizing liquid droplet optics
+!
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2020-08-10  R. Hogan  Bounded re to be >=1.2um and <=50um
+
+module radiation_liquid_optics_socrates
+
+  use parkind1, only : jprb
+
+  implicit none
+  public
+
+  ! SOCRATES (Edwards-Slingo) parameterizes info on the dependence of
+  ! the scattering properties in each band on effective radius in
+  ! terms of 16 coefficients
+  integer, parameter :: NLiqOpticsCoeffsSOCRATES = 16
+
+  ! Range of valid input effective radius, in microns
+  real(jprb), parameter :: MinEffectiveRadius = 1.2e-6
+  real(jprb), parameter :: MaxEffectiveRadius = 50.0e-6
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Compute liquid-droplet scattering properties using a
+  ! parameterization consisting of Pade approximants from the
+  ! SOCRATES (Edwards-Slingo) code
+  subroutine calc_liq_optics_socrates(nb, coeff, lwp, re_in, od, scat_od, g)
+
+    use parkind1, only : jprb
+    !use yomhook,  only : lhook, dr_hook
+
+    ! Number of bands
+    integer, intent(in)  :: nb
+    ! Coefficients read from a data file
+    real(jprb), intent(in) :: coeff(:,:)
+    ! Liquid water path (kg m-2) and effective radius (m)
+    real(jprb), intent(in) :: lwp, re_in
+    ! Total optical depth, scattering optical depth and asymmetry factor
+    real(jprb), intent(out) :: od(nb), scat_od(nb), g(nb)
+
+    ! Local effective radius (m), after applying bounds
+    real(jprb) :: re
+
+    !real(jprb) :: hook_handle
+
+    !if (lhook) call dr_hook('radiation_liquid_optics_socrates:calc_liq_optics_socrates',0,hook_handle)
+
+    ! Apply the bounds of validity to effective radius
+    re = max(MinEffectiveRadius, min(re_in, MaxEffectiveRadius))
+
+    od = lwp * (coeff(1:nb,1) + re*(coeff(1:nb,2) + re*coeff(1:nb,3))) &
+         &  / (1.0_jprb + re*(coeff(1:nb,4) + re*(coeff(1:nb,5) &
+         &  + re*coeff(1:nb,6))))
+    scat_od = od * (1.0_jprb &
+         &  - (coeff(1:nb,7) + re*(coeff(1:nb,8) + re*coeff(1:nb,9))) &
+         &  / (1.0_jprb + re*(coeff(1:nb,10) + re*coeff(1:nb,11))))
+    g = (coeff(1:nb,12) + re*(coeff(1:nb,13) + re*coeff(1:nb,14))) &
+         &  / (1.0_jprb + re*(coeff(1:nb,15) + re*coeff(1:nb,16)))
+
+    !if (lhook) call dr_hook('radiation_liquid_optics_socrates:calc_liq_optics_socrates',1,hook_handle)
+
+  end subroutine calc_liq_optics_socrates
+
+end module radiation_liquid_optics_socrates
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_lw_derivatives.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_lw_derivatives.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_lw_derivatives.F90	(revision 3908)
@@ -0,0 +1,257 @@
+! radiation_lw_derivatives.F90 - Compute longwave derivatives for Hogan and Bozzo (2015) method
+!
+! (C) Copyright 2016- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! This module provides routines to compute the rate of change of
+! broadband upwelling longwave flux at each half level with respect to
+! the surface broadband upwelling flux.  This is done from the surface
+! spectral fluxes and the spectral transmittance of each atmospheric
+! layer, assuming no longwave scattering. The result may be used to
+! perform approximate updates to the longwave flux profile in between
+! calls to the full radiation scheme, accounting for the change in
+! skin temperature, following the method of Hogan and Bozzo (JAMES
+! 2015).  Separate routines are provided for each solver.
+!
+! Note that currently a more approximate calculation is performed from
+! the exact one in Hogan and Bozzo (2015); here we assume that a
+! change in temperature increases the spectral fluxes in proportion,
+! when in reality there is a change in shape of the Planck function in
+! addition to an overall increase in the total emission.
+!
+! Modifications
+!   2017-10-23  R. Hogan  Renamed single-character variables
+
+module radiation_lw_derivatives
+
+  public
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Calculation for the Independent Column Approximation
+  subroutine calc_lw_derivatives_ica(ng, nlev, icol, transmittance, flux_up_surf, lw_derivatives)
+
+    use parkind1, only           : jprb
+    use yomhook,  only           : lhook, dr_hook
+
+    implicit none
+
+    ! Inputs
+    integer,    intent(in) :: ng   ! number of spectral intervals
+    integer,    intent(in) :: nlev ! number of levels
+    integer,    intent(in) :: icol ! Index of column for output
+    real(jprb), intent(in) :: transmittance(ng,nlev)
+    real(jprb), intent(in) :: flux_up_surf(ng) ! Upwelling surface spectral flux (W m-2)
+    
+    ! Output
+    real(jprb), intent(out) :: lw_derivatives(:,:) ! dimensioned (ncol,nlev+1)
+
+    ! Rate of change of spectral flux at a given height with respect
+    ! to the surface value
+    real(jprb) :: lw_derivatives_g(ng)
+
+    integer    :: jlev
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_lw_derivatives:calc_lw_derivatives_ica',0,hook_handle)
+
+    ! Initialize the derivatives at the surface
+    lw_derivatives_g = flux_up_surf / sum(flux_up_surf)
+    lw_derivatives(icol, nlev+1) = 1.0_jprb
+
+    ! Move up through the atmosphere computing the derivatives at each
+    ! half-level
+    do jlev = nlev,1,-1
+      lw_derivatives_g = lw_derivatives_g * transmittance(:,jlev)
+      lw_derivatives(icol,jlev) = sum(lw_derivatives_g)
+    end do
+
+    if (lhook) call dr_hook('radiation_lw_derivatives:calc_lw_derivatives_ica',1,hook_handle)
+
+  end subroutine calc_lw_derivatives_ica
+
+
+  !---------------------------------------------------------------------
+  ! Calculation for the Independent Column Approximation
+  subroutine modify_lw_derivatives_ica(ng, nlev, icol, transmittance, &
+       &                               flux_up_surf, weight, lw_derivatives)
+
+    use parkind1, only           : jprb
+    use yomhook,  only           : lhook, dr_hook
+
+    implicit none
+
+    ! Inputs
+    integer,    intent(in) :: ng   ! number of spectral intervals
+    integer,    intent(in) :: nlev ! number of levels
+    integer,    intent(in) :: icol ! Index of column for output
+    real(jprb), intent(in) :: transmittance(ng,nlev)
+    real(jprb), intent(in) :: flux_up_surf(ng) ! Upwelling surface spectral flux (W m-2)
+    real(jprb), intent(in) :: weight ! Weight new values against existing
+    
+    ! Output
+    real(jprb), intent(inout) :: lw_derivatives(:,:) ! dimensioned (ncol,nlev+1)
+
+    ! Rate of change of spectral flux at a given height with respect
+    ! to the surface value
+    real(jprb) :: lw_derivatives_g(ng)
+
+    integer    :: jlev
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_lw_derivatives:modify_lw_derivatives_ica',0,hook_handle)
+
+    ! Initialize the derivatives at the surface
+    lw_derivatives_g = flux_up_surf / sum(flux_up_surf)
+    ! This value must be 1 so no weighting applied
+    lw_derivatives(icol, nlev+1) = 1.0_jprb
+
+    ! Move up through the atmosphere computing the derivatives at each
+    ! half-level
+    do jlev = nlev,1,-1
+      lw_derivatives_g = lw_derivatives_g * transmittance(:,jlev)
+      lw_derivatives(icol,jlev) = (1.0_jprb - weight) * lw_derivatives(icol,jlev) &
+           &                    + weight * sum(lw_derivatives_g)
+    end do
+
+    if (lhook) call dr_hook('radiation_lw_derivatives:modify_lw_derivatives_ica',1,hook_handle)
+
+  end subroutine modify_lw_derivatives_ica
+
+
+
+  !---------------------------------------------------------------------
+  ! Calculation for solvers involving multiple regions and matrices
+  subroutine calc_lw_derivatives_matrix(ng, nlev, nreg, icol, transmittance, &
+       &                                u_matrix, flux_up_surf, lw_derivatives)
+
+    use parkind1, only           : jprb
+    use yomhook,  only           : lhook, dr_hook
+
+    use radiation_matrix
+
+    implicit none
+
+    ! Inputs
+    integer,    intent(in) :: ng   ! number of spectral intervals
+    integer,    intent(in) :: nlev ! number of levels
+    integer,    intent(in) :: nreg ! number of regions
+    integer,    intent(in) :: icol ! Index of column for output
+    real(jprb), intent(in) :: transmittance(ng,nreg,nreg,nlev)
+    real(jprb), intent(in) :: u_matrix(nreg,nreg,nlev+1) ! Upward overlap matrix
+    real(jprb), intent(in) :: flux_up_surf(ng) ! Upwelling surface spectral flux (W m-2)
+    
+    ! Output
+    real(jprb), intent(out) :: lw_derivatives(:,:) ! dimensioned (ncol,nlev+1)
+
+    ! Rate of change of spectral flux at a given height with respect
+    ! to the surface value
+    real(jprb) :: lw_derivatives_g_reg(ng,nreg)
+
+    integer    :: jlev
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_lw_derivatives:calc_lw_derivatives_matrix',0,hook_handle)
+
+    ! Initialize the derivatives at the surface; the surface is
+    ! treated as a single clear-sky layer so we only need to put
+    ! values in region 1.
+    lw_derivatives_g_reg = 0.0_jprb
+    lw_derivatives_g_reg(:,1) = flux_up_surf / sum(flux_up_surf)
+    lw_derivatives(icol, nlev+1) = 1.0_jprb
+
+    ! Move up through the atmosphere computing the derivatives at each
+    ! half-level
+    do jlev = nlev,1,-1
+      ! Compute effect of overlap at half-level jlev+1, yielding
+      ! derivatives just above that half-level
+      lw_derivatives_g_reg = singlemat_x_vec(ng,ng,nreg,u_matrix(:,:,jlev+1),lw_derivatives_g_reg)
+
+      ! Compute effect of transmittance of layer jlev, yielding
+      ! derivatives just below the half-level above (jlev)
+      lw_derivatives_g_reg = mat_x_vec(ng,ng,nreg,transmittance(:,:,:,jlev),lw_derivatives_g_reg)
+
+      lw_derivatives(icol, jlev) = sum(lw_derivatives_g_reg)
+    end do
+
+    if (lhook) call dr_hook('radiation_lw_derivatives:calc_lw_derivatives_matrix',1,hook_handle)
+
+  end subroutine calc_lw_derivatives_matrix
+
+
+  !---------------------------------------------------------------------
+  ! Calculation for solvers involving multiple regions but no 3D
+  ! effects: the difference from calc_lw_derivatives_matrix is that transmittance
+  ! has one less dimensions
+  subroutine calc_lw_derivatives_region(ng, nlev, nreg, icol, transmittance, &
+       &                                u_matrix, flux_up_surf, lw_derivatives)
+
+    use parkind1, only           : jprb
+    use yomhook,  only           : lhook, dr_hook
+
+    use radiation_matrix
+
+    implicit none
+
+    ! Inputs
+    integer,    intent(in) :: ng   ! number of spectral intervals
+    integer,    intent(in) :: nlev ! number of levels
+    integer,    intent(in) :: nreg ! number of regions
+    integer,    intent(in) :: icol ! Index of column for output
+    real(jprb), intent(in) :: transmittance(ng,nreg,nlev)
+    real(jprb), intent(in) :: u_matrix(nreg,nreg,nlev+1) ! Upward overlap matrix
+    real(jprb), intent(in) :: flux_up_surf(ng) ! Upwelling surface spectral flux (W m-2)
+    
+    ! Output
+    real(jprb), intent(out) :: lw_derivatives(:,:) ! dimensioned (ncol,nlev+1)
+
+    ! Rate of change of spectral flux at a given height with respect
+    ! to the surface value
+    real(jprb) :: lw_derivatives_g_reg(ng,nreg)
+
+    integer    :: jlev
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_lw_derivatives:calc_lw_derivatives_region',0,hook_handle)
+
+    ! Initialize the derivatives at the surface; the surface is
+    ! treated as a single clear-sky layer so we only need to put
+    ! values in region 1.
+    lw_derivatives_g_reg = 0.0_jprb
+    lw_derivatives_g_reg(:,1) = flux_up_surf / sum(flux_up_surf)
+    lw_derivatives(icol, nlev+1) = 1.0_jprb
+
+    ! Move up through the atmosphere computing the derivatives at each
+    ! half-level
+    do jlev = nlev,1,-1
+      ! Compute effect of overlap at half-level jlev+1, yielding
+      ! derivatives just above that half-level
+      lw_derivatives_g_reg = singlemat_x_vec(ng,ng,nreg,u_matrix(:,:,jlev+1),lw_derivatives_g_reg)
+
+      ! Compute effect of transmittance of layer jlev, yielding
+      ! derivatives just below the half-level above (jlev)
+      lw_derivatives_g_reg = transmittance(:,:,jlev) * lw_derivatives_g_reg
+
+      lw_derivatives(icol, jlev) = sum(lw_derivatives_g_reg)
+    end do
+
+    if (lhook) call dr_hook('radiation_lw_derivatives:calc_lw_derivatives_region',1,hook_handle)
+
+  end subroutine calc_lw_derivatives_region
+
+
+end module radiation_lw_derivatives
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_matrix.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_matrix.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_matrix.F90	(revision 3908)
@@ -0,0 +1,1002 @@
+! radiation_matrix.F90 - SPARTACUS matrix operations
+!
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2018-10-15  R. Hogan  Added fast_expm_exchange_[23]
+!
+! This module provides the neccessary mathematical functions for the
+! SPARTACUS radiation scheme: matrix multiplication, matrix solvers
+! and matrix exponentiation, but (a) multiple matrices are operated on
+! at once with array access indended to facilitate vectorization, and
+! (b) optimization for 2x2 and 3x3 matrices.  There is probably
+! considerable scope for further optimization. Note that this module
+! is not used by the McICA solver.
+
+module radiation_matrix
+
+  use parkind1, only : jprb
+
+  implicit none
+  public
+
+  ! Codes to describe sparseness pattern, where the SHORTWAVE
+  ! pattern is of the form:
+  ! (x x x)
+  ! (x x x)
+  ! (0 0 x)
+  ! where each element may itself be a square matrix.  
+  integer, parameter :: IMatrixPatternDense     = 0
+  integer, parameter :: IMatrixPatternShortwave = 1
+
+  public  :: mat_x_vec, singlemat_x_vec, mat_x_mat, &
+       &     singlemat_x_mat, mat_x_singlemat, &
+       &     identity_minus_mat_x_mat, solve_vec, solve_mat, expm, &
+       &     fast_expm_exchange_2, fast_expm_exchange_3
+
+  private :: solve_vec_2, solve_vec_3, solve_mat_2, &
+       &     solve_mat_3, lu_factorization, lu_substitution, solve_mat_n, &
+       &     diag_mat_right_divide_3
+
+  interface fast_expm_exchange
+    module procedure fast_expm_exchange_2, fast_expm_exchange_3
+  end interface fast_expm_exchange
+
+contains
+
+  ! --- MATRIX-VECTOR MULTIPLICATION ---
+
+  !---------------------------------------------------------------------
+  ! Treat A as n m-by-m square matrices (with the n dimension varying
+  ! fastest) and b as n m-element vectors, and perform matrix-vector
+  ! multiplications on first iend pairs
+  function mat_x_vec(n,iend,m,A,b,do_top_left_only_in)
+
+    use yomhook, only : lhook, dr_hook
+
+    integer,    intent(in)                   :: n, m, iend
+    real(jprb), intent(in), dimension(:,:,:) :: A
+    real(jprb), intent(in), dimension(:,:)   :: b
+    logical,    intent(in), optional         :: do_top_left_only_in
+    real(jprb),             dimension(iend,m):: mat_x_vec
+
+    integer :: j1, j2
+    logical :: do_top_left_only
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_matrix:mat_x_vec',0,hook_handle)
+
+    if (present(do_top_left_only_in)) then
+      do_top_left_only = do_top_left_only_in
+    else
+      do_top_left_only = .false.
+    end if
+
+    ! Array-wise assignment
+    mat_x_vec = 0.0_jprb
+
+    if (do_top_left_only) then
+      mat_x_vec(1:iend,1) = A(1:iend,1,1)*b(1:iend,1)
+    else
+      do j1 = 1,m
+        do j2 = 1,m
+          mat_x_vec(1:iend,j1) = mat_x_vec(1:iend,j1) &
+               &               + A(1:iend,j1,j2)*b(1:iend,j2)
+        end do
+      end do
+    end if
+
+    if (lhook) call dr_hook('radiation_matrix:mat_x_vec',1,hook_handle)
+
+  end function mat_x_vec
+
+
+  !---------------------------------------------------------------------
+  ! Treat A as an m-by-m square matrix and b as n m-element vectors
+  ! (with the n dimension varying fastest), and perform matrix-vector
+  ! multiplications on first iend pairs
+  function singlemat_x_vec(n,iend,m,A,b)
+
+    use yomhook, only : lhook, dr_hook
+
+    integer,    intent(in)                    :: n, m, iend
+    real(jprb), intent(in), dimension(m,m)    :: A
+    real(jprb), intent(in), dimension(:,:)    :: b
+    real(jprb),             dimension(iend,m) :: singlemat_x_vec
+
+    integer    :: j1, j2
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_matrix:single_mat_x_vec',0,hook_handle)
+
+    ! Array-wise assignment
+    singlemat_x_vec = 0.0_jprb
+
+    do j1 = 1,m
+      do j2 = 1,m
+        singlemat_x_vec(1:iend,j1) = singlemat_x_vec(1:iend,j1) &
+             &                    + A(j1,j2)*b(1:iend,j2)
+      end do
+    end do
+
+    if (lhook) call dr_hook('radiation_matrix:single_mat_x_vec',1,hook_handle)
+
+  end function singlemat_x_vec
+
+
+  ! --- SQUARE MATRIX-MATRIX MULTIPLICATION ---
+
+  !---------------------------------------------------------------------
+  ! Treat A and B each as n m-by-m square matrices (with the n
+  ! dimension varying fastest) and perform matrix multiplications on
+  ! all n matrix pairs
+  function mat_x_mat(n,iend,m,A,B,i_matrix_pattern)
+
+    use yomhook, only : lhook, dr_hook
+
+    integer,    intent(in)                      :: n, m, iend
+    integer,    intent(in), optional            :: i_matrix_pattern
+    real(jprb), intent(in), dimension(:,:,:)    :: A, B
+
+    real(jprb),             dimension(iend,m,m) :: mat_x_mat
+    integer    :: j1, j2, j3
+    integer    :: mblock, m2block
+    integer    :: i_actual_matrix_pattern
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_matrix:mat_x_mat',0,hook_handle)
+
+    if (present(i_matrix_pattern)) then
+      i_actual_matrix_pattern = i_matrix_pattern
+    else
+      i_actual_matrix_pattern = IMatrixPatternDense
+    end if
+
+    ! Array-wise assignment
+    mat_x_mat = 0.0_jprb
+
+    if (i_actual_matrix_pattern == IMatrixPatternShortwave) then
+      ! Matrix has a sparsity pattern
+      !     (C D E)
+      ! A = (F G H)
+      !     (0 0 I)
+      mblock = m/3
+      m2block = 2*mblock 
+      ! Do the top-left (C, D, F, G)
+      do j2 = 1,m2block
+        do j1 = 1,m2block
+          do j3 = 1,m2block
+            mat_x_mat(1:iend,j1,j2) = mat_x_mat(1:iend,j1,j2) &
+                 &                  + A(1:iend,j1,j3)*B(1:iend,j3,j2)
+          end do
+        end do
+      end do
+      do j2 = m2block+1,m
+        ! Do the top-right (E & H)
+        do j1 = 1,m2block
+          do j3 = 1,m
+            mat_x_mat(1:iend,j1,j2) = mat_x_mat(1:iend,j1,j2) &
+                 &                  + A(1:iend,j1,j3)*B(1:iend,j3,j2)
+          end do
+        end do
+        ! Do the bottom-right (I)
+        do j1 = m2block+1,m
+          do j3 = m2block+1,m
+            mat_x_mat(1:iend,j1,j2) = mat_x_mat(1:iend,j1,j2) &
+                 &                  + A(1:iend,j1,j3)*B(1:iend,j3,j2)
+          end do
+        end do
+      end do
+    else
+      ! Ordinary dense matrix
+      do j2 = 1,m
+        do j1 = 1,m
+          do j3 = 1,m
+            mat_x_mat(1:iend,j1,j2) = mat_x_mat(1:iend,j1,j2) &
+                 &                  + A(1:iend,j1,j3)*B(1:iend,j3,j2)
+          end do
+        end do
+      end do
+    end if
+
+    if (lhook) call dr_hook('radiation_matrix:mat_x_mat',1,hook_handle)
+
+  end function mat_x_mat
+
+
+  !---------------------------------------------------------------------
+  ! Treat A as an m-by-m matrix and B as n m-by-m square matrices
+  ! (with the n dimension varying fastest) and perform matrix
+  ! multiplications on the first iend matrix pairs
+  function singlemat_x_mat(n,iend,m,A,B)
+
+    use yomhook, only : lhook, dr_hook
+
+    integer,    intent(in)                      :: n, m, iend
+    real(jprb), intent(in), dimension(m,m)      :: A
+    real(jprb), intent(in), dimension(:,:,:)    :: B
+    real(jprb),             dimension(iend,m,m) :: singlemat_x_mat
+
+    integer    :: j1, j2, j3
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_matrix:singlemat_x_mat',0,hook_handle)
+
+    ! Array-wise assignment
+    singlemat_x_mat = 0.0_jprb
+
+    do j2 = 1,m
+      do j1 = 1,m
+        do j3 = 1,m
+          singlemat_x_mat(1:iend,j1,j2) = singlemat_x_mat(1:iend,j1,j2) &
+               &                        + A(j1,j3)*B(1:iend,j3,j2)
+        end do
+      end do
+    end do
+
+    if (lhook) call dr_hook('radiation_matrix:singlemat_x_mat',1,hook_handle)
+
+  end function singlemat_x_mat
+
+
+  !---------------------------------------------------------------------
+  ! Treat B as an m-by-m matrix and A as n m-by-m square matrices
+  ! (with the n dimension varying fastest) and perform matrix
+  ! multiplications on the first iend matrix pairs
+  function mat_x_singlemat(n,iend,m,A,B)
+
+    use yomhook, only : lhook, dr_hook
+
+    integer,    intent(in)                      :: n, m, iend
+    real(jprb), intent(in), dimension(:,:,:)    :: A
+    real(jprb), intent(in), dimension(m,m)      :: B
+
+    real(jprb),             dimension(iend,m,m) :: mat_x_singlemat
+    integer    :: j1, j2, j3
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_matrix:mat_x_singlemat',0,hook_handle)
+
+    ! Array-wise assignment
+    mat_x_singlemat = 0.0_jprb
+
+    do j2 = 1,m
+      do j1 = 1,m
+        do j3 = 1,m
+          mat_x_singlemat(1:iend,j1,j2) = mat_x_singlemat(1:iend,j1,j2) &
+               &                        + A(1:iend,j1,j3)*B(j3,j2)
+        end do
+      end do
+    end do
+
+    if (lhook) call dr_hook('radiation_matrix:mat_x_singlemat',1,hook_handle)
+
+  end function mat_x_singlemat
+
+
+  !---------------------------------------------------------------------
+  ! Compute I-A*B where I is the identity matrix and A & B are n
+  ! m-by-m square matrices
+  function identity_minus_mat_x_mat(n,iend,m,A,B,i_matrix_pattern)
+
+    use yomhook, only : lhook, dr_hook
+
+    integer,    intent(in)                   :: n, m, iend
+    integer,    intent(in), optional         :: i_matrix_pattern
+    real(jprb), intent(in), dimension(:,:,:) :: A, B
+    real(jprb),             dimension(iend,m,m) :: identity_minus_mat_x_mat
+
+    integer    :: j
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_matrix:identity_mat_x_mat',0,hook_handle)
+
+    if (present(i_matrix_pattern)) then
+      identity_minus_mat_x_mat = mat_x_mat(n,iend,m,A,B,i_matrix_pattern)
+    else
+      identity_minus_mat_x_mat = mat_x_mat(n,iend,m,A,B)
+    end if
+
+    identity_minus_mat_x_mat = - identity_minus_mat_x_mat
+    do j = 1,m
+      identity_minus_mat_x_mat(1:iend,j,j) &
+           &     = 1.0_jprb + identity_minus_mat_x_mat(1:iend,j,j)
+    end do
+
+    if (lhook) call dr_hook('radiation_matrix:identity_mat_x_mat',1,hook_handle)
+
+  end function identity_minus_mat_x_mat
+
+
+  ! --- REPEATEDLY SQUARE A MATRIX ---
+
+  !---------------------------------------------------------------------
+  ! Square m-by-m matrix "A" nrepeat times. A will be corrupted by
+  ! this function.
+  function repeated_square(m,A,nrepeat,i_matrix_pattern)
+    integer,    intent(in)           :: m, nrepeat
+    real(jprb), intent(inout)        :: A(m,m)
+    integer,    intent(in), optional :: i_matrix_pattern
+    real(jprb)                       :: repeated_square(m,m)
+
+    integer :: j1, j2, j3, j4
+    integer :: mblock, m2block
+    integer :: i_actual_matrix_pattern
+
+    if (present(i_matrix_pattern)) then
+      i_actual_matrix_pattern = i_matrix_pattern
+    else
+      i_actual_matrix_pattern = IMatrixPatternDense
+    end if
+
+    if (i_actual_matrix_pattern == IMatrixPatternShortwave) then
+      ! Matrix has a sparsity pattern
+      !     (C D E)
+      ! A = (F G H)
+      !     (0 0 I)
+      mblock = m/3
+      m2block = 2*mblock
+      do j4 = 1,nrepeat
+        repeated_square = 0.0_jprb
+        ! Do the top-left (C, D, F & G)
+        do j2 = 1,m2block
+          do j1 = 1,m2block
+            do j3 = 1,m2block
+              repeated_square(j1,j2) = repeated_square(j1,j2) &
+                   &                 + A(j1,j3)*A(j3,j2)
+            end do
+          end do
+        end do
+        do j2 = m2block+1, m
+          ! Do the top-right (E & H)
+          do j1 = 1,m2block
+            do j3 = 1,m
+              repeated_square(j1,j2) = repeated_square(j1,j2) &
+                   &                 + A(j1,j3)*A(j3,j2)
+            end do
+          end do
+          ! Do the bottom-right (I)
+          do j1 = m2block+1, m
+            do j3 = m2block+1,m
+              repeated_square(j1,j2) = repeated_square(j1,j2) &
+                   &                 + A(j1,j3)*A(j3,j2)
+            end do
+          end do
+        end do
+        if (j4 < nrepeat) then
+          A = repeated_square
+        end if
+      end do
+    else
+      ! Ordinary dense matrix
+      do j4 = 1,nrepeat
+        repeated_square = 0.0_jprb
+        do j2 = 1,m
+          do j1 = 1,m
+            do j3 = 1,m
+              repeated_square(j1,j2) = repeated_square(j1,j2) &
+                   &                 + A(j1,j3)*A(j3,j2)
+            end do
+          end do
+        end do
+        if (j4 < nrepeat) then
+          A = repeated_square
+        end if
+      end do
+    end if
+
+  end function repeated_square
+
+
+  ! --- SOLVE LINEAR EQUATIONS ---
+
+  !---------------------------------------------------------------------
+  ! Solve Ax=b to obtain x.  Version optimized for 2x2 matrices using
+  ! Cramer's method: "A" contains n 2x2 matrices and "b" contains n
+  ! 2-element vectors; returns A^-1 b.
+  pure subroutine solve_vec_2(n,iend,A,b,x)
+
+    integer,    intent(in)  :: n, iend
+    real(jprb), intent(in)  :: A(:,:,:)
+    real(jprb), intent(in)  :: b(:,:)
+    real(jprb), intent(out) :: x(:,:)
+
+    real(jprb) :: inv_det(iend)
+
+    inv_det = 1.0_jprb / (  A(1:iend,1,1)*A(1:iend,2,2) &
+         &                - A(1:iend,1,2)*A(1:iend,2,1))
+
+    x(1:iend,1) = inv_det*(A(1:iend,2,2)*b(1:iend,1)-A(1:iend,1,2)*b(1:iend,2))
+    x(1:iend,2) = inv_det*(A(1:iend,1,1)*b(1:iend,2)-A(1:iend,2,1)*b(1:iend,1))
+
+  end subroutine solve_vec_2
+
+
+  !---------------------------------------------------------------------
+  ! Solve AX=B to obtain X, i.e. the matrix right-hand-side version of
+  ! solve_vec_2, with A, X and B all containing n 2x2 matrices;
+  ! returns A^-1 B using Cramer's method.
+  pure subroutine solve_mat_2(n,iend,A,B,X)
+    integer,    intent(in)  :: n, iend
+    real(jprb), intent(in)  :: A(:,:,:)
+    real(jprb), intent(in)  :: B(:,:,:)
+    real(jprb), intent(out) :: X(:,:,:)
+
+    real(jprb) :: inv_det(iend)
+
+    inv_det = 1.0_jprb / (  A(1:iend,1,1)*A(1:iend,2,2) &
+         &                - A(1:iend,1,2)*A(1:iend,2,1))
+
+    X(1:iend,1,1) = inv_det*( A(1:iend,2,2)*B(1:iend,1,1) &
+         &                   -A(1:iend,1,2)*B(1:iend,2,1))
+    X(1:iend,2,1) = inv_det*( A(1:iend,1,1)*B(1:iend,2,1) &
+         &                   -A(1:iend,2,1)*B(1:iend,1,1))
+    X(1:iend,1,2) = inv_det*( A(1:iend,2,2)*B(1:iend,1,2) &
+         &                   -A(1:iend,1,2)*B(1:iend,2,2))
+    X(1:iend,2,2) = inv_det*( A(1:iend,1,1)*B(1:iend,2,2) &
+         &                   -A(1:iend,2,1)*B(1:iend,1,2))
+
+  end subroutine solve_mat_2
+
+
+  !---------------------------------------------------------------------
+  ! Solve Ax=b optimized for 3x3 matrices, using LU
+  ! factorization and substitution without pivoting.
+  pure subroutine solve_vec_3(n,iend,A,b,x)
+    integer,    intent(in)  :: n, iend
+    real(jprb), intent(in)  :: A(:,:,:)
+    real(jprb), intent(in)  :: b(:,:)
+    real(jprb), intent(out) :: x(:,:)
+
+    real(jprb), dimension(iend) :: L21, L31, L32
+    real(jprb), dimension(iend) :: U22, U23, U33
+    real(jprb), dimension(iend) :: y2, y3
+
+    ! Some compilers unfortunately don't support assocate
+    !    associate (U11 => A(:,1,1), U12 => A(:,1,2), U13 => A(1,3), &
+    !         y1 => b(:,1), x1 => solve_vec3(:,1), &
+    !         x2 => solve_vec3(:,2), x3 => solve_vec3(:,3))
+
+    ! LU decomposition:
+    !     ( 1        )   (U11 U12 U13)
+    ! A = (L21  1    ) * (    U22 U23)
+    !     (L31 L32  1)   (        U33)
+    L21 = A(1:iend,2,1) / A(1:iend,1,1)
+    L31 = A(1:iend,3,1) / A(1:iend,1,1)
+    U22 = A(1:iend,2,2) - L21*A(1:iend,1,2)
+    U23 = A(1:iend,2,3) - L21*A(1:iend,1,3)
+    L32 =(A(1:iend,3,2) - L31*A(1:iend,1,2)) / U22
+    U33 = A(1:iend,3,3) - L31*A(1:iend,1,3) - L32*U23
+
+    ! Solve Ly = b by forward substitution
+    y2 = b(1:iend,2) - L21*b(1:iend,1)
+    y3 = b(1:iend,3) - L31*b(1:iend,1) - L32*y2
+
+    ! Solve Ux = y by back substitution
+    x(1:iend,3) = y3/U33
+    x(1:iend,2) = (y2 - U23*x(1:iend,3)) / U22
+    x(1:iend,1) = (b(1:iend,1) - A(1:iend,1,2)*x(1:iend,2) &
+         &         - A(1:iend,1,3)*x(1:iend,3)) / A(1:iend,1,1)
+    !    end associate
+
+  end subroutine solve_vec_3
+
+
+  !---------------------------------------------------------------------
+  ! Solve AX=B optimized for 3x3 matrices, using LU factorization and
+  ! substitution with no pivoting.
+  pure subroutine solve_mat_3(n,iend,A,B,X)
+    integer,    intent(in)  :: n, iend
+    real(jprb), intent(in)  :: A(:,:,:)
+    real(jprb), intent(in)  :: B(:,:,:)
+    real(jprb), intent(out) :: X(:,:,:)
+
+    real(jprb), dimension(iend) :: L21, L31, L32
+    real(jprb), dimension(iend) :: U22, U23, U33
+    real(jprb), dimension(iend) :: y2, y3
+
+    integer :: j
+
+    !    associate (U11 => A(:,1,1), U12 => A(:,1,2), U13 => A(1,3))
+    ! LU decomposition:
+    !     ( 1        )   (U11 U12 U13)
+    ! A = (L21  1    ) * (    U22 U23)
+    !     (L31 L32  1)   (        U33)
+    L21 = A(1:iend,2,1) / A(1:iend,1,1)
+    L31 = A(1:iend,3,1) / A(1:iend,1,1)
+    U22 = A(1:iend,2,2) - L21*A(1:iend,1,2)
+    U23 = A(1:iend,2,3) - L21*A(1:iend,1,3)
+    L32 =(A(1:iend,3,2) - L31*A(1:iend,1,2)) / U22
+    U33 = A(1:iend,3,3) - L31*A(1:iend,1,3) - L32*U23
+
+    do j = 1,3
+      ! Solve Ly = B(:,:,j) by forward substitution
+      ! y1 = B(:,1,j)
+      y2 = B(1:iend,2,j) - L21*B(1:iend,1,j)
+      y3 = B(1:iend,3,j) - L31*B(1:iend,1,j) - L32*y2
+      ! Solve UX(:,:,j) = y by back substitution
+      X(1:iend,3,j) = y3 / U33
+      X(1:iend,2,j) = (y2 - U23*X(1:iend,3,j)) / U22
+      X(1:iend,1,j) = (B(1:iend,1,j) - A(1:iend,1,2)*X(1:iend,2,j) &
+           &          - A(1:iend,1,3)*X(1:iend,3,j)) / A(1:iend,1,1)
+    end do
+
+  end subroutine solve_mat_3
+
+
+  !---------------------------------------------------------------------
+  ! Return X = B A^-1 = (A^-T B)^T optimized for 3x3 matrices, where B
+  ! is a diagonal matrix, using LU factorization and substitution with
+  ! no pivoting.
+  pure subroutine diag_mat_right_divide_3(n,iend,A,B,X)
+    integer,    intent(in)  :: n, iend
+    real(jprb), intent(in)  :: A(iend,3,3)
+    real(jprb), intent(in)  :: B(iend,3)
+    real(jprb), intent(out) :: X(n,3,3)
+
+    real(jprb), dimension(iend) :: L21, L31, L32
+    real(jprb), dimension(iend) :: U22, U23, U33
+    real(jprb), dimension(iend) :: y2, y3
+
+    integer :: j
+
+    !    associate (U11 => A(:,1,1), U12 => A(:,1,2), U13 => A(1,3))
+    ! LU decomposition of the *transpose* of A:
+    !       ( 1        )   (U11 U12 U13)
+    ! A^T = (L21  1    ) * (    U22 U23)
+    !       (L31 L32  1)   (        U33)
+    L21 = A(1:iend,1,2) / A(1:iend,1,1)
+    L31 = A(1:iend,1,3) / A(1:iend,1,1)
+    U22 = A(1:iend,2,2) - L21*A(1:iend,2,1)
+    U23 = A(1:iend,3,2) - L21*A(1:iend,3,1)
+    L32 =(A(1:iend,2,3) - L31*A(1:iend,2,1)) / U22
+    U33 = A(1:iend,3,3) - L31*A(1:iend,3,1) - L32*U23
+
+    ! Solve X(1,:) = A^-T ( B(1) )
+    !                     (  0   )
+    !                     (  0   )
+    ! Solve Ly = B(:,:,j) by forward substitution
+    ! y1 = B(:,1)
+    y2 = - L21*B(1:iend,1)
+    y3 = - L31*B(1:iend,1) - L32*y2
+    ! Solve UX(:,:,j) = y by back substitution
+    X(1:iend,1,3) = y3 / U33
+    X(1:iend,1,2) = (y2 - U23*X(1:iend,1,3)) / U22
+    X(1:iend,1,1) = (B(1:iend,1) - A(1:iend,2,1)*X(1:iend,1,2) &
+         &          - A(1:iend,3,1)*X(1:iend,1,3)) / A(1:iend,1,1)
+
+    ! Solve X(2,:) = A^-T (  0   )
+    !                     ( B(2) )
+    !                     (  0   )
+    ! Solve Ly = B(:,:,j) by forward substitution
+    ! y1 = 0
+    ! y2 = B(1:iend,2)
+    y3 = - L32*B(1:iend,2)
+    ! Solve UX(:,:,j) = y by back substitution
+    X(1:iend,2,3) = y3 / U33
+    X(1:iend,2,2) = (B(1:iend,2) - U23*X(1:iend,2,3)) / U22
+    X(1:iend,2,1) = (-A(1:iend,2,1)*X(1:iend,2,2) &
+         &           -A(1:iend,3,1)*X(1:iend,2,3)) / A(1:iend,1,1)
+
+    ! Solve X(3,:) = A^-T (  0   )
+    !                     (  0   )
+    !                     ( B(3) )
+    ! Solve Ly = B(:,:,j) by forward substitution
+    ! y1 = 0
+    ! y2 = 0
+    ! y3 = B(1:iend,3)
+    ! Solve UX(:,:,j) = y by back substitution
+    X(1:iend,3,3) = B(1:iend,3) / U33
+    X(1:iend,3,2) = -U23*X(1:iend,3,3) / U22
+    X(1:iend,3,1) = (-A(1:iend,2,1)*X(1:iend,3,2) &
+         &          - A(1:iend,3,1)*X(1:iend,3,3)) / A(1:iend,1,1)
+
+  end subroutine diag_mat_right_divide_3
+
+
+  !---------------------------------------------------------------------
+  ! Treat A as n m-by-m matrices and return the LU factorization of A
+  ! compressed into a single matrice (with L below the diagonal and U
+  ! on and above the diagonal; the diagonal elements of L are 1). No
+  ! pivoting is performed.
+  pure subroutine lu_factorization(n, iend, m, A, LU)
+    integer,    intent(in)  :: n, m, iend
+    real(jprb), intent(in)  :: A(:,:,:)
+    real(jprb), intent(out) :: LU(iend,m,m)
+
+    real(jprb) :: s(iend)
+    integer    :: j1, j2, j3
+
+    ! This routine is adapted from an in-place one, so we first copy
+    ! the input into the output.
+    LU(1:iend,1:m,1:m) = A(1:iend,1:m,1:m)
+
+    do j2 = 1, m
+      do j1 = 1, j2-1
+        s = LU(1:iend,j1,j2)
+        do j3 = 1, j1-1
+          s = s - LU(1:iend,j1,j3) * LU(1:iend,j3,j2)
+        end do
+        LU(1:iend,j1,j2) = s
+      end do
+      do j1 = j2, m
+        s = LU(1:iend,j1,j2)
+        do j3 = 1, j2-1
+          s = s - LU(1:iend,j1,j3) * LU(1:iend,j3,j2)
+        end do
+        LU(1:iend,j1,j2) = s
+      end do
+      if (j2 /= m) then
+        s = 1.0_jprb / LU(1:iend,j2,j2)
+        do j1 = j2+1, m
+          LU(1:iend,j1,j2) = LU(1:iend,j1,j2) * s
+        end do
+      end if
+    end do
+
+  end subroutine lu_factorization
+
+
+  !---------------------------------------------------------------------
+  ! Treat LU as an LU-factorization of an original matrix A, and
+  ! return x where Ax=b. LU consists of n m-by-m matrices and b as n
+  ! m-element vectors.
+  pure subroutine lu_substitution(n,iend,m,LU,b,x)
+    ! CHECK: dimensions should be ":"?
+    integer,    intent(in) :: n, m, iend
+    real(jprb), intent(in) :: LU(iend,m,m)
+    real(jprb), intent(in) :: b(:,:)
+    real(jprb), intent(out):: x(iend,m)
+
+    integer :: j1, j2
+
+    x(1:iend,1:m) = b(1:iend,1:m)
+
+    ! First solve Ly=b
+    do j2 = 2, m
+      do j1 = 1, j2-1
+        x(1:iend,j2) = x(1:iend,j2) - x(1:iend,j1)*LU(1:iend,j2,j1)
+      end do
+    end do
+    ! Now solve Ux=y
+    do j2 = m, 1, -1
+      do j1 = j2+1, m
+        x(1:iend,j2) = x(1:iend,j2) - x(1:iend,j1)*LU(1:iend,j2,j1)
+      end do
+      x(1:iend,j2) = x(1:iend,j2) / LU(1:iend,j2,j2)
+    end do
+
+  end subroutine lu_substitution
+
+
+  !---------------------------------------------------------------------
+  ! Return matrix X where AX=B. LU, A, X, B all consist of n m-by-m
+  ! matrices.
+  pure subroutine solve_mat_n(n,iend,m,A,B,X)
+    integer,    intent(in) :: n, m, iend
+    real(jprb), intent(in) :: A(:,:,:)
+    real(jprb), intent(in) :: B(:,:,:)
+    real(jprb), intent(out):: X(iend,m,m)
+
+    real(jprb) :: LU(iend,m,m)
+
+    integer :: j
+
+    call lu_factorization(n,iend,m,A,LU)
+
+    do j = 1, m
+      call lu_substitution(n,iend,m,LU,B(1:,1:m,j),X(1:iend,1:m,j))
+!      call lu_substitution(n,iend,m,LU,B(1:n,1:m,j),X(1:iend,1:m,j))
+    end do
+
+  end subroutine solve_mat_n
+
+
+  !---------------------------------------------------------------------
+  ! Solve Ax=b, where A consists of n m-by-m matrices and x and b
+  ! consist of n m-element vectors. For m=2 or m=3, this function
+  ! calls optimized versions, otherwise it uses general LU
+  ! decomposition without pivoting.
+  function solve_vec(n,iend,m,A,b)
+
+    use yomhook, only : lhook, dr_hook
+
+    integer,    intent(in) :: n, m, iend
+    real(jprb), intent(in) :: A(:,:,:)
+    real(jprb), intent(in) :: b(:,:)
+
+    real(jprb)             :: solve_vec(iend,m)
+    real(jprb)             :: LU(iend,m,m)
+    real(jprb)             :: hook_handle
+
+    if (lhook) call dr_hook('radiation_matrix:solve_vec',0,hook_handle)
+
+    if (m == 2) then
+      call solve_vec_2(n,iend,A,b,solve_vec)
+    elseif (m == 3) then
+      call solve_vec_3(n,iend,A,b,solve_vec)
+    else
+      call lu_factorization(n,iend,m,A,LU)
+      call lu_substitution(n,iend,m,LU,b,solve_vec)
+    end if
+
+    if (lhook) call dr_hook('radiation_matrix:solve_vec',1,hook_handle)
+
+  end function solve_vec
+
+
+  !---------------------------------------------------------------------
+  ! Solve AX=B, where A, X and B consist of n m-by-m matrices. For m=2
+  ! or m=3, this function calls optimized versions, otherwise it uses
+  ! general LU decomposition without pivoting.
+  function solve_mat(n,iend,m,A,B)
+
+    use yomhook, only : lhook, dr_hook
+
+    integer,    intent(in)  :: n, m, iend
+    real(jprb), intent(in)  :: A(:,:,:)
+    real(jprb), intent(in)  :: B(:,:,:)
+
+    real(jprb)              :: solve_mat(iend,m,m)
+    real(jprb)              :: hook_handle
+
+    if (lhook) call dr_hook('radiation_matrix:solve_mat',0,hook_handle)
+
+    if (m == 2) then
+      call solve_mat_2(n,iend,A,B,solve_mat)
+    elseif (m == 3) then
+      call solve_mat_3(n,iend,A,B,solve_mat)
+    else
+      call solve_mat_n(n,iend,m,A,B,solve_mat)
+    end if
+
+    if (lhook) call dr_hook('radiation_matrix:solve_mat',1,hook_handle)
+
+  end function solve_mat
+
+
+  ! --- MATRIX EXPONENTIATION ---
+
+  !---------------------------------------------------------------------
+  ! Perform matrix exponential of n m-by-m matrices stored in A (where
+  ! index n varies fastest) using the Higham scaling and squaring
+  ! method. The result is placed in A. This routine is intended for
+  ! speed so is accurate only to single precision.  For simplicity and
+  ! to aid vectorization, the Pade approximant of order 7 is used for
+  ! all input matrices, perhaps leading to a few too many
+  ! multiplications for matrices with a small norm.
+  subroutine expm(n,iend,m,A,i_matrix_pattern)
+
+    use yomhook, only : lhook, dr_hook
+
+    integer,    intent(in)      :: n, m, iend
+    real(jprb), intent(inout)   :: A(n,m,m)
+    integer,    intent(in)      :: i_matrix_pattern
+
+    real(jprb), parameter :: theta(3) = (/4.258730016922831e-01_jprb, &
+         &                                1.880152677804762e+00_jprb, &
+         &                                3.925724783138660e+00_jprb/) 
+    real(jprb), parameter :: c(8) = (/17297280.0_jprb, 8648640.0_jprb, &
+         &                1995840.0_jprb, 277200.0_jprb, 25200.0_jprb, &
+         &                1512.0_jprb, 56.0_jprb, 1.0_jprb/)
+
+    real(jprb), dimension(iend,m,m) :: A2, A4, A6
+    real(jprb), dimension(iend,m,m) :: U, V
+
+    real(jprb) :: normA(iend), sum_column(iend)
+
+    integer    :: j1, j2, j3
+    real(jprb) :: frac(iend)
+    integer    :: expo(iend)
+    real(jprb) :: scaling(iend)
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_matrix:expm',0,hook_handle)
+
+    normA = 0.0_jprb
+
+    ! Compute the 1-norms of A
+    do j3 = 1,m
+      sum_column(:) = 0.0_jprb
+      do j2 = 1,m
+        do j1 = 1,iend
+          sum_column(j1) = sum_column(j1) + abs(A(j1,j2,j3))
+        end do
+      end do
+      do j1 = 1,iend
+        if (sum_column(j1) > normA(j1)) then
+          normA(j1) = sum_column(j1)
+        end if
+      end do
+    end do
+
+    frac = fraction(normA/theta(3))
+    expo = exponent(normA/theta(3))
+    where (frac == 0.5_jprb)
+      expo = expo - 1
+    end where
+
+    where (expo < 0)
+      expo = 0
+    end where
+
+    ! Scale the input matrices by a power of 2
+    scaling = 2.0_jprb**(-expo)
+    do j3 = 1,m
+      do j2 = 1,m
+        A(1:iend,j2,j3) = A(1:iend,j2,j3) * scaling
+      end do
+    end do
+    ! Pade approximant of degree 7
+    A2 = mat_x_mat(n,iend,m,A, A, i_matrix_pattern)
+    A4 = mat_x_mat(n,iend,m,A2,A2,i_matrix_pattern)
+    A6 = mat_x_mat(n,iend,m,A2,A4,i_matrix_pattern)
+
+    V = c(8)*A6 + c(6)*A4 + c(4)*A2
+    do j3 = 1,m
+      V(:,j3,j3) = V(:,j3,j3) + c(2)
+    end do
+    U = mat_x_mat(n,iend,m,A,V,i_matrix_pattern)
+    V = c(7)*A6 + c(5)*A4 + c(3)*A2
+    ! Add a multiple of the identity matrix
+    do j3 = 1,m
+      V(:,j3,j3) = V(:,j3,j3) + c(1)
+    end do
+
+    V = V-U
+    U = 2.0_jprb*U
+    A(1:iend,1:m,1:m) = solve_mat(n,iend,m,V,U)
+
+    ! Add the identity matrix
+    do j3 = 1,m
+      A(1:iend,j3,j3) = A(1:iend,j3,j3) + 1.0_jprb
+    end do
+
+    ! Loop through the matrices
+    do j1 = 1,iend
+      if (expo(j1) > 0) then
+        ! Square matrix j1 expo(j1) times          
+        A(j1,:,:) = repeated_square(m,A(j1,:,:),expo(j1),i_matrix_pattern)
+      end if
+    end do
+
+    if (lhook) call dr_hook('radiation_matrix:expm',1,hook_handle)
+
+  end subroutine expm
+
+
+  !---------------------------------------------------------------------
+  ! Return the matrix exponential of n 2x2 matrices representing
+  ! conservative exchange between SPARTACUS regions, where the
+  ! matrices have the structure
+  !   (-a   b)
+  !   ( a  -b)
+  ! and a and b are assumed to be positive or zero.  The solution uses
+  ! Putzer's algorithm - see the appendix of Hogan et al. (GMD 2018)
+  subroutine fast_expm_exchange_2(n,iend,a,b,R)
+
+    use yomhook, only : lhook, dr_hook
+
+    integer,                      intent(in)  :: n, iend
+    real(jprb), dimension(n),     intent(in)  :: a, b
+    real(jprb), dimension(n,2,2), intent(out) :: R
+
+    real(jprb), dimension(iend) :: factor
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_matrix:fast_expm_exchange_2',0,hook_handle)
+
+    ! Security to ensure that if a==b==0 then the identity matrix is returned
+    factor = (1.0_jprb - exp(-(a(1:iend)+b(1:iend))))/max(1.0e-12_jprb,a(1:iend)+b(1:iend))
+
+    R(1:iend,1,1) = 1.0_jprb - factor*a(1:iend)
+    R(1:iend,2,1) = factor*a(1:iend)
+    R(1:iend,1,2) = factor*b(1:iend)
+    R(1:iend,2,2) = 1.0_jprb - factor*b(1:iend)
+
+    if (lhook) call dr_hook('radiation_matrix:fast_expm_exchange_2',1,hook_handle)
+
+  end subroutine fast_expm_exchange_2
+
+
+  !---------------------------------------------------------------------
+  ! Return the matrix exponential of n 3x3 matrices representing
+  ! conservative exchange between SPARTACUS regions, where the
+  ! matrices have the structure
+  !   (-a   b   0)
+  !   ( a -b-c  d)
+  !   ( 0   c  -d)
+  ! and a-d are assumed to be positive or zero.  The solution uses the
+  ! diagonalization method and is a slight generalization of the
+  ! solution provided in the appendix of Hogan et al. (GMD 2018),
+  ! which assumed c==d.
+  subroutine fast_expm_exchange_3(n,iend,a,b,c,d,R)
+
+    use yomhook, only : lhook, dr_hook
+
+    real(jprb), parameter :: my_epsilon = 1.0e-12_jprb
+
+    integer,                      intent(in)  :: n, iend
+    real(jprb), dimension(n),     intent(in)  :: a, b, c, d
+    real(jprb), dimension(n,3,3), intent(out) :: R
+
+    ! Eigenvectors
+    real(jprb), dimension(iend,3,3) :: V
+
+    ! Non-zero Eigenvalues
+    real(jprb), dimension(iend) :: lambda1, lambda2
+
+    ! Diagonal matrix of the exponential of the eigenvalues
+    real(jprb), dimension(iend,3) :: diag
+
+    ! Result of diag right-divided by V
+    real(jprb), dimension(iend,3,3) :: diag_rdivide_V
+
+    ! Intermediate arrays
+    real(jprb), dimension(iend) :: tmp1, tmp2
+
+    integer :: j1, j2
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_matrix:fast_expm_exchange_3',0,hook_handle)
+
+    ! Eigenvalues
+    tmp1 = 0.5_jprb * (a(1:iend)+b(1:iend)+c(1:iend)+d(1:iend))
+    tmp2 = sqrt(tmp1*tmp1 - (a(1:iend)*c(1:iend) + a(1:iend)*d(1:iend) + b(1:iend)*d(1:iend)))
+    lambda1 = -tmp1 + tmp2
+    lambda2 = -tmp1 - tmp2
+
+    ! Eigenvectors, with securities such taht if a--d are all zero
+    ! then V is non-singular and the identity matrix is returned in R;
+    ! note that lambdaX is typically negative so we need a
+    ! sign-preserving security
+    V(1:iend,1,1) = max(my_epsilon, b(1:iend)) &
+         &  / sign(max(my_epsilon, abs(a(1:iend) + lambda1)), a(1:iend) + lambda1)
+    V(1:iend,1,2) = b(1:iend) &
+         &  / sign(max(my_epsilon, abs(a(1:iend) + lambda2)), a(1:iend) + lambda2)
+    V(1:iend,1,3) = b(1:iend) / max(my_epsilon, a(1:iend))
+    V(1:iend,2,:) = 1.0_jprb
+    V(1:iend,3,1) = c(1:iend) &
+         &  / sign(max(my_epsilon, abs(d(1:iend) + lambda1)), d(1:iend) + lambda1)
+    V(1:iend,3,2) = c(1:iend) &
+         &  / sign(max(my_epsilon, abs(d(1:iend) + lambda2)), d(1:iend) + lambda2)
+    V(1:iend,3,3) = max(my_epsilon, c(1:iend)) / max(my_epsilon, d(1:iend))
+    
+    diag(:,1) = exp(lambda1)
+    diag(:,2) = exp(lambda2)
+    diag(:,3) = 1.0_jprb
+
+    ! Compute diag_rdivide_V = diag * V^-1
+    call diag_mat_right_divide_3(iend,iend,V,diag,diag_rdivide_V)
+
+    ! Compute V * diag_rdivide_V
+    do j1 = 1,3
+      do j2 = 1,3
+        R(1:iend,j2,j1) = V(1:iend,j2,1)*diag_rdivide_V(1:iend,1,j1) &
+             &          + V(1:iend,j2,2)*diag_rdivide_V(1:iend,2,j1) &
+             &          + V(1:iend,j2,3)*diag_rdivide_V(1:iend,3,j1)
+      end do
+    end do
+
+    if (lhook) call dr_hook('radiation_matrix:fast_expm_exchange_3',1,hook_handle)
+
+  end subroutine fast_expm_exchange_3
+
+!  generic :: fast_expm_exchange => fast_expm_exchange_2, fast_expm_exchange_3
+
+
+end module radiation_matrix
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_mcica_lw.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_mcica_lw.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_mcica_lw.F90	(revision 3908)
@@ -0,0 +1,361 @@
+! radiation_mcica_lw.F90 - Monte-Carlo Independent Column Approximation longtwave solver
+!
+! (C) Copyright 2015- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2017-04-11  R. Hogan  Receive emission/albedo rather than planck/emissivity
+!   2017-04-22  R. Hogan  Store surface fluxes at all g-points
+!   2017-07-12  R. Hogan  Call fast adding method if only clouds scatter
+!   2017-10-23  R. Hogan  Renamed single-character variables
+
+module radiation_mcica_lw
+
+  public
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Longwave Monte Carlo Independent Column Approximation
+  ! (McICA). This implementation performs a clear-sky and a cloudy-sky
+  ! calculation, and then weights the two to get the all-sky fluxes
+  ! according to the total cloud cover. This method reduces noise for
+  ! low cloud cover situations, and exploits the clear-sky
+  ! calculations that are usually performed for diagnostic purposes
+  ! simultaneously. The cloud generator has been carefully written
+  ! such that the stochastic cloud field satisfies the prescribed
+  ! overlap parameter accounting for this weighting.
+  subroutine solver_mcica_lw(nlev,istartcol,iendcol, &
+       &  config, single_level, cloud, & 
+       &  od, ssa, g, od_cloud, ssa_cloud, g_cloud, planck_hl, &
+       &  emission, albedo, &
+       &  flux)
+
+    use parkind1, only           : jprb
+    use yomhook,  only           : lhook, dr_hook
+
+    use radiation_io,   only           : nulerr, radiation_abort
+    use radiation_config, only         : config_type
+    use radiation_single_level, only   : single_level_type
+    use radiation_cloud, only          : cloud_type
+    use radiation_flux, only           : flux_type
+    use radiation_two_stream, only     : calc_two_stream_gammas_lw, &
+         &                               calc_reflectance_transmittance_lw, &
+         &                               calc_no_scattering_transmittance_lw
+    use radiation_adding_ica_lw, only  : adding_ica_lw, fast_adding_ica_lw, &
+         &                               calc_fluxes_no_scattering_lw
+    use radiation_lw_derivatives, only : calc_lw_derivatives_ica, modify_lw_derivatives_ica
+    use radiation_cloud_generator, only: cloud_generator
+
+    implicit none
+
+    ! Inputs
+    integer, intent(in) :: nlev               ! number of model levels
+    integer, intent(in) :: istartcol, iendcol ! range of columns to process
+    type(config_type),        intent(in) :: config
+    type(single_level_type),  intent(in) :: single_level
+    type(cloud_type),         intent(in) :: cloud
+
+    ! Gas and aerosol optical depth, single-scattering albedo and
+    ! asymmetry factor at each longwave g-point
+    real(jprb), intent(in), dimension(config%n_g_lw, nlev, istartcol:iendcol) :: &
+         &  od
+    real(jprb), intent(in), dimension(config%n_g_lw_if_scattering, nlev, istartcol:iendcol) :: &
+         &  ssa, g
+
+    ! Cloud and precipitation optical depth, single-scattering albedo and
+    ! asymmetry factor in each longwave band
+    real(jprb), intent(in), dimension(config%n_bands_lw,nlev,istartcol:iendcol)   :: &
+         &  od_cloud
+    real(jprb), intent(in), dimension(config%n_bands_lw_if_scattering, &
+         &  nlev,istartcol:iendcol) :: ssa_cloud, g_cloud
+
+    ! Planck function at each half-level and the surface
+    real(jprb), intent(in), dimension(config%n_g_lw,nlev+1,istartcol:iendcol) :: &
+         &  planck_hl
+
+    ! Emission (Planck*emissivity) and albedo (1-emissivity) at the
+    ! surface at each longwave g-point
+    real(jprb), intent(in), dimension(config%n_g_lw, istartcol:iendcol) :: emission, albedo
+
+    ! Output
+    type(flux_type), intent(inout):: flux
+
+    ! Local variables
+
+    ! Diffuse reflectance and transmittance for each layer in clear
+    ! and all skies
+    real(jprb), dimension(config%n_g_lw, nlev) :: ref_clear, trans_clear, reflectance, transmittance
+
+    ! Emission by a layer into the upwelling or downwelling diffuse
+    ! streams, in clear and all skies
+    real(jprb), dimension(config%n_g_lw, nlev) :: source_up_clear, source_dn_clear, source_up, source_dn
+
+    ! Fluxes per g point
+    real(jprb), dimension(config%n_g_lw, nlev+1) :: flux_up, flux_dn
+    real(jprb), dimension(config%n_g_lw, nlev+1) :: flux_up_clear, flux_dn_clear
+
+    ! Combined gas+aerosol+cloud optical depth, single scattering
+    ! albedo and asymmetry factor
+    real(jprb), dimension(config%n_g_lw) :: od_total, ssa_total, g_total
+
+    ! Combined scattering optical depth
+    real(jprb) :: scat_od, scat_od_total(config%n_g_lw)
+
+    ! Two-stream coefficients
+    real(jprb), dimension(config%n_g_lw) :: gamma1, gamma2
+
+    ! Optical depth scaling from the cloud generator, zero indicating
+    ! clear skies
+    real(jprb), dimension(config%n_g_lw,nlev) :: od_scaling
+
+    ! Modified optical depth after McICA scaling to represent cloud
+    ! inhomogeneity
+    real(jprb), dimension(config%n_g_lw) :: od_cloud_new
+
+    ! Total cloud cover output from the cloud generator
+    real(jprb) :: total_cloud_cover
+
+    ! Identify clear-sky layers
+    logical :: is_clear_sky_layer(nlev)
+
+    ! Index of the highest cloudy layer
+    integer :: i_cloud_top
+
+    ! Number of g points
+    integer :: ng
+
+    ! Loop indices for level, column and g point
+    integer :: jlev, jcol, jg
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_mcica_lw:solver_mcica_lw',0,hook_handle)
+
+    if (.not. config%do_clear) then
+      write(nulerr,'(a)') '*** Error: longwave McICA requires clear-sky calculation to be performed'
+      call radiation_abort()      
+    end if
+
+    ng = config%n_g_lw
+
+    ! Loop through columns
+    do jcol = istartcol,iendcol
+
+      ! Clear-sky calculation
+      if (config%do_lw_aerosol_scattering) then
+        ! Scattering case: first compute clear-sky reflectance,
+        ! transmittance etc at each model level
+        do jlev = 1,nlev
+          ssa_total = ssa(:,jlev,jcol)
+          g_total   = g(:,jlev,jcol)
+          call calc_two_stream_gammas_lw(ng, ssa_total, g_total, &
+               &  gamma1, gamma2)
+          call calc_reflectance_transmittance_lw(ng, &
+               &  od(:,jlev,jcol), gamma1, gamma2, &
+               &  planck_hl(:,jlev,jcol), planck_hl(:,jlev+1,jcol), &
+               &  ref_clear(:,jlev), trans_clear(:,jlev), &
+               &  source_up_clear(:,jlev), source_dn_clear(:,jlev))
+        end do
+        ! Then use adding method to compute fluxes
+        call adding_ica_lw(ng, nlev, &
+             &  ref_clear, trans_clear, source_up_clear, source_dn_clear, &
+             &  emission(:,jcol), albedo(:,jcol), &
+             &  flux_up_clear, flux_dn_clear)
+        
+      else
+        ! Non-scattering case: use simpler functions for
+        ! transmission and emission
+        do jlev = 1,nlev
+          call calc_no_scattering_transmittance_lw(ng, od(:,jlev,jcol), &
+               &  planck_hl(:,jlev,jcol), planck_hl(:,jlev+1, jcol), &
+               &  trans_clear(:,jlev), source_up_clear(:,jlev), source_dn_clear(:,jlev))
+        end do
+        ! Simpler down-then-up method to compute fluxes
+        call calc_fluxes_no_scattering_lw(ng, nlev, &
+             &  trans_clear, source_up_clear, source_dn_clear, &
+             &  emission(:,jcol), albedo(:,jcol), &
+             &  flux_up_clear, flux_dn_clear)
+        
+        ! Ensure that clear-sky reflectance is zero since it may be
+        ! used in cloudy-sky case
+        ref_clear = 0.0_jprb
+      end if
+
+      ! Sum over g-points to compute broadband fluxes
+      flux%lw_up_clear(jcol,:) = sum(flux_up_clear,1)
+      flux%lw_dn_clear(jcol,:) = sum(flux_dn_clear,1)
+      ! Store surface spectral downwelling fluxes
+      flux%lw_dn_surf_clear_g(:,jcol) = flux_dn_clear(:,nlev+1)
+
+      ! Do cloudy-sky calculation; add a prime number to the seed in
+      ! the longwave
+      call cloud_generator(ng, nlev, config%i_overlap_scheme, &
+           &  single_level%iseed(jcol) + 997, &
+           &  config%cloud_fraction_threshold, &
+           &  cloud%fraction(jcol,:), cloud%overlap_param(jcol,:), &
+           &  config%cloud_inhom_decorr_scaling, cloud%fractional_std(jcol,:), &
+           &  config%pdf_sampler, od_scaling, total_cloud_cover, &
+           &  is_beta_overlap=config%use_beta_overlap)
+      
+      ! Store total cloud cover
+      flux%cloud_cover_lw(jcol) = total_cloud_cover
+      
+      if (total_cloud_cover >= config%cloud_fraction_threshold) then
+        ! Total-sky calculation
+
+        is_clear_sky_layer = .true.
+        i_cloud_top = nlev+1
+        do jlev = 1,nlev
+          ! Compute combined gas+aerosol+cloud optical properties
+          if (cloud%fraction(jcol,jlev) >= config%cloud_fraction_threshold) then
+            is_clear_sky_layer(jlev) = .false.
+            ! Get index to the first cloudy layer from the top
+            if (i_cloud_top > jlev) then
+              i_cloud_top = jlev
+            end if
+
+            od_cloud_new = od_scaling(:,jlev) &
+                 &  * od_cloud(config%i_band_from_reordered_g_lw,jlev,jcol)
+            od_total = od(:,jlev,jcol) + od_cloud_new
+            ssa_total = 0.0_jprb
+            g_total   = 0.0_jprb
+
+            if (config%do_lw_cloud_scattering) then
+              ! Scattering case: calculate reflectance and
+              ! transmittance at each model level
+
+              if (config%do_lw_aerosol_scattering) then
+                ! In single precision we need to protect against the
+                ! case that od_total > 0.0 and ssa_total > 0.0 but
+                ! od_total*ssa_total == 0 due to underflow
+                scat_od_total = ssa(:,jlev,jcol)*od(:,jlev,jcol) &
+                     &     + ssa_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
+                     &     *  od_cloud_new
+                where (scat_od_total > 0.0_jprb)
+                  g_total = (g(:,jlev,jcol)*ssa(:,jlev,jcol)*od(:,jlev,jcol) &
+                       &     +   g_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
+                       &     * ssa_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
+                       &     *  od_cloud_new) &
+                       &     / scat_od_total
+                end where                
+                where (od_total > 0.0_jprb)
+                  ssa_total = scat_od_total / od_total
+                end where
+              else
+                do jg = 1,ng
+                  if (od_total(jg) > 0.0_jprb) then
+                    scat_od = ssa_cloud(config%i_band_from_reordered_g_lw(jg),jlev,jcol) &
+                         &     * od_cloud_new(jg)
+                    ssa_total(jg) = scat_od / od_total(jg)
+                    if (scat_od > 0.0_jprb) then
+                      g_total(jg) = g_cloud(config%i_band_from_reordered_g_lw(jg),jlev,jcol) &
+                           &     * ssa_cloud(config%i_band_from_reordered_g_lw(jg),jlev,jcol) &
+                           &     *  od_cloud_new(jg) / scat_od
+                    end if
+                  end if
+                end do
+              end if
+            
+              ! Compute cloudy-sky reflectance, transmittance etc at
+              ! each model level
+              call calc_two_stream_gammas_lw(ng, ssa_total, g_total, &
+                   &  gamma1, gamma2)
+              call calc_reflectance_transmittance_lw(ng, &
+                   &  od_total, gamma1, gamma2, &
+                   &  planck_hl(:,jlev,jcol), planck_hl(:,jlev+1,jcol), &
+                   &  reflectance(:,jlev), transmittance(:,jlev), source_up(:,jlev), source_dn(:,jlev))
+            else
+              ! No-scattering case: use simpler functions for
+              ! transmission and emission
+              call calc_no_scattering_transmittance_lw(ng, od_total, &
+                   &  planck_hl(:,jlev,jcol), planck_hl(:,jlev+1, jcol), &
+                   &  transmittance(:,jlev), source_up(:,jlev), source_dn(:,jlev))
+            end if
+
+          else
+            ! Clear-sky layer: copy over clear-sky values
+            reflectance(:,jlev) = ref_clear(:,jlev)
+            transmittance(:,jlev) = trans_clear(:,jlev)
+            source_up(:,jlev) = source_up_clear(:,jlev)
+            source_dn(:,jlev) = source_dn_clear(:,jlev)
+          end if
+        end do
+        
+        if (config%do_lw_aerosol_scattering) then
+          ! Use adding method to compute fluxes for an overcast sky,
+          ! allowing for scattering in all layers
+          call adding_ica_lw(ng, nlev, reflectance, transmittance, source_up, source_dn, &
+               &  emission(:,jcol), albedo(:,jcol), &
+               &  flux_up, flux_dn)
+        else if (config%do_lw_cloud_scattering) then
+          ! Use adding method to compute fluxes but optimize for the
+          ! presence of clear-sky layers
+!          call adding_ica_lw(ng, nlev, reflectance, transmittance, source_up, source_dn, &
+!               &  emission(:,jcol), albedo(:,jcol), &
+!               &  flux_up, flux_dn)
+          call fast_adding_ica_lw(ng, nlev, reflectance, transmittance, source_up, source_dn, &
+               &  emission(:,jcol), albedo(:,jcol), &
+               &  is_clear_sky_layer, i_cloud_top, flux_dn_clear, &
+               &  flux_up, flux_dn)
+        else
+          ! Simpler down-then-up method to compute fluxes
+          call calc_fluxes_no_scattering_lw(ng, nlev, &
+               &  transmittance, source_up, source_dn, emission(:,jcol), albedo(:,jcol), &
+               &  flux_up, flux_dn)
+        end if
+        
+        ! Store overcast broadband fluxes
+        flux%lw_up(jcol,:) = sum(flux_up,1)
+        flux%lw_dn(jcol,:) = sum(flux_dn,1)
+
+        ! Cloudy flux profiles currently assume completely overcast
+        ! skies; perform weighted average with clear-sky profile
+        flux%lw_up(jcol,:) =  total_cloud_cover *flux%lw_up(jcol,:) &
+             &  + (1.0_jprb - total_cloud_cover)*flux%lw_up_clear(jcol,:)
+        flux%lw_dn(jcol,:) =  total_cloud_cover *flux%lw_dn(jcol,:) &
+             &  + (1.0_jprb - total_cloud_cover)*flux%lw_dn_clear(jcol,:)
+        ! Store surface spectral downwelling fluxes
+        flux%lw_dn_surf_g(:,jcol) = total_cloud_cover*flux_dn(:,nlev+1) &
+             &  + (1.0_jprb - total_cloud_cover)*flux%lw_dn_surf_clear_g(:,jcol)
+
+        ! Compute the longwave derivatives needed by Hogan and Bozzo
+        ! (2015) approximate radiation update scheme
+        if (config%do_lw_derivatives) then
+          call calc_lw_derivatives_ica(ng, nlev, jcol, transmittance, flux_up(:,nlev+1), &
+               &                       flux%lw_derivatives)
+          if (total_cloud_cover < 1.0_jprb - config%cloud_fraction_threshold) then
+            ! Modify the existing derivative with the contribution from the clear sky
+            call modify_lw_derivatives_ica(ng, nlev, jcol, trans_clear, flux_up_clear(:,nlev+1), &
+                 &                         1.0_jprb-total_cloud_cover, flux%lw_derivatives)
+          end if
+        end if
+
+      else
+        ! No cloud in profile and clear-sky fluxes already
+        ! calculated: copy them over
+        flux%lw_up(jcol,:) = flux%lw_up_clear(jcol,:)
+        flux%lw_dn(jcol,:) = flux%lw_dn_clear(jcol,:)
+        flux%lw_dn_surf_g(:,jcol) = flux%lw_dn_surf_clear_g(:,jcol)
+        if (config%do_lw_derivatives) then
+          call calc_lw_derivatives_ica(ng, nlev, jcol, trans_clear, flux_up_clear(:,nlev+1), &
+               &                       flux%lw_derivatives)
+ 
+        end if
+      end if ! Cloud is present in profile
+    end do
+
+    if (lhook) call dr_hook('radiation_mcica_lw:solver_mcica_lw',1,hook_handle)
+    
+  end subroutine solver_mcica_lw
+
+end module radiation_mcica_lw
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_mcica_sw.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_mcica_sw.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_mcica_sw.F90	(revision 3908)
@@ -0,0 +1,348 @@
+! radiation_mcica_sw.F90 - Monte-Carlo Independent Column Approximation shortwave solver
+!
+! (C) Copyright 2015- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2017-04-11  R. Hogan  Receive albedos at g-points
+!   2017-04-22  R. Hogan  Store surface fluxes at all g-points
+!   2017-10-23  R. Hogan  Renamed single-character variables
+
+module radiation_mcica_sw
+
+  public
+
+contains
+
+  ! Provides elemental function "delta_eddington"
+#include "radiation_delta_eddington.h"
+
+  !---------------------------------------------------------------------
+  ! Shortwave Monte Carlo Independent Column Approximation
+  ! (McICA). This implementation performs a clear-sky and a cloudy-sky
+  ! calculation, and then weights the two to get the all-sky fluxes
+  ! according to the total cloud cover. This method reduces noise for
+  ! low cloud cover situations, and exploits the clear-sky
+  ! calculations that are usually performed for diagnostic purposes
+  ! simultaneously. The cloud generator has been carefully written
+  ! such that the stochastic cloud field satisfies the prescribed
+  ! overlap parameter accounting for this weighting.
+  subroutine solver_mcica_sw(nlev,istartcol,iendcol, &
+       &  config, single_level, cloud, & 
+       &  od, ssa, g, od_cloud, ssa_cloud, g_cloud, &
+       &  albedo_direct, albedo_diffuse, incoming_sw, &
+       &  flux)
+
+    use parkind1, only           : jprb
+    use yomhook,  only           : lhook, dr_hook
+
+    use radiation_io,   only           : nulerr, radiation_abort
+    use radiation_config, only         : config_type
+    use radiation_single_level, only   : single_level_type
+    use radiation_cloud, only          : cloud_type
+    use radiation_flux, only           : flux_type
+    use radiation_two_stream, only     : calc_two_stream_gammas_sw, &
+         &                               calc_reflectance_transmittance_sw
+    use radiation_adding_ica_sw, only  : adding_ica_sw
+    use radiation_cloud_generator, only: cloud_generator
+
+    implicit none
+
+    ! Inputs
+    integer, intent(in) :: nlev               ! number of model levels
+    integer, intent(in) :: istartcol, iendcol ! range of columns to process
+    type(config_type),        intent(in) :: config
+    type(single_level_type),  intent(in) :: single_level
+    type(cloud_type),         intent(in) :: cloud
+
+    ! Gas and aerosol optical depth, single-scattering albedo and
+    ! asymmetry factor at each shortwave g-point
+    real(jprb), intent(in), dimension(config%n_g_sw, nlev, istartcol:iendcol) :: &
+         &  od, ssa, g
+
+    ! Cloud and precipitation optical depth, single-scattering albedo and
+    ! asymmetry factor in each shortwave band
+    real(jprb), intent(in), dimension(config%n_bands_sw,nlev,istartcol:iendcol)   :: &
+         &  od_cloud, ssa_cloud, g_cloud
+
+    ! Direct and diffuse surface albedos, and the incoming shortwave
+    ! flux into a plane perpendicular to the incoming radiation at
+    ! top-of-atmosphere in each of the shortwave g points
+    real(jprb), intent(in), dimension(config%n_g_sw,istartcol:iendcol) :: &
+         &  albedo_direct, albedo_diffuse, incoming_sw
+
+    ! Output
+    type(flux_type), intent(inout):: flux
+
+    ! Local variables
+
+    ! Cosine of solar zenith angle
+    real(jprb)                                 :: cos_sza
+
+    ! Diffuse reflectance and transmittance for each layer in clear
+    ! and all skies
+    real(jprb), dimension(config%n_g_sw, nlev) :: ref_clear, trans_clear, reflectance, transmittance
+
+    ! Fraction of direct beam scattered by a layer into the upwelling
+    ! or downwelling diffuse streams, in clear and all skies
+    real(jprb), dimension(config%n_g_sw, nlev) :: ref_dir_clear, trans_dir_diff_clear, ref_dir, trans_dir_diff
+
+    ! Transmittance for the direct beam in clear and all skies
+    real(jprb), dimension(config%n_g_sw, nlev) :: trans_dir_dir_clear, trans_dir_dir
+
+    ! Fluxes per g point
+    real(jprb), dimension(config%n_g_sw, nlev+1) :: flux_up, flux_dn_diffuse, flux_dn_direct
+
+    ! Combined gas+aerosol+cloud optical depth, single scattering
+    ! albedo and asymmetry factor
+    real(jprb), dimension(config%n_g_sw) :: od_total, ssa_total, g_total
+
+    ! Combined scattering optical depth
+    real(jprb) :: scat_od
+
+    ! Two-stream coefficients
+    real(jprb), dimension(config%n_g_sw) :: gamma1, gamma2, gamma3
+
+    ! Optical depth scaling from the cloud generator, zero indicating
+    ! clear skies
+    real(jprb), dimension(config%n_g_sw,nlev) :: od_scaling
+
+    ! Modified optical depth after McICA scaling to represent cloud
+    ! inhomogeneity
+    real(jprb), dimension(config%n_g_sw) :: od_cloud_new
+
+    ! Total cloud cover output from the cloud generator
+    real(jprb) :: total_cloud_cover
+
+    ! Number of g points
+    integer :: ng
+
+    ! Loop indices for level, column and g point
+    integer :: jlev, jcol, jg
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_mcica_sw:solver_mcica_sw',0,hook_handle)
+
+    if (.not. config%do_clear) then
+      write(nulerr,'(a)') '*** Error: shortwave McICA requires clear-sky calculation to be performed'
+      call radiation_abort()      
+    end if
+
+    ng = config%n_g_sw
+
+    ! Loop through columns
+    do jcol = istartcol,iendcol
+      ! Only perform calculation if sun above the horizon
+      if (single_level%cos_sza(jcol) > 0.0_jprb) then
+        cos_sza = single_level%cos_sza(jcol)
+
+        ! Clear-sky calculation - first compute clear-sky reflectance,
+        ! transmittance etc at each model level
+        if (.not. config%do_sw_delta_scaling_with_gases) then
+          ! Delta-Eddington scaling has already been performed to the
+          ! aerosol part of od, ssa and g
+          do jlev = 1,nlev
+            call calc_two_stream_gammas_sw(ng, &
+                 &  cos_sza, ssa(:,jlev,jcol), g(:,jlev,jcol), &
+                 &  gamma1, gamma2, gamma3)
+            call calc_reflectance_transmittance_sw(ng, &
+                 &  cos_sza, od(:,jlev,jcol), ssa(:,jlev,jcol), &
+                 &  gamma1, gamma2, gamma3, &
+                 &  ref_clear(:,jlev), trans_clear(:,jlev), &
+                 &  ref_dir_clear(:,jlev), trans_dir_diff_clear(:,jlev), &
+                 &  trans_dir_dir_clear(:,jlev) )
+          end do
+        else
+          ! Apply delta-Eddington scaling to the aerosol-gas mixture
+          do jlev = 1,nlev
+            od_total  =  od(:,jlev,jcol)
+            ssa_total = ssa(:,jlev,jcol)
+            g_total   =   g(:,jlev,jcol)
+            call delta_eddington(od_total, ssa_total, g_total)
+            call calc_two_stream_gammas_sw(ng, &
+                 &  cos_sza, ssa_total, g_total, &
+                 &  gamma1, gamma2, gamma3)
+            call calc_reflectance_transmittance_sw(ng, &
+                 &  cos_sza, od_total, ssa_total, &
+                 &  gamma1, gamma2, gamma3, &
+                 &  ref_clear(:,jlev), trans_clear(:,jlev), &
+                 &  ref_dir_clear(:,jlev), trans_dir_diff_clear(:,jlev), &
+                 &  trans_dir_dir_clear(:,jlev) )
+          end do
+        end if
+
+        ! Use adding method to compute fluxes
+        call adding_ica_sw(ng, nlev, incoming_sw(:,jcol), &
+             &  albedo_diffuse(:,jcol), albedo_direct(:,jcol), spread(cos_sza,1,ng), &
+             &  ref_clear, trans_clear, ref_dir_clear, trans_dir_diff_clear, &
+             &  trans_dir_dir_clear, flux_up, flux_dn_diffuse, flux_dn_direct)
+        
+        ! Sum over g-points to compute and save clear-sky broadband
+        ! fluxes
+        flux%sw_up_clear(jcol,:) = sum(flux_up,1)
+        if (allocated(flux%sw_dn_direct_clear)) then
+          flux%sw_dn_direct_clear(jcol,:) &
+               &  = sum(flux_dn_direct,1)
+          flux%sw_dn_clear(jcol,:) = sum(flux_dn_diffuse,1) &
+               &  + flux%sw_dn_direct_clear(jcol,:)
+        else
+          flux%sw_dn_clear(jcol,:) = sum(flux_dn_diffuse,1) &
+               &  + sum(flux_dn_direct,1)
+        end if
+        ! Store spectral downwelling fluxes at surface
+        flux%sw_dn_diffuse_surf_clear_g(:,jcol) = flux_dn_diffuse(:,nlev+1)
+        flux%sw_dn_direct_surf_clear_g(:,jcol)  = flux_dn_direct(:,nlev+1)
+
+        ! Do cloudy-sky calculation
+        call cloud_generator(ng, nlev, config%i_overlap_scheme, &
+             &  single_level%iseed(jcol), &
+             &  config%cloud_fraction_threshold, &
+             &  cloud%fraction(jcol,:), cloud%overlap_param(jcol,:), &
+             &  config%cloud_inhom_decorr_scaling, cloud%fractional_std(jcol,:), &
+             &  config%pdf_sampler, od_scaling, total_cloud_cover, &
+             &  is_beta_overlap=config%use_beta_overlap)
+
+        ! Store total cloud cover
+        flux%cloud_cover_sw(jcol) = total_cloud_cover
+        
+        if (total_cloud_cover >= config%cloud_fraction_threshold) then
+          ! Total-sky calculation
+          do jlev = 1,nlev
+            ! Compute combined gas+aerosol+cloud optical properties
+            if (cloud%fraction(jcol,jlev) >= config%cloud_fraction_threshold) then
+              od_cloud_new = od_scaling(:,jlev) &
+                   &  * od_cloud(config%i_band_from_reordered_g_sw,jlev,jcol)
+              od_total  = od(:,jlev,jcol) + od_cloud_new
+              ssa_total = 0.0_jprb
+              g_total   = 0.0_jprb
+              ! In single precision we need to protect against the
+              ! case that od_total > 0.0 and ssa_total > 0.0 but
+              ! od_total*ssa_total == 0 due to underflow
+              do jg = 1,ng
+                if (od_total(jg) > 0.0_jprb) then
+                  scat_od = ssa(jg,jlev,jcol)*od(jg,jlev,jcol) &
+                       &     + ssa_cloud(config%i_band_from_reordered_g_sw(jg),jlev,jcol) &
+                       &     *  od_cloud_new(jg)
+                  ssa_total(jg) = scat_od / od_total(jg)
+                  if (scat_od > 0.0_jprb) then
+                    g_total(jg) = (g(jg,jlev,jcol)*ssa(jg,jlev,jcol)*od(jg,jlev,jcol) &
+                         &     +   g_cloud(config%i_band_from_reordered_g_sw(jg),jlev,jcol) &
+                         &     * ssa_cloud(config%i_band_from_reordered_g_sw(jg),jlev,jcol) &
+                         &     *  od_cloud_new(jg)) &
+                         &     / scat_od
+                  end if
+                end if
+              end do
+
+              ! Apply delta-Eddington scaling to the cloud-aerosol-gas
+              ! mixture
+              if (config%do_sw_delta_scaling_with_gases) then
+                call delta_eddington(od_total, ssa_total, g_total)
+              end if
+
+             ! Compute cloudy-sky reflectance, transmittance etc at
+              ! each model level
+              call calc_two_stream_gammas_sw(ng, &
+                   &  cos_sza, ssa_total, g_total, &
+                   &  gamma1, gamma2, gamma3)
+
+              call calc_reflectance_transmittance_sw(ng, &
+                   &  cos_sza, od_total, ssa_total, &
+                   &  gamma1, gamma2, gamma3, &
+                   &  reflectance(:,jlev), transmittance(:,jlev), &
+                   &  ref_dir(:,jlev), trans_dir_diff(:,jlev), &
+                   &  trans_dir_dir(:,jlev) )
+
+            else
+              ! Clear-sky layer: copy over clear-sky values
+              reflectance(:,jlev) = ref_clear(:,jlev)
+              transmittance(:,jlev) = trans_clear(:,jlev)
+              ref_dir(:,jlev) = ref_dir_clear(:,jlev)
+              trans_dir_diff(:,jlev) = trans_dir_diff_clear(:,jlev)
+              trans_dir_dir(:,jlev) = trans_dir_dir_clear(:,jlev)
+            end if
+          end do
+            
+          ! Use adding method to compute fluxes for an overcast sky
+          call adding_ica_sw(ng, nlev, incoming_sw(:,jcol), &
+               &  albedo_diffuse(:,jcol), albedo_direct(:,jcol), spread(cos_sza,1,ng), &
+               &  reflectance, transmittance, ref_dir, trans_dir_diff, &
+               &  trans_dir_dir, flux_up, flux_dn_diffuse, flux_dn_direct)
+          
+          ! Store overcast broadband fluxes
+          flux%sw_up(jcol,:) = sum(flux_up,1)
+          if (allocated(flux%sw_dn_direct)) then
+            flux%sw_dn_direct(jcol,:) = sum(flux_dn_direct,1)
+            flux%sw_dn(jcol,:) = sum(flux_dn_diffuse,1) &
+                 &  + flux%sw_dn_direct(jcol,:)
+          else
+            flux%sw_dn(jcol,:) = sum(flux_dn_diffuse,1) &
+                 &  + sum(flux_dn_direct,1)
+          end if
+
+          ! Cloudy flux profiles currently assume completely overcast
+          ! skies; perform weighted average with clear-sky profile
+          flux%sw_up(jcol,:) =  total_cloud_cover *flux%sw_up(jcol,:) &
+               &  + (1.0_jprb - total_cloud_cover)*flux%sw_up_clear(jcol,:)
+          flux%sw_dn(jcol,:) =  total_cloud_cover *flux%sw_dn(jcol,:) &
+               &  + (1.0_jprb - total_cloud_cover)*flux%sw_dn_clear(jcol,:)
+          if (allocated(flux%sw_dn_direct)) then
+            flux%sw_dn_direct(jcol,:) = total_cloud_cover *flux%sw_dn_direct(jcol,:) &
+                 &  + (1.0_jprb - total_cloud_cover)*flux%sw_dn_direct_clear(jcol,:)
+          end if
+          ! Likewise for surface spectral fluxes
+          flux%sw_dn_diffuse_surf_g(:,jcol) = flux_dn_diffuse(:,nlev+1)
+          flux%sw_dn_direct_surf_g(:,jcol)  = flux_dn_direct(:,nlev+1)
+          flux%sw_dn_diffuse_surf_g(:,jcol) = total_cloud_cover *flux%sw_dn_diffuse_surf_g(:,jcol) &
+               &     + (1.0_jprb - total_cloud_cover)*flux%sw_dn_diffuse_surf_clear_g(:,jcol)
+          flux%sw_dn_direct_surf_g(:,jcol) = total_cloud_cover *flux%sw_dn_direct_surf_g(:,jcol) &
+               &     + (1.0_jprb - total_cloud_cover)*flux%sw_dn_direct_surf_clear_g(:,jcol)
+          
+        else
+          ! No cloud in profile and clear-sky fluxes already
+          ! calculated: copy them over
+          flux%sw_up(jcol,:) = flux%sw_up_clear(jcol,:)
+          flux%sw_dn(jcol,:) = flux%sw_dn_clear(jcol,:)
+          if (allocated(flux%sw_dn_direct)) then
+            flux%sw_dn_direct(jcol,:) = flux%sw_dn_direct_clear(jcol,:)
+          end if
+          flux%sw_dn_diffuse_surf_g(:,jcol) = flux%sw_dn_diffuse_surf_clear_g(:,jcol)
+          flux%sw_dn_direct_surf_g(:,jcol)  = flux%sw_dn_direct_surf_clear_g(:,jcol)
+
+        end if ! Cloud is present in profile
+
+      else
+        ! Set fluxes to zero if sun is below the horizon
+        flux%sw_up(jcol,:) = 0.0_jprb
+        flux%sw_dn(jcol,:) = 0.0_jprb
+        if (allocated(flux%sw_dn_direct)) then
+          flux%sw_dn_direct(jcol,:) = 0.0_jprb
+        end if
+        flux%sw_up_clear(jcol,:) = 0.0_jprb
+        flux%sw_dn_clear(jcol,:) = 0.0_jprb
+        if (allocated(flux%sw_dn_direct_clear)) then
+          flux%sw_dn_direct_clear(jcol,:) = 0.0_jprb
+        end if
+        flux%sw_dn_diffuse_surf_g(:,jcol) = 0.0_jprb
+        flux%sw_dn_direct_surf_g(:,jcol)  = 0.0_jprb
+        flux%sw_dn_diffuse_surf_clear_g(:,jcol) = 0.0_jprb
+        flux%sw_dn_direct_surf_clear_g(:,jcol)  = 0.0_jprb
+      end if ! Sun above horizon
+
+    end do ! Loop over columns
+
+    if (lhook) call dr_hook('radiation_mcica_sw:solver_mcica_sw',1,hook_handle)
+    
+  end subroutine solver_mcica_sw
+
+end module radiation_mcica_sw
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_monochromatic.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_monochromatic.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_monochromatic.F90	(revision 3908)
@@ -0,0 +1,382 @@
+! radiation_interface.F90 - Monochromatic gas/cloud optics for testing
+!
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2017-04-11  R. Hogan  Receive "surface" dummy argument
+!   2017-09-13  R. Hogan  Revert
+!   2018-08-29  R. Hogan  Particulate single-scattering albedo / asymmetry from namelist
+
+module radiation_monochromatic
+
+  implicit none
+
+  public  :: setup_gas_optics, gas_optics, set_gas_units, &
+       &     setup_cloud_optics, cloud_optics,            &
+       &     setup_aerosol_optics, add_aerosol_optics
+
+contains
+
+  ! Provides elemental function "delta_eddington"
+#include "radiation_delta_eddington.h"
+
+  !---------------------------------------------------------------------
+  ! Setup the arrays in the config object corresponding to the
+  ! monochromatic gas optics model.  The directory argument is not
+  ! used, since no look-up tables need to be loaded.
+  subroutine setup_gas_optics(config, directory)
+
+    use radiation_config, only : config_type
+    
+    type(config_type), intent(inout) :: config
+    character(len=*),  intent(in)    :: directory
+
+    ! In the monochromatic model we have simply one band and g-point
+    ! in both the longwave and shortwave parts of the spectrum
+    config%n_g_sw     = 1
+    config%n_g_lw     = 1
+    config%n_bands_sw = 1
+    config%n_bands_lw = 1
+
+    ! Allocate arrays
+    allocate(config%i_band_from_g_sw          (config%n_g_sw))
+    allocate(config%i_band_from_g_lw          (config%n_g_lw))
+    allocate(config%i_band_from_reordered_g_sw(config%n_g_sw))
+    allocate(config%i_band_from_reordered_g_lw(config%n_g_lw))
+    allocate(config%i_g_from_reordered_g_sw(config%n_g_sw))
+    allocate(config%i_g_from_reordered_g_lw(config%n_g_lw))
+
+    ! Indices are trivial...
+    config%i_band_from_g_sw           = 1
+    config%i_band_from_g_lw           = 1
+    config%i_g_from_reordered_g_sw    = 1
+    config%i_g_from_reordered_g_lw    = 1
+    config%i_band_from_reordered_g_sw = 1
+    config%i_band_from_reordered_g_lw = 1
+
+  end subroutine setup_gas_optics
+
+
+  !---------------------------------------------------------------------
+  ! Dummy routine for scaling gas mixing ratios
+  subroutine set_gas_units(gas)
+
+    use radiation_gas,           only : gas_type
+    type(gas_type),    intent(inout) :: gas
+
+  end subroutine set_gas_units
+
+
+  !---------------------------------------------------------------------
+  ! Dummy setup routine for cloud optics: in fact, no setup is
+  ! required for monochromatic case
+  subroutine setup_cloud_optics(config)
+
+    use radiation_config, only : config_type
+    type(config_type), intent(inout) :: config
+
+  end subroutine setup_cloud_optics
+
+
+  !---------------------------------------------------------------------
+  ! Dummy subroutine since no aerosols are represented in
+  ! monochromatic case
+  subroutine setup_aerosol_optics(config)
+
+    use radiation_config,              only : config_type
+    type(config_type), intent(inout) :: config
+
+  end subroutine setup_aerosol_optics
+
+
+  !---------------------------------------------------------------------
+  ! Compute gas optical depths, shortwave scattering, Planck function
+  ! and incoming shortwave radiation at top-of-atmosphere
+  subroutine gas_optics(ncol,nlev,istartcol,iendcol, &
+       config, single_level, thermodynamics, gas, lw_albedo, & 
+       od_lw, od_sw, ssa_sw, planck_hl, lw_emission, &
+       incoming_sw)
+
+    use parkind1,                 only : jprb
+    use radiation_config,         only : config_type
+    use radiation_thermodynamics, only : thermodynamics_type
+    use radiation_single_level,   only : single_level_type
+    use radiation_gas,            only : gas_type
+    use radiation_constants,      only : Pi, StefanBoltzmann
+
+    ! Inputs
+    integer, intent(in) :: ncol               ! number of columns
+    integer, intent(in) :: nlev               ! number of model levels
+    integer, intent(in) :: istartcol, iendcol ! range of columns to process
+    type(config_type),        intent(in) :: config
+    type(single_level_type),  intent(in) :: single_level
+    type(thermodynamics_type),intent(in) :: thermodynamics
+    type(gas_type),           intent(in) :: gas
+
+    ! Longwave albedo of the surface
+    real(jprb), dimension(config%n_g_lw,istartcol:iendcol), &
+         &  intent(in) :: lw_albedo
+
+    ! Outputs
+
+    ! Gaseous layer optical depth in longwave and shortwave, and
+    ! shortwave single scattering albedo (i.e. fraction of extinction
+    ! due to Rayleigh scattering) at each g-point
+    real(jprb), dimension(config%n_g_lw,nlev,istartcol:iendcol), intent(out) :: &
+         &   od_lw
+    real(jprb), dimension(config%n_g_sw,nlev,istartcol:iendcol), intent(out) :: &
+         &   od_sw, ssa_sw
+
+    ! The Planck function (emitted flux from a black body) at half
+    ! levels and at the surface at each longwave g-point
+    real(jprb), dimension(config%n_g_lw,nlev+1,istartcol:iendcol), intent(out) :: &
+         &   planck_hl
+    real(jprb), dimension(config%n_g_lw,istartcol:iendcol), intent(out) :: &
+         &   lw_emission
+
+    ! The incoming shortwave flux into a plane perpendicular to the
+    ! incoming radiation at top-of-atmosphere in each of the shortwave
+    ! g-points
+    real(jprb), dimension(config%n_g_sw,istartcol:iendcol), intent(out) :: &
+         &   incoming_sw
+    
+    ! Ratio of the optical depth of the entire atmospheric column that
+    ! is in the current layer
+    real(jprb), dimension(istartcol:iendcol) :: extinction_fraction
+
+    ! In the monochromatic model, the absorption by the atmosphere is
+    ! assumed proportional to the mass in each layer, so is defined in
+    ! terms of a total zenith optical depth and then distributed with
+    ! height according to the pressure.
+    !real(jprb), parameter :: total_od_sw = 0.10536_jprb ! Transmittance 0.9
+    !real(jprb), parameter :: total_od_lw = 1.6094_jprb  ! Transmittance 0.2
+
+    integer :: jlev
+
+    do jlev = 1,nlev
+      ! The fraction of the total optical depth in the current layer
+      ! is proportional to the fraction of the mass of the atmosphere
+      ! in the current layer, computed from pressure assuming
+      ! hydrostatic balance
+      extinction_fraction = &
+           &   (thermodynamics%pressure_hl(istartcol:iendcol,jlev+1) &
+           &   -thermodynamics%pressure_hl(istartcol:iendcol,jlev)) &
+           &   /thermodynamics%pressure_hl(istartcol:iendcol,nlev)
+      
+      ! Assign longwave and shortwave optical depths
+      od_lw(1,jlev,:) = config%mono_lw_total_od*extinction_fraction
+      od_sw(1,jlev,:) = config%mono_sw_total_od*extinction_fraction
+    end do
+
+    ! Shortwave single-scattering albedo is almost entirely Rayleigh
+    ! scattering
+    ssa_sw = 0.999999_jprb
+
+    ! Entire shortwave spectrum represented in one band
+    incoming_sw(1,:) = single_level%solar_irradiance
+
+    if (single_level%is_simple_surface) then
+      if (config%mono_lw_wavelength <= 0.0_jprb) then
+        ! Entire longwave spectrum represented in one band
+        lw_emission(1,istartcol:iendcol) &
+             &  = StefanBoltzmann * single_level%skin_temperature(istartcol:iendcol)**4 &
+             &  * single_level%lw_emissivity(istartcol:iendcol,1)
+        do jlev = 1,nlev+1
+          planck_hl(1,jlev,istartcol:iendcol) = StefanBoltzmann * thermodynamics%temperature_hl(istartcol:iendcol,jlev)**4
+        end do
+      else
+        ! Single wavelength: multiply by pi to convert W sr-1 m-3 to W m-3
+        lw_emission(1,istartcol:iendcol) = Pi*planck_function(config%mono_lw_wavelength, &
+             &             single_level%skin_temperature(istartcol:iendcol)) &
+             &  * single_level%lw_emissivity(istartcol:iendcol,1)
+        do jlev = 1,nlev+1
+          planck_hl(1,jlev,istartcol:iendcol) = Pi*planck_function(config%mono_lw_wavelength, &
+               &             thermodynamics%temperature_hl(istartcol:iendcol,jlev))
+        end do
+      end if
+    else
+      lw_emission = transpose(single_level%lw_emission)
+    end if
+
+  end subroutine gas_optics
+
+
+  !---------------------------------------------------------------------
+  ! Compute cloud optical depth, single-scattering albedo and
+  ! g factor in the longwave and shortwave
+  subroutine cloud_optics(nlev,istartcol,iendcol, &
+       &   config, thermodynamics, cloud, & 
+       &   od_lw_cloud, ssa_lw_cloud, g_lw_cloud, &
+       &   od_sw_cloud, ssa_sw_cloud, g_sw_cloud)
+
+    use parkind1,                 only : jprb
+    use radiation_config,         only : config_type
+    use radiation_thermodynamics, only : thermodynamics_type
+    use radiation_cloud,          only : cloud_type
+    use radiation_constants,      only : AccelDueToGravity, &
+         &   DensityLiquidWater, DensitySolidIce
+
+    ! Inputs
+    integer, intent(in) :: nlev               ! number of model levels
+    integer, intent(in) :: istartcol, iendcol ! range of columns to process
+    type(config_type), intent(in) :: config
+    type(thermodynamics_type),intent(in) :: thermodynamics
+    type(cloud_type),   intent(in) :: cloud
+
+    ! Outputs
+
+    ! Layer optical depth, single scattering albedo and g factor of
+    ! clouds in each longwave band, where the latter two
+    ! variables are only defined if cloud longwave scattering is
+    ! enabled (otherwise both are treated as zero).
+    real(jprb), dimension(config%n_bands_lw,nlev,istartcol:iendcol), intent(out) :: &
+         &   od_lw_cloud
+    real(jprb), dimension(config%n_bands_lw_if_scattering,nlev,istartcol:iendcol), &
+         &   intent(out) :: ssa_lw_cloud, g_lw_cloud
+
+    ! Layer optical depth, single scattering albedo and g factor of
+    ! clouds in each shortwave band
+    real(jprb), dimension(config%n_g_sw,nlev,istartcol:iendcol), intent(out) :: &
+         &   od_sw_cloud, ssa_sw_cloud, g_sw_cloud
+
+    ! In-cloud liquid and ice water path in a layer, in kg m-2
+    real(jprb), dimension(nlev,istartcol:iendcol) :: lwp_kg_m2, iwp_kg_m2
+
+    integer  :: jlev, jcol
+
+    ! Factor to convert from gridbox-mean mass mixing ratio to
+    ! in-cloud water path
+    real(jprb) :: factor
+
+    ! Convert cloud mixing ratio into liquid and ice water path
+    ! in each layer
+    do jlev = 1, nlev
+      do jcol = istartcol, iendcol
+        ! Factor to convert from gridbox-mean mass mixing ratio to
+        ! in-cloud water path involves the pressure difference in
+        ! Pa, acceleration due to gravity and cloud fraction
+        ! adjusted to avoid division by zero.
+        factor = ( thermodynamics%pressure_hl(jcol,jlev+1)    &
+             &    -thermodynamics%pressure_hl(jcol,jlev  )  ) &
+             &   / (AccelDueToGravity &
+             &   * max(epsilon(1.0_jprb), cloud%fraction(jcol,jlev)))
+        lwp_kg_m2(jlev,jcol) = factor * cloud%q_liq(jcol,jlev)
+        iwp_kg_m2(jlev,jcol) = factor * cloud%q_ice(jcol,jlev)
+      end do
+    end do
+
+    ! Geometric optics approximation: particles treated as much larger
+    ! than the wavelength in both shortwave and longwave
+    od_sw_cloud(1,:,:) &
+         &   = (3.0_jprb/(2.0_jprb*DensityLiquidWater)) &
+         &   * lwp_kg_m2 / transpose(cloud%re_liq(istartcol:iendcol,:)) &
+         &   + (3.0_jprb / (2.0_jprb * DensitySolidIce)) &
+         &   * iwp_kg_m2 / transpose(cloud%re_ice(istartcol:iendcol,:))
+    od_lw_cloud(1,:,:) = lwp_kg_m2 * 137.22_jprb &
+         &   + (3.0_jprb / (2.0_jprb * DensitySolidIce)) &
+         &   * iwp_kg_m2 / transpose(cloud%re_ice(istartcol:iendcol,:))
+
+    if (config%iverbose >= 4) then
+      do jcol = istartcol,iendcol
+        write(*,'(a,i0,a,f7.3,a,f7.3)') 'Profile ', jcol, ': shortwave optical depth = ', &
+             &  sum(od_sw_cloud(1,:,jcol)*cloud%fraction(jcol,:)), &
+             &  ', longwave optical depth = ', &
+             &  sum(od_lw_cloud(1,:,jcol)*cloud%fraction(jcol,:))
+        !    print *, 'LWP = ', sum(lwp_kg_m2(:,istartcol)*cloud%fraction(istartcol,:))
+      end do
+    end if
+
+    ssa_sw_cloud = config%mono_sw_single_scattering_albedo
+    g_sw_cloud   = config%mono_sw_asymmetry_factor
+
+    ! In-place delta-Eddington scaling
+    call delta_eddington(od_sw_cloud, ssa_sw_cloud, g_sw_cloud)
+
+    if (config%do_lw_cloud_scattering) then
+      ssa_lw_cloud = config%mono_lw_single_scattering_albedo
+      g_lw_cloud   = config%mono_lw_asymmetry_factor
+      ! In-place delta-Eddington scaling
+      call delta_eddington(od_lw_cloud, ssa_lw_cloud, g_lw_cloud)
+    end if
+
+  end subroutine cloud_optics
+
+
+  !---------------------------------------------------------------------
+  ! Dummy subroutine since no aerosols are represented in
+  ! monochromatic case
+  subroutine add_aerosol_optics(nlev,istartcol,iendcol, &
+       &  config, thermodynamics, gas, aerosol, & 
+       &  od_lw, ssa_lw, g_lw, od_sw, ssa_sw, g_sw)
+
+    use parkind1,                      only : jprb
+
+    use radiation_config,              only : config_type
+    use radiation_thermodynamics,      only : thermodynamics_type
+    use radiation_gas,                 only : gas_type
+    use radiation_aerosol,             only : aerosol_type
+
+    integer, intent(in) :: nlev               ! number of model levels
+    integer, intent(in) :: istartcol, iendcol ! range of columns to process
+    type(config_type), intent(in), target :: config
+    type(thermodynamics_type),intent(in)  :: thermodynamics
+    type(gas_type),           intent(in)  :: gas
+    type(aerosol_type),       intent(in)  :: aerosol
+    ! Optical depth, single scattering albedo and asymmetry factor of
+    ! the atmosphere (gases on input, gases and aerosols on output)
+    ! for each g point. Note that longwave ssa and asymmetry and
+    ! shortwave asymmetry are all zero for gases, so are not yet
+    ! defined on input and are therefore intent(out).
+    real(jprb), dimension(config%n_g_lw,nlev,istartcol:iendcol), intent(inout) :: od_lw
+    real(jprb), dimension(config%n_g_lw_if_scattering,nlev,istartcol:iendcol), &
+         &  intent(out) :: ssa_lw, g_lw
+    real(jprb), dimension(config%n_g_sw,nlev,istartcol:iendcol), intent(inout) &
+         &  :: od_sw, ssa_sw
+    real(jprb), dimension(config%n_g_sw,nlev,istartcol:iendcol), intent(out) :: g_sw
+
+    g_sw = 0.0_jprb
+
+    if (config%do_lw_aerosol_scattering) then
+      ssa_lw = 0.0_jprb
+      g_lw   = 0.0_jprb
+    end if
+
+  end subroutine add_aerosol_optics
+
+  !---------------------------------------------------------------------
+  ! Planck function in terms of wavelength
+  elemental function planck_function(wavelength, temperature)
+
+    use parkind1,            only : jprb
+
+    use radiation_constants, only : BoltzmannConstant, PlanckConstant, &
+         &                          SpeedOfLight
+
+    real(jprb), intent(in) :: wavelength  ! metres
+    real(jprb), intent(in) :: temperature ! Kelvin
+
+    ! Output in W sr-1 m-3
+    real(jprb)             :: planck_function
+
+    if (temperature > 0.0_jprb) then
+      planck_function = 2.0_jprb * PlanckConstant * SpeedOfLight**2 &
+           &   / (wavelength**5 &
+           &   * (exp(PlanckConstant*SpeedOfLight &
+           &         /(wavelength*BoltzmannConstant*temperature)) - 1.0_jprb))
+    else
+      planck_function = 0.0_jprb
+    end if
+
+  end function planck_function
+
+end module radiation_monochromatic
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_optical_depth_scaling.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_optical_depth_scaling.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_optical_depth_scaling.h	(revision 3908)
@@ -0,0 +1,73 @@
+! radiation_optical_depth_scaling.h - Cloud optical-depth scaling for Tripleclouds 
+!
+! (C) Copyright 2016- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2017-07-14  R. Hogan  Incorporate gamma distribution option
+!
+! This file is intended to be included inside a module to ensure that
+! this simple routine may be inlined
+
+!---------------------------------------------------------------------
+! Compute the optical depth scalings for the optically "thick" and
+! "thin" regions of a Tripleclouds representation of a sub-grid PDF of
+! cloud optical depth. Following Shonk and Hogan (2008), the 16th
+! percentile is used for the thin region, and the formulas estimate
+! this for both lognormal and gamma distributions.
+pure subroutine optical_depth_scaling(nreg, frac_std, do_gamma, od_scaling)
+
+  use parkind1, only : jprb
+
+  ! Number of regions
+  integer, intent(in)     :: nreg
+
+  ! Fractional standard deviation of in-cloud water content
+  real(jprb), intent(in)  :: frac_std
+
+  ! Do we do a lognormal or gamma distribution?
+  logical, intent(in) :: do_gamma
+
+  ! Optical depth scaling for the cloudy regions
+  real(jprb), intent(out) :: od_scaling(2:nreg)
+
+  if (nreg == 2) then
+    ! Only one clear-sky and one cloudy region: cloudy region is
+    ! homogeneous
+    od_scaling(2) = 1.0_jprb
+  else
+    ! Two cloudy regions with optical depth scaled by 1-x and
+    ! 1+x.
+    ! Simple version which fails when fractional_std >= 1:
+    !od_scaling(2) = 1.0_jprb-cloud%fractional_std(jcol,jlev)
+    ! According to Shonk and Hogan (2008), 1-x should correspond to
+    ! the 16th percentile. 
+    if (.not. do_gamma) then
+      ! If we treat the distribution as a lognormal such that the
+      ! equivalent Normal has a mean mu and standard deviation sigma,
+      ! then the 16th percentile of the lognormal is very close to
+      ! exp(mu-sigma).
+      od_scaling(2) &
+           &  = exp(-sqrt(log(frac_std**2+1))) / sqrt(frac_std**2+1)
+    else
+      ! If we treat the distribution as a gamma then the 16th
+      ! percentile is close to the following
+      od_scaling(2) = exp(-frac_std*(1.0_jprb + 0.5_jprb*frac_std &
+           &                                   *(1.0_jprb+0.5_jprb*frac_std)))
+    end if
+
+    ! Ensure mean optical depth is conserved
+    od_scaling(3) = 2.0_jprb-od_scaling(2)
+  end if
+
+end subroutine optical_depth_scaling
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_overlap.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_overlap.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_overlap.F90	(revision 3908)
@@ -0,0 +1,459 @@
+! radiation_overlap.F90 - Module to compute cloud overlap quantities
+!
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2017-10-23  R. Hogan  Renamed single-character variables
+!   2018-10-05  R. Hogan  Generalized alpha overlap for non-equal regions
+!   2018-10-08  R. Hogan  Removed calc_region_fractions
+
+module radiation_overlap
+
+  implicit none
+
+  public :: calc_overlap_matrices
+
+contains
+
+
+  ! This function now superceded by calc_region_properties in module
+  ! radiation_regions
+  ! !---------------------------------------------------------------------
+  ! ! Return an array of length nreg containing the fraction of the
+  ! ! gridbox occupied by each region for the specified cloud fraction.
+  ! pure function calc_region_fractions(nreg, cloud_fraction)
+
+  !   use parkind1, only : jprb
+
+  !   integer,    intent(in)      :: nreg
+  !   real(jprb), intent(in)      :: cloud_fraction
+
+  !   real(jprb), dimension(nreg) :: calc_region_fractions
+  !   integer :: jreg
+
+  !   if (nreg == 1) then
+  !     ! Only one region: must occupy all of gridbox
+  !     calc_region_fractions(1) = 1.0_jprb
+  !   else
+  !     ! Two or more regions: the first is the cloud-free region
+  !     calc_region_fractions(1) = 1.0_jprb - cloud_fraction
+
+  !     do jreg = 2,nreg
+  !       ! The cloudy regions are assumed to each have the same
+  !       ! fraction - see Shonk and Hogan (2008) for justification
+  !       calc_region_fractions(jreg) = cloud_fraction / (nreg - 1.0_jprb)
+  !     end do
+  !   end if
+
+  ! end function calc_region_fractions
+
+  !---------------------------------------------------------------------
+  ! Calculate a matrix expressing the overlap of regions in adjacent
+  ! layers, using the method of Shonk et al. (2010) in terms of their
+  ! "beta" overlap parameter
+  pure function calc_beta_overlap_matrix(nreg, op, frac_upper, frac_lower, &
+       &  frac_threshold) result(overlap_matrix)
+
+    use parkind1, only : jprb
+    
+    integer, intent(in) :: nreg ! Number of regions
+
+    ! Overlap parameter for each region, and fraction of the gridbox
+    ! occupied by each region in the upper and lower layers
+    real(jprb), intent(in), dimension(nreg) :: op, frac_upper, frac_lower
+
+    ! Cloud-fraction threshold below which cloud is deemed not to be
+    ! present
+    real(jprb), intent(in) :: frac_threshold
+
+    ! Output overlap matrix
+    real(jprb) :: overlap_matrix(nreg,nreg)
+
+    ! Denominator and its reciprocal in computing the random part of
+    ! the overlap matrix
+    real(jprb) :: denominator, factor
+
+    ! Beta overlap parameter multiplied by the minimum region fraction
+    ! of the upper and lower layers
+    real(jprb) :: op_x_frac_min(nreg)
+
+    integer :: jupper, jlower, jreg
+
+    ! In computing the random part of the overlap matrix we need
+    ! to divide all elements by "denominator", or for efficiency
+    ! multiply by "factor"
+    denominator = 1.0_jprb
+    do jreg = 1,nreg
+      op_x_frac_min(jreg) = op(jreg) &
+           &  * min(frac_upper(jreg), frac_lower(jreg))
+      denominator = denominator - op_x_frac_min(jreg)
+    end do
+    ! In principle the denominator can be zero
+    if (denominator >= frac_threshold) then
+      factor = 1.0_jprb / denominator
+      ! Create the random part of the overlap matrix
+      do jupper = 1,nreg
+        do jlower = 1,nreg
+          overlap_matrix(jupper,jlower) = factor &
+               &  * (frac_lower(jlower)-op_x_frac_min(jlower)) &
+               &  * (frac_upper(jupper)-op_x_frac_min(jupper))
+        end do
+      end do
+    else
+      overlap_matrix = 0.0_jprb
+    end if
+    
+    ! Add on the maximum part of the overlap matrix
+    do jreg = 1,nreg
+      overlap_matrix(jreg,jreg) = overlap_matrix(jreg,jreg) &
+           &  + op_x_frac_min(jreg)
+    end do
+
+  end function calc_beta_overlap_matrix
+
+
+  !---------------------------------------------------------------------
+  ! Calculate a matrix expressing the overlap of regions in adjacent
+  ! layers, using the Hogan and Illingworth (2000) "alpha" overlap
+  ! parameter, but allowing for the two cloudy regions in the
+  ! Tripleclouds assumption to have different areas
+  pure function calc_alpha_overlap_matrix(nreg, op, op_inhom, &
+       &  frac_upper, frac_lower) result(overlap_matrix)
+
+    use parkind1, only : jprb
+    
+    integer, intent(in) :: nreg ! Number of regions
+
+    ! Overlap parameter for cloud boundaries and for internal
+    ! inhomogeneities
+    real(jprb), intent(in) :: op, op_inhom
+
+    ! Fraction of the gridbox occupied by each region in the upper and
+    ! lower layers
+    real(jprb), intent(in), dimension(nreg) :: frac_upper, frac_lower
+
+    ! Output overlap matrix
+    real(jprb) :: overlap_matrix(nreg,nreg)
+
+    ! Combined cloud cover of pair of layers
+    real(jprb) :: pair_cloud_cover
+
+    ! Cloud fraction of upper and lower layers
+    real(jprb) :: cf_upper, cf_lower
+
+    ! One divided by cloud fraction
+    real(jprb) :: one_over_cf
+
+    ! Fraction of domain with cloud in both layers
+    real(jprb) :: frac_both
+
+    cf_upper = sum(frac_upper(2:nreg))
+    cf_lower = sum(frac_lower(2:nreg))
+
+    pair_cloud_cover = op*max(cf_upper,cf_lower) &
+           &  + (1.0_jprb - op) &
+           &  * (cf_upper+cf_lower-cf_upper*cf_lower)
+
+    ! Clear in both layers
+    overlap_matrix(1,1) = 1.0_jprb - pair_cloud_cover
+    if (nreg == 2) then
+      ! Clear in upper layer, cloudy in lower layer
+      overlap_matrix(1,2) = pair_cloud_cover - cf_upper
+      ! Clear in lower layer, cloudy in upper layer
+      overlap_matrix(2,1) = pair_cloud_cover - cf_lower
+      ! Cloudy in both layers
+      overlap_matrix(2,2) = cf_upper + cf_lower - pair_cloud_cover
+    else
+       ! Clear in upper layer, cloudy in lower layer
+      one_over_cf = 1.0_jprb / max(cf_lower, 1.0e-6_jprb)
+      overlap_matrix(1,2) = (pair_cloud_cover - cf_upper) &
+           &              * frac_lower(2) * one_over_cf
+      overlap_matrix(1,3) = (pair_cloud_cover - cf_upper) &
+           &              * frac_lower(3) * one_over_cf
+      ! Clear in lower layer, cloudy in upper layer
+      one_over_cf = 1.0_jprb / max(cf_upper, 1.0e-6_jprb)
+      overlap_matrix(2,1) = (pair_cloud_cover - cf_lower) &
+           &              * frac_upper(2) * one_over_cf
+      overlap_matrix(3,1) = (pair_cloud_cover - cf_lower) &
+           &              * frac_upper(3) * one_over_cf
+      ! Cloudy in both layers: frac_both is the fraction of the
+      ! gridbox with cloud in both layers
+      frac_both = cf_upper + cf_lower - pair_cloud_cover
+      ! Treat low and high optical-depth regions within frac_both as
+      ! one treats clear and cloudy skies in the whole domain;
+      ! redefine the following variables treating the high
+      ! optical-depth region as the cloud
+      cf_upper = frac_upper(3) / max(cf_upper, 1.0e-6_jprb)
+      cf_lower = frac_lower(3) / max(cf_lower, 1.0e-6_jprb)
+      pair_cloud_cover = op_inhom*max(cf_upper,cf_lower) &
+           &  + (1.0_jprb - op_inhom) &
+           &  * (cf_upper+cf_lower-cf_upper*cf_lower)
+      ! Assign overlaps for this 2x2 section of the 3x3 matrix as for
+      ! the 2-region case above, but multiplied by frac_both
+      overlap_matrix(2,2) = frac_both * (1.0_jprb - pair_cloud_cover)
+      overlap_matrix(2,3) = frac_both * (pair_cloud_cover - cf_upper)
+      overlap_matrix(3,2) = frac_both * (pair_cloud_cover - cf_lower)
+      overlap_matrix(3,3) = frac_both * (cf_upper+cf_lower-pair_cloud_cover)
+    end if
+
+  end function calc_alpha_overlap_matrix
+
+
+  !---------------------------------------------------------------------
+  ! Calculate a matrix expressing the overlap of regions in adjacent
+  ! layers, using the Hogan and Illingworth (2000) "alpha" overlap
+  ! parameter, and assuming the two cloudy regions in the Tripleclouds
+  ! assumption have the same area
+  pure function calc_alpha_overlap_matrix_simple(nreg, op, op_inhom, &
+       &  cf_upper, cf_lower) result(overlap_matrix)
+
+    use parkind1, only : jprb
+    
+    integer, intent(in) :: nreg ! Number of regions
+
+    ! Overlap parameter for cloud boundaries and for internal
+    ! inhomogeneities
+    real(jprb), intent(in) :: op, op_inhom
+
+    ! Cloud fraction in the upper and lower layers
+    real(jprb), intent(in) :: cf_upper, cf_lower
+
+    ! Output overlap matrix
+    real(jprb) :: overlap_matrix(nreg,nreg)
+
+    ! Combined cloud cover of pair of layers
+    real(jprb) :: pair_cloud_cover
+
+    real(jprb) :: cloud_unit
+
+    pair_cloud_cover = op*max(cf_upper,cf_lower) &
+           &  + (1.0_jprb - op) &
+           &  * (cf_upper+cf_lower-cf_upper*cf_lower)
+
+    ! Clear in both layers
+    overlap_matrix(1,1) = 1.0_jprb - pair_cloud_cover
+    if (nreg == 2) then
+      ! Clear in upper layer, cloudy in lower layer
+      overlap_matrix(1,2) = pair_cloud_cover - cf_upper
+      ! Clear in lower layer, cloudy in upper layer
+      overlap_matrix(2,1) = pair_cloud_cover - cf_lower
+      ! Cloudy in both layers
+      overlap_matrix(2,2) = cf_upper + cf_lower - pair_cloud_cover
+    else
+      ! The following assumes that the two cloudy regions are of equal area.
+      ! Clear in upper layer, cloudy in lower layer
+      overlap_matrix(1,2) = 0.5_jprb * (pair_cloud_cover - cf_upper)
+      overlap_matrix(1,3) = overlap_matrix(1,2)
+      ! Clear in lower layer, cloudy in upper layer
+      overlap_matrix(2,1) = 0.5_jprb * (pair_cloud_cover - cf_lower)
+      overlap_matrix(3,1) = overlap_matrix(2,1)
+      ! Cloudy in both layers
+      cloud_unit = 0.25_jprb * (cf_upper + cf_lower - pair_cloud_cover)
+      overlap_matrix(2,2) = cloud_unit * (1.0_jprb + op_inhom)
+      overlap_matrix(2,3) = cloud_unit * (1.0_jprb - op_inhom)
+      overlap_matrix(3,3) = overlap_matrix(2,2)
+      overlap_matrix(3,2) = overlap_matrix(2,3)
+    end if
+
+  end function calc_alpha_overlap_matrix_simple
+
+
+  !---------------------------------------------------------------------
+  ! Compute the upward and downward overlap matrices u_matrix and
+  ! v_matrix, respectively, where u_matrix is defined such that
+  ! y=u_matrix*x, where x is a vector of upwelling fluxes in each
+  ! region just below an interface, and y is a vector of upwelling
+  ! fluxes in each region just above that interface. For nlev model
+  ! levels there are nlev+1 interfaces including the ground and
+  ! top-of-atmosphere, and so that is one of the dimensions of
+  ! u_matrix and v_matrix.
+  subroutine calc_overlap_matrices(nlev,nreg,istartcol,iendcol, &
+       &     region_fracs, overlap_param, u_matrix, v_matrix, decorrelation_scaling, &
+       &     cloud_fraction_threshold, cloud_cover, use_beta_overlap)
+
+    use parkind1,     only : jprb
+    use yomhook,      only : lhook, dr_hook
+
+    ! Number of levels and regions
+    integer,  intent(in) :: nlev, nreg
+
+    ! Range of columns to process (also outer dimensions of u_matrix
+    ! and v_matrix)
+    integer, intent(in) :: istartcol, iendcol
+
+    ! Area fraction of each region: region 1 is clear sky, and 2+ are
+    ! the cloudy regions (only one or two cloudy regions are
+    ! supported)
+    real(jprb), intent(in), dimension(1:nreg,nlev,istartcol:iendcol)  :: region_fracs
+
+    ! The overlap parameter: either the "alpha" of Hogan & Illingworth
+    ! (2000) or the "beta" of Shonk et al. (2010)
+    real(jprb), intent(in), dimension(:,:)  :: overlap_param  ! (ncol,nlev-1)
+
+    ! Output overlap matrices
+    real(jprb), intent(out), dimension(nreg,nreg,nlev+1,istartcol:iendcol) &
+         &  :: u_matrix, v_matrix
+
+    ! For regions 2 and above, the overlap decorrelation length for
+    ! cloud boundaries is scaled by this amount to obtain the overlap
+    ! decorrelation length for cloud inhomogeneities. Typically this
+    ! number is 0.5, but if omitted it will be assumed to be one (same
+    ! decorrelation for cloud boundaries and in-cloud inhomogeneities)
+    real(jprb), intent(in), optional :: decorrelation_scaling
+
+    ! Regions smaller than this are ignored
+    real(jprb), intent(in), optional :: cloud_fraction_threshold
+
+    ! The diagnosed cloud cover is an optional output
+    real(jprb), intent(out), optional :: cloud_cover(:)
+
+    ! Do we use Shonk et al.'s (2010) "beta" overlap parameter?
+    logical, intent(in), optional :: use_beta_overlap
+
+    ! Loop indices for column, level, region and the regions in the
+    ! upper and lower layers for an interface
+    integer  :: jcol, jlev, jupper, jlower
+
+    ! Overlap matrix (non-directional)
+    real(jprb) :: overlap_matrix(nreg,nreg)
+
+    ! Fraction of the gridbox occupied by each region in the upper and
+    ! lower layers for an interface
+    real(jprb) :: frac_upper(nreg), frac_lower(nreg)
+
+    ! Beta overlap parameter for each region
+    real(jprb) :: op(nreg)
+
+    ! In case the user doesn't supply cloud_fraction_threshold we use
+    ! a default value
+    real(jprb) :: frac_threshold
+
+    ! The decorrelation scaling to use, in case decorrelation_scaling
+    ! was not provided
+    real(jprb) :: used_decorrelation_scaling
+
+    logical :: use_beta_overlap_param
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_overlap:calc_overlap_matrices',0,hook_handle)
+
+    if (present(decorrelation_scaling)) then
+       used_decorrelation_scaling = decorrelation_scaling
+    else
+       used_decorrelation_scaling = 1.0_jprb
+    end if
+
+    if (present(cloud_fraction_threshold)) then
+      frac_threshold = cloud_fraction_threshold
+    else
+      frac_threshold = 1.0e-20_jprb
+    end if
+
+    if (present(use_beta_overlap)) then
+      use_beta_overlap_param = use_beta_overlap
+    else
+      use_beta_overlap_param = .false.
+    end if
+
+    ! Loop through each atmospheric column
+    do jcol = istartcol, iendcol
+      ! For this column, outer space is treated as one clear-sky
+      ! region, so the fractions are assigned as such
+      frac_upper(1) = 1.0_jprb
+      frac_upper(2:nreg) = 0.0_jprb
+
+      ! Overlap parameter is irrelevant when there is only one region
+      ! in the upper layer
+      op = 1.0_jprb
+
+      ! Loop down through the atmosphere, where jlev indexes each
+      ! half-level starting at 1 for the top-of-atmosphere, as well
+      ! as indexing each level starting at 1 for the top-most level.
+      do jlev = 1,nlev+1
+        ! Fraction of each region just below the interface
+        if (jlev > nlev) then
+          ! We are at the surface: treat as a single clear-sky
+          ! region
+          frac_lower(1) = 1.0_jprb
+          frac_lower(2:nreg) = 0.0_jprb
+        else
+          frac_lower = region_fracs(1:nreg,jlev,jcol)
+        end if
+   
+        ! Compute the overlap parameter of the interface just below
+        ! the current full level
+        if (jlev == 1 .or. jlev > nlev) then
+          ! We are at the surface or top-of-atmosphere: overlap
+          ! parameter is irrelevant
+          op = 1.0_jprb
+        else
+          ! We are not at the surface
+          op(1) = overlap_param(jcol,jlev-1)
+          ! For cloudy regions, scale the cloud-boundary overlap
+          ! parameter to obtain the cloud-inhomogeneity overlap
+          ! parameter as follows
+          if (op(1) >= 0.0_jprb) then
+            op(2:nreg) = op(1)**(1.0_jprb/used_decorrelation_scaling)
+          else
+            op(2:nreg) = op(1)
+          end if
+        end if
+     
+        if (use_beta_overlap_param) then
+          overlap_matrix = calc_beta_overlap_matrix(nreg, op, &
+               &  frac_upper, frac_lower, frac_threshold)
+        else
+          ! Simpler scheme assuming the two cloudy regions have the
+          ! same fraction
+          !overlap_matrix = calc_alpha_overlap_matrix_simple(nreg, &
+          !     &  op(1), op(2), &
+          !     &  1.0_jprb - frac_upper(1), 1.0_jprb - frac_lower(1))
+          ! More general scheme
+          overlap_matrix = calc_alpha_overlap_matrix(nreg, &
+               &  op(1), op(2), frac_upper, frac_lower)
+        end if
+
+        ! Convert to directional overlap matrices
+        do jupper = 1,nreg
+          do jlower = 1,nreg
+            if (frac_lower(jlower) >= frac_threshold) then
+              u_matrix(jupper,jlower,jlev,jcol) = overlap_matrix(jupper,jlower) &
+                   &  / frac_lower(jlower)
+            else
+              u_matrix(jupper,jlower,jlev,jcol) = 0.0_jprb
+            end if
+            if (frac_upper(jupper) >= frac_threshold) then
+              v_matrix(jlower,jupper,jlev,jcol) = overlap_matrix(jupper,jlower) &
+                   &  / frac_upper(jupper)
+            else
+              v_matrix(jlower,jupper,jlev,jcol) = 0.0_jprb
+            end if
+          end do
+        end do
+        frac_upper = frac_lower
+        
+      end do ! levels
+
+      ! Compute cloud cover from one of the directional overlap matrices
+      if (present(cloud_cover)) then
+        cloud_cover(jcol) = 1.0_jprb - product(v_matrix(1,1,:,jcol))
+      end if
+
+    end do ! columns
+
+    if (lhook) call dr_hook('radiation_overlap:calc_overlap_matrices',1,hook_handle)
+
+  end subroutine calc_overlap_matrices
+  
+end module radiation_overlap
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_pdf_sampler.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_pdf_sampler.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_pdf_sampler.F90	(revision 3908)
@@ -0,0 +1,210 @@
+! radiation_pdf_sampler.F90 - Get samples from a lognormal distribution for McICA
+!
+! (C) Copyright 2015- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+
+module radiation_pdf_sampler
+
+  use parkind1, only : jprb
+
+  implicit none
+  public
+
+  !---------------------------------------------------------------------
+  ! Derived type for sampling from a lognormal distribution, used to
+  ! generate water content or optical depth scalings for use in the
+  ! Monte Carlo Independent Column Approximation (McICA)
+  type pdf_sampler_type
+    ! Number of points in look-up table for cumulative distribution
+    ! function (CDF) and fractional standard deviation (FSD)
+    ! dimensions
+    integer :: ncdf, nfsd
+
+    ! First value of FSD and the reciprocal of the interval between
+    ! FSD values (which are assumed to be uniformly distributed)
+    real(jprb) :: fsd1, inv_fsd_interval
+
+    ! Value of the distribution for each CDF and FSD bin
+    real(jprb), allocatable, dimension(:,:) :: val
+
+  contains
+
+    procedure :: setup => setup_pdf_sampler
+    procedure :: sample => sample_from_pdf
+    procedure :: masked_sample => sample_from_pdf_masked
+    procedure :: deallocate => deallocate_pdf_sampler
+
+  end type pdf_sampler_type
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Load look-up table from a file 
+  subroutine setup_pdf_sampler(this, file_name, iverbose)
+    
+    use yomhook,     only : lhook, dr_hook
+    use easy_netcdf, only : netcdf_file
+
+    class(pdf_sampler_type), intent(inout) :: this
+    character(len=*),        intent(in)    :: file_name
+    integer, optional,       intent(in)    :: iverbose
+
+    type(netcdf_file)  :: file
+    integer            :: iverb
+    real(jprb), allocatable :: fsd(:)
+
+    real(jprb)         :: hook_handle
+
+    if (lhook) call dr_hook('radiation_pdf_sampler:setup',0,hook_handle)
+
+    if (present(iverbose)) then
+      iverb = iverbose
+    else
+      iverb = 2
+    end if
+
+    if (allocated(this%val)) then
+      deallocate(this%val)
+    end if
+
+    call file%open(trim(file_name), iverbose=iverb)
+
+    call file%get('fsd',fsd)
+    call file%get('x',  this%val)
+
+    call file%close()
+
+    this%ncdf = size(this%val,1)
+    this%nfsd = size(this%val,2)
+    this%fsd1 = fsd(1)
+    this%inv_fsd_interval = 1.0_jprb / (fsd(2)-fsd(1))
+
+    deallocate(fsd)
+
+    if (lhook) call dr_hook('radiation_pdf_sampler:setup',1,hook_handle)
+
+  end subroutine setup_pdf_sampler
+
+  !---------------------------------------------------------------------
+  ! Deallocate data in pdf_sampler_type derived type
+  subroutine deallocate_pdf_sampler(this)
+
+    use yomhook,     only : lhook, dr_hook
+
+    class(pdf_sampler_type), intent(inout) :: this
+    real(jprb)         :: hook_handle
+
+    if (lhook) call dr_hook('radiation_pdf_sampler:deallocate',0,hook_handle)
+
+    if (allocated(this%val)) then
+      deallocate(this%val)
+    end if
+
+    if (lhook) call dr_hook('radiation_pdf_sampler:deallocate',1,hook_handle)
+    
+  end subroutine deallocate_pdf_sampler
+
+
+  !---------------------------------------------------------------------
+  ! Extract the value of a lognormal distribution with fractional
+  ! standard deviation "fsd" corresponding to the cumulative
+  ! distribution function value "cdf", and return it in val. Since this
+  ! is an elemental subroutine, fsd, cdf and val may be arrays.
+  elemental subroutine sample_from_pdf(this, fsd, cdf, val)
+    
+    class(pdf_sampler_type), intent(in)  :: this
+
+    ! Fractional standard deviation (0 to 4) and cumulative
+    ! distribution function (0 to 1)
+    real(jprb),              intent(in)  :: fsd, cdf
+
+    ! Sample from distribution
+    real(jprb),              intent(out) :: val
+
+    ! Index to look-up table
+    integer    :: ifsd, icdf
+
+    ! Weights in bilinear interpolation
+    real(jprb) :: wfsd, wcdf
+
+    ! Bilinear interpolation with bounds
+    wcdf = cdf * (this%ncdf-1) + 1.0_jprb
+    icdf = max(1, min(int(wcdf), this%ncdf-1))
+    wcdf = max(0.0_jprb, min(wcdf - icdf, 1.0_jprb))
+
+    wfsd = (fsd-this%fsd1) * this%inv_fsd_interval + 1.0_jprb
+    ifsd = max(1, min(int(wfsd), this%nfsd-1))
+    wfsd = max(0.0_jprb, min(wfsd - ifsd, 1.0_jprb))
+
+    val =    (1.0_jprb-wcdf)*(1.0_jprb-wfsd) * this%val(icdf  ,ifsd)   &
+         & + (1.0_jprb-wcdf)*          wfsd  * this%val(icdf  ,ifsd+1) &
+         & +           wcdf *(1.0_jprb-wfsd) * this%val(icdf+1,ifsd)   &
+         & +           wcdf *          wfsd  * this%val(icdf+1,ifsd+1)
+
+  end subroutine sample_from_pdf
+
+
+  !---------------------------------------------------------------------
+  ! For true elements of mask, extract the values of a lognormal
+  ! distribution with fractional standard deviation "fsd"
+  ! corresponding to the cumulative distribution function values
+  ! "cdf", and return in val. For false elements of mask, return zero
+  ! in val.
+  subroutine sample_from_pdf_masked(this, nsamp, fsd, cdf, val, mask)
+    
+    class(pdf_sampler_type), intent(in)  :: this
+
+    ! Number of samples
+    integer,    intent(in) :: nsamp
+
+    ! Fractional standard deviation (0 to 4) and cumulative
+    ! distribution function (0 to 1)
+    real(jprb), intent(in)  :: fsd(nsamp), cdf(nsamp)
+
+    ! Sample from distribution
+    real(jprb), intent(out) :: val(:)
+
+    ! Mask
+    logical,    intent(in) :: mask(nsamp)
+
+    ! Loop index
+    integer    :: jsamp
+
+    ! Index to look-up table
+    integer    :: ifsd, icdf
+
+    ! Weights in bilinear interpolation
+    real(jprb) :: wfsd, wcdf
+
+    do jsamp = 1,nsamp
+      if (mask(jsamp)) then
+        ! Bilinear interpolation with bounds
+        wcdf = cdf(jsamp) * (this%ncdf-1) + 1.0_jprb
+        icdf = max(1, min(int(wcdf), this%ncdf-1))
+        wcdf = max(0.0_jprb, min(wcdf - icdf, 1.0_jprb))
+        
+        wfsd = (fsd(jsamp)-this%fsd1) * this%inv_fsd_interval + 1.0_jprb
+        ifsd = max(1, min(int(wfsd), this%nfsd-1))
+        wfsd = max(0.0_jprb, min(wfsd - ifsd, 1.0_jprb))
+        
+        val(jsamp)=(1.0_jprb-wcdf)*(1.0_jprb-wfsd) * this%val(icdf  ,ifsd)   &
+             &    +(1.0_jprb-wcdf)*          wfsd  * this%val(icdf  ,ifsd+1) &
+             &    +          wcdf *(1.0_jprb-wfsd) * this%val(icdf+1,ifsd)   &
+             &    +          wcdf *          wfsd  * this%val(icdf+1,ifsd+1)
+      else
+        val(jsamp) = 0.0_jprb
+      end if
+    end do
+  end subroutine sample_from_pdf_masked
+
+end module radiation_pdf_sampler
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_regions.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_regions.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_regions.F90	(revision 3908)
@@ -0,0 +1,202 @@
+! radiation_regions.F90 -- Properties of horizontal regions in Tripleclouds & SPARTACUS
+!
+! (C) Copyright 2016- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2017-07-14  R. Hogan  Incorporate gamma distribution option
+!   2018-10-06  R. Hogan  Merged from radiation_optical_depth_scaling.h and radiation_overlap.F90
+
+module radiation_regions
+
+  implicit none
+
+  public :: calc_region_properties
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Compute the optical depth scalings for the optically "thick" and
+  ! "thin" regions of a Tripleclouds representation of a sub-grid PDF
+  ! of cloud optical depth. Following Shonk and Hogan (2008), the 16th
+  ! percentile is used for the thin region, and the formulas estimate
+  ! this for both lognormal and gamma distributions. However, an
+  ! adjustment is needed for the gamma distribution at large
+  ! fractional standard deviations.
+  subroutine calc_region_properties(nlev, nreg, istartcol, iendcol, do_gamma, &
+       &  cloud_fraction, frac_std, reg_fracs, od_scaling, cloud_fraction_threshold)
+
+    use parkind1,     only : jprb
+    use yomhook,      only : lhook, dr_hook
+    use radiation_io, only : nulerr, radiation_abort
+
+    ! Minimum od_scaling in the case of a Gamma distribution
+    real(jprb), parameter :: MinGammaODScaling = 0.025_jprb
+
+    ! At large fractional standard deviations (FSDs), we cannot
+    ! capture the behaviour of a gamma distribution with two equally
+    ! weighted points; we need to weight the first ("lower") point
+    ! more.  The weight of the first point is normally 0.5, but for
+    ! FSDs between 1.5 and 3.725 it rises linearly to 0.9, and for
+    ! higher FSD it is capped at this value.  The weight of the second
+    ! point is one minus the first point.
+    real(jprb), parameter :: MinLowerFrac      = 0.5_jprb
+    real(jprb), parameter :: MaxLowerFrac      = 0.9_jprb
+    real(jprb), parameter :: FSDAtMinLowerFrac = 1.5_jprb
+    real(jprb), parameter :: FSDAtMaxLowerFrac = 3.725_jprb
+    ! Between FSDAtMinLowerFrac and FSDAtMaxLowerFrac,
+    ! LowerFrac=LowerFracFSDIntercept+FSD*LowerFracFSDGradient
+    real(jprb), parameter :: LowerFracFSDGradient &
+         &  = (MaxLowerFrac-MinLowerFrac) / (FSDAtMaxLowerFrac-FSDAtMinLowerFrac)
+    real(jprb), parameter :: LowerFracFSDIntercept &
+         &  = MinLowerFrac - FSDAtMinLowerFrac*LowerFracFSDGradient
+
+    ! Number of levels and regions
+    integer, intent(in) :: nlev, nreg
+
+    ! Range of columns to process
+    integer, intent(in) :: istartcol, iendcol
+
+    ! Do we do a lognormal or gamma distribution?
+    logical, intent(in) :: do_gamma
+
+    ! Cloud fraction, i.e. the fraction of the gridbox assigned to all
+    ! regions numbered 2 and above (region 1 is clear sky)
+    real(jprb), intent(in), dimension(:,:)  :: cloud_fraction ! (ncol,nlev)
+
+    ! Fractional standard deviation of in-cloud water content
+    real(jprb), intent(in), dimension(:,:)  :: frac_std       ! (ncol,nlev)
+
+    ! Fractional area coverage of each region
+    real(jprb), intent(out) :: reg_fracs(1:nreg,nlev,istartcol:iendcol)
+
+    ! Optical depth scaling for the cloudy regions
+    real(jprb), intent(out) :: od_scaling(2:nreg,nlev,istartcol:iendcol)
+
+    ! Regions smaller than this are ignored
+    real(jprb), intent(in), optional :: cloud_fraction_threshold
+
+    ! In case the user doesn't supply cloud_fraction_threshold we use
+    ! a default value
+    real(jprb) :: frac_threshold
+
+    ! Loop indices
+    integer :: jcol, jlev
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_region_properties:calc_region_properties',0,hook_handle)
+
+    if (present(cloud_fraction_threshold)) then
+      frac_threshold = cloud_fraction_threshold
+    else
+      frac_threshold = 1.0e-20_jprb
+    end if
+
+    if (nreg == 2) then
+      ! Only one clear-sky and one cloudy region: cloudy region is
+      ! homogeneous
+      reg_fracs(2,1:nlev,istartcol:iendcol)  = transpose(cloud_fraction(istartcol:iendcol,1:nlev))
+      reg_fracs(1,1:nlev,istartcol:iendcol)  = 1.0_jprb - reg_fracs(2,1:nlev,istartcol:iendcol)
+      od_scaling(2,1:nlev,istartcol:iendcol) = 1.0_jprb
+
+    else if (nreg == 3) then
+      ! Two cloudy regions with optical depth scaled by 1-x and
+      ! 1+x.
+      ! Simple version which fails when fractional_std >= 1:
+      !od_scaling(2) = 1.0_jprb-cloud%fractional_std(jcol,jlev)
+      ! According to Shonk and Hogan (2008), 1-FSD should correspond to
+      ! the 16th percentile. 
+      if (.not. do_gamma) then
+        ! If we treat the distribution as a lognormal such that the
+        ! equivalent Normal has a mean mu and standard deviation
+        ! sigma, then the 16th percentile of the lognormal is very
+        ! close to exp(mu-sigma).
+        do jcol = istartcol,iendcol
+          do jlev = 1,nlev
+            if (cloud_fraction(jcol,jlev) < frac_threshold) then
+              reg_fracs(1,jlev,jcol)       = 1.0_jprb
+              reg_fracs(2:3,jlev,jcol)  = 0.0_jprb
+              od_scaling(2:3,jlev,jcol) = 1.0_jprb
+            else
+              reg_fracs(1,jlev,jcol) = 1.0_jprb - cloud_fraction(jcol,jlev)
+              reg_fracs(2:3,jlev,jcol) = cloud_fraction(jcol,jlev)*0.5_jprb
+              od_scaling(2,jlev,jcol) &
+                   &  = exp(-sqrt(log(frac_std(jcol,jlev)**2+1))) &
+                   &  / sqrt(frac_std(jcol,jlev)**2+1)
+              od_scaling(3,jlev,jcol) = 2.0_jprb - od_scaling(2,jlev,jcol)
+            end if
+          end do
+        end do
+      else
+        ! If we treat the distribution as a gamma then the 16th
+        ! percentile is close to the following.  Note that because it
+        ! becomes vanishingly small for FSD >~ 2, we have a lower
+        ! limit of 1/40, and for higher FSDs reduce the fractional
+        ! cover of the denser region - see region_fractions routine
+        ! below
+        do jcol = istartcol,iendcol
+          do jlev = 1,nlev
+            if (cloud_fraction(jcol,jlev) < frac_threshold) then
+              reg_fracs(1,jlev,jcol)    = 1.0_jprb
+              reg_fracs(2:3,jlev,jcol)  = 0.0_jprb
+              od_scaling(2:3,jlev,jcol) = 1.0_jprb
+            else
+              ! Fraction of the clear-sky region
+              reg_fracs(1,jlev,jcol) = 1.0_jprb - cloud_fraction(jcol,jlev)
+!#define OLD_GAMMA_REGION_BEHAVIOUR 1
+#ifdef OLD_GAMMA_REGION_BEHAVIOUR
+              ! Use previous behaviour (ecRad version 1.1.5 and
+              ! earlier): cloudy fractions are the same and there is
+              ! no minimum optical depth scaling; this tends to lead
+              ! to an overprediction of the reflection from scenes
+              ! with a large fractional standard deviation of optical
+              ! depth.
+              ! Fraction and optical-depth scaling of the lower of the
+              ! two cloudy regions
+              reg_fracs(2,jlev,jcol) = cloud_fraction(jcol,jlev) * 0.5_jprb
+              od_scaling(2,jlev,jcol) = &
+                   &  exp(-frac_std(jcol,jlev)*(1.0_jprb + 0.5_jprb*frac_std(jcol,jlev) &
+                   &                     *(1.0_jprb+0.5_jprb*frac_std(jcol,jlev))))
+
+#else
+              ! Improved behaviour.
+              ! Fraction and optical-depth scaling of the lower of the
+              ! two cloudy regions
+              reg_fracs(2,jlev,jcol) = cloud_fraction(jcol,jlev) &
+                   &  * max(MinLowerFrac, min(MaxLowerFrac, &
+                   &  LowerFracFSDIntercept + frac_std(jcol,jlev)*LowerFracFSDGradient))
+              od_scaling(2,jlev,jcol) = MinGammaODScaling &
+                   &  + (1.0_jprb - MinGammaODScaling) &
+                   &    * exp(-frac_std(jcol,jlev)*(1.0_jprb + 0.5_jprb*frac_std(jcol,jlev) &
+                   &                     *(1.0_jprb+0.5_jprb*frac_std(jcol,jlev))))
+#endif
+              ! Fraction of the upper of the two cloudy regions
+              reg_fracs(3,jlev,jcol) = 1.0_jprb-reg_fracs(1,jlev,jcol)-reg_fracs(2,jlev,jcol)
+              ! Ensure conservation of the mean optical depth
+              od_scaling(3,jlev,jcol) = (cloud_fraction(jcol,jlev) &
+                   &  -reg_fracs(2,jlev,jcol)*od_scaling(2,jlev,jcol)) / reg_fracs(3,jlev,jcol)
+            end if
+          end do
+        end do
+      end if
+    else ! nreg > 3
+      write(nulerr,'(a)') '*** Error: only 2 or 3 regions may be specified'
+      call radiation_abort()
+    end if
+
+    if (lhook) call dr_hook('radiation_region_properties:calc_region_properties',1,hook_handle)
+
+  end subroutine calc_region_properties
+
+end module radiation_regions
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_save.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_save.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_save.F90	(revision 3908)
@@ -0,0 +1,1000 @@
+! radiation_save.F90 - Save data to NetCDF files
+!
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2017-04-22  R. Hogan  Adapt for new way of describing longwave properties
+!   2019-01-02  R. Hogan  Only save cloud properties if do_clouds==.true.
+
+module radiation_save
+
+  use parkind1, only : jprb
+
+  implicit none
+
+  ! Two available subroutines: save final fluxes and save intermediate
+  ! radiative properties
+  public :: save_fluxes, save_radiative_properties, save_inputs
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Save fluxes in "flux" to NetCDF file_name, plus pressure from the
+  ! thermodynamics object
+  subroutine save_fluxes(file_name, config, thermodynamics, flux, &
+       &                 iverbose, is_hdf5_file, experiment_name)
+
+    use yomhook,                  only : lhook, dr_hook
+
+    use easy_netcdf
+
+    use radiation_io,             only : nulout
+    use radiation_config,         only : config_type, IGasModelMonochromatic
+    use radiation_thermodynamics, only : thermodynamics_type
+    use radiation_flux,           only : flux_type
+
+    character(len=*),           intent(in) :: file_name
+    type(config_type),          intent(in) :: config
+    type(thermodynamics_type),  intent(in) :: thermodynamics
+    type(flux_type),            intent(in) :: flux
+    integer,          optional, intent(in) :: iverbose
+    logical,          optional, intent(in) :: is_hdf5_file
+    character(len=*), optional, intent(in) :: experiment_name
+
+    type(netcdf_file)                      :: out_file
+    integer                                :: ncol, n_lev_plus1
+    character(5), parameter                :: default_lw_units_str = 'W m-2'
+    character(5)                           :: lw_units_str
+    integer                                :: i_local_verbose
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_save:save_fluxes',0,hook_handle)
+    
+    if (present(iverbose)) then
+      i_local_verbose = iverbose
+    else
+      i_local_verbose = config%iverbose
+    end if
+
+    ! Work out array dimensions
+    if (config%do_sw) then
+      ncol = size(flux%sw_up,1)
+      n_lev_plus1 = size(flux%sw_up,2)
+    elseif (config%do_lw) then
+      ncol = size(flux%lw_up,1)
+      n_lev_plus1 = size(flux%lw_up,2)
+    else
+      if (i_local_verbose >= 1) then
+        write(nulout,'(a,a,a)') 'Warning: neither longwave nor shortwave computed so ', &
+             &                  file_name,' not written'
+      end if
+      return
+    end if
+
+    if (config%i_gas_model == IGasModelMonochromatic &
+         .and. config%mono_lw_wavelength > 0.0_jprb) then
+      lw_units_str = 'W m-3'
+    else
+      lw_units_str = default_lw_units_str
+    end if
+
+    ! Open the file
+    call out_file%create(trim(file_name), iverbose=i_local_verbose, is_hdf5_file=is_hdf5_file)
+
+    ! Variables stored internally with column varying fastest, but in
+    ! output file column varies most slowly so need to transpose
+    call out_file%transpose_matrices(.true.)
+
+    ! Spectral fluxes in memory are dimensioned (nband,ncol,nlev), but
+    ! are reoriented in the output file to be (nband,nlev,ncol), where
+    ! the convention here is first dimension varying fastest
+    call out_file%permute_3d_arrays( (/ 1, 3, 2 /) )
+
+    ! Define dimensions
+    call out_file%define_dimension("column", ncol)
+    call out_file%define_dimension("half_level", n_lev_plus1)
+
+    if (config%do_save_spectral_flux) then
+      if (config%do_lw) then
+        call out_file%define_dimension("band_lw", config%n_spec_lw)
+      end if
+      if (config%do_sw) then
+        call out_file%define_dimension("band_sw", config%n_spec_sw)
+      end if
+    else if (config%do_surface_sw_spectral_flux) then
+      if (config%do_sw) then
+        call out_file%define_dimension("band_sw", config%n_bands_sw)
+      end if
+    end if
+
+    if (config%do_lw .and. config%do_canopy_fluxes_lw) then
+      call out_file%define_dimension("canopy_band_lw", &
+           &  size(flux%lw_dn_surf_canopy, 1))
+    end if
+    if (config%do_sw .and. config%do_canopy_fluxes_sw) then
+      call out_file%define_dimension("canopy_band_sw", &
+           &  size(flux%sw_dn_diffuse_surf_canopy, 1))
+    end if
+
+    ! Put global attributes
+    call out_file%put_global_attributes( &
+         &   title_str="Radiative flux profiles from the ecRad offline radiation model", &
+         &   references_str="Hogan, R. J., and A. Bozzo, 2018: A flexible and efficient radiation " &
+         &   //"scheme for the ECMWF model. J. Adv. Modeling Earth Sys., 10, 1990–2008", &
+         &   source_str="ecRad offline radiation model")
+
+    ! Save "experiment" global attribute if present and not empty
+    if (present(experiment_name)) then
+      if (experiment_name /= " ") then
+        call out_file%put_global_attribute("experiment", experiment_name)
+      end if
+    end if
+
+    ! Define variables
+    call out_file%define_variable("pressure_hl", &
+         &   dim2_name="column", dim1_name="half_level", &
+         &   units_str="Pa", long_name="Pressure", &
+         &   standard_name="air_pressure")
+
+    if (config%do_lw) then
+      call out_file%define_variable("flux_up_lw", &
+           &   dim2_name="column", dim1_name="half_level", &
+           &   units_str=lw_units_str, long_name="Upwelling longwave flux", &
+           &   standard_name="upwelling_longwave_flux_in_air")
+      call out_file%define_variable("flux_dn_lw", &
+           &   dim2_name="column", dim1_name="half_level", &
+           &   units_str=lw_units_str, long_name="Downwelling longwave flux", &
+           &   standard_name="downwelling_longwave_flux_in_air")
+      if (config%do_clear) then
+        call out_file%define_variable("flux_up_lw_clear", &
+             &   dim2_name="column", dim1_name="half_level", &
+             &   units_str=lw_units_str, &
+             &   long_name="Upwelling clear-sky longwave flux")
+        call out_file%define_variable("flux_dn_lw_clear", &
+             &   dim2_name="column", dim1_name="half_level", &
+             &   units_str=lw_units_str, &
+             &   long_name="Downwelling clear-sky longwave flux")
+      end if
+
+      if (config%do_lw_derivatives) then
+        call out_file%define_variable("lw_derivative", &
+             &  dim2_name="column", dim1_name="half_level", &
+             &  units_str="1", &
+             &  long_name="Derivative of upwelling LW flux w.r.t. surface value")
+      end if
+
+      if (config%do_save_spectral_flux) then
+        call out_file%define_variable("spectral_flux_up_lw", &
+             &   dim3_name="column", dim2_name="half_level", &
+             &   dim1_name="band_lw", units_str=lw_units_str, &
+             &   long_name="Spectral upwelling longwave flux")
+        call out_file%define_variable("spectral_flux_dn_lw", &
+             &   dim3_name="column", dim2_name="half_level", &
+             &   dim1_name="band_lw", units_str=lw_units_str, &
+             &   long_name="Spectral downwelling longwave flux")
+        if (config%do_clear) then
+          call out_file%define_variable("spectral_flux_up_lw_clear", &
+               &   dim3_name="column", dim2_name="half_level", &
+               &   dim1_name="band_lw", units_str=lw_units_str, &
+               &   long_name="Spectral upwelling clear-sky longwave flux")
+          call out_file%define_variable("spectral_flux_dn_lw_clear", &
+               &   dim3_name="column", dim2_name="half_level", &
+               &   dim1_name="band_lw", units_str=lw_units_str, &
+               &   long_name="Spectral downwelling clear-sky longwave flux")
+        end if
+      end if
+   
+      if (config%do_canopy_fluxes_lw) then
+        call out_file%define_variable("canopy_flux_dn_lw_surf", &
+             &   dim2_name="column", dim1_name="canopy_band_lw", units_str=lw_units_str, &
+             &   long_name="Surface downwelling longwave flux in canopy bands")
+      end if
+
+    end if
+
+    if (config%do_sw) then
+      call out_file%define_variable("flux_up_sw", &
+           &   dim2_name="column", dim1_name="half_level", &
+           &   units_str="W m-2", long_name="Upwelling shortwave flux", &
+           &   standard_name="upwelling_shortwave_flux_in_air")
+      call out_file%define_variable("flux_dn_sw", &
+           &   dim2_name="column", dim1_name="half_level", &
+           &   units_str="W m-2", long_name="Downwelling shortwave flux", &
+           &   standard_name="downwelling_shortwave_flux_in_air")
+      if (config%do_sw_direct) then
+        call out_file%define_variable("flux_dn_direct_sw", &
+             &   dim2_name="column", dim1_name="half_level", &
+             &   units_str="W m-2", &
+             &   long_name="Downwelling direct shortwave flux")
+      end if
+      if (config%do_clear) then
+        call out_file%define_variable("flux_up_sw_clear", &
+             &   dim2_name="column", dim1_name="half_level", &
+             &   units_str="W m-2", &
+             &   long_name="Upwelling clear-sky shortwave flux")
+        call out_file%define_variable("flux_dn_sw_clear", &
+             &   dim2_name="column", dim1_name="half_level", &
+             &   units_str="W m-2", &
+             &   long_name="Downwelling clear-sky shortwave flux")
+        if (config%do_sw_direct) then
+          call out_file%define_variable("flux_dn_direct_sw_clear", &
+               &   dim2_name="column", dim1_name="half_level", &
+               &   units_str="W m-2", &
+               &   long_name="Downwelling clear-sky direct shortwave flux")
+        end if
+      end if
+
+      if (config%do_save_spectral_flux) then
+        call out_file%define_variable("spectral_flux_up_sw", &
+             &   dim3_name="column", dim2_name="half_level", &
+             &   dim1_name="band_sw", units_str="W m-2", &
+             &   long_name="Spectral upwelling shortwave flux")
+        call out_file%define_variable("spectral_flux_dn_sw", &
+             &   dim3_name="column", dim2_name="half_level", &
+             &   dim1_name="band_sw", units_str="W m-2", &
+             &   long_name="Spectral downwelling shortwave flux")
+        if (config%do_sw_direct) then
+          call out_file%define_variable("spectral_flux_dn_direct_sw", &
+               &   dim3_name="column", dim2_name="half_level", &
+               &   dim1_name="band_sw", units_str="W m-2", &
+               &   long_name="Spectral downwelling direct shortwave flux")
+        end if
+        if (config%do_clear) then
+          call out_file%define_variable("spectral_flux_up_sw_clear", &
+               &   dim3_name="column", dim2_name="half_level", &
+               &   dim1_name="band_sw", units_str="W m-2", &
+               &   long_name="Spectral upwelling clear-sky shortwave flux")
+          call out_file%define_variable("spectral_flux_dn_sw_clear", &
+               &   dim3_name="column", dim2_name="half_level", &
+               &   dim1_name="band_sw", units_str="W m-2", &
+               &   long_name="Spectral downwelling clear-sky shortwave flux")
+          if (config%do_sw_direct) then
+            call out_file%define_variable("spectral_flux_dn_direct_sw_clear", &
+                 &   dim3_name="column", dim2_name="half_level", &
+                 &   dim1_name="band_sw", units_str="W m-2", &
+                 &   long_name="Spectral downwelling clear-sky direct shortwave flux")
+          end if
+        end if
+      else if (config%do_surface_sw_spectral_flux) then
+        call out_file%define_variable("spectral_flux_dn_sw_surf", &
+             &   dim2_name="column", dim1_name="band_sw", units_str="W m-2", &
+             &   long_name="Spectral downwelling shortwave flux at surface")
+        call out_file%define_variable("spectral_flux_dn_direct_sw_surf", &
+             &   dim2_name="column", dim1_name="band_sw", units_str="W m-2", &
+             &   long_name="Spectral downwelling direct shortwave flux at surface")
+        if (config%do_clear) then
+          call out_file%define_variable("spectral_flux_dn_sw_surf_clear", &
+               &   dim2_name="column", dim1_name="band_sw", units_str="W m-2", &
+               &   long_name="Spectral downwelling clear-sky shortwave flux at surface")
+          call out_file%define_variable("spectral_flux_dn_direct_sw_surf_clear", &
+               &   dim2_name="column", dim1_name="band_sw", units_str="W m-2", &
+               &   long_name="Spectral downwelling clear-sky direct shortwave flux at surface")
+        end if
+      end if
+   
+      if (config%do_canopy_fluxes_sw) then
+        call out_file%define_variable("canopy_flux_dn_diffuse_sw_surf", &
+             &   dim2_name="column", dim1_name="canopy_band_sw", units_str="W m-2", &
+             &   long_name="Surface downwelling diffuse shortwave flux in canopy bands")
+        call out_file%define_variable("canopy_flux_dn_direct_sw_surf", &
+             &   dim2_name="column", dim1_name="canopy_band_sw", units_str="W m-2", &
+             &   long_name="Surface downwelling direct shortwave flux in canopy bands")
+      end if
+
+    end if
+   
+    if (config%do_lw .and. config%do_clouds) then
+      call out_file%define_variable("cloud_cover_lw", &
+           &  dim1_name="column", units_str="1", &
+           &  long_name="Total cloud cover diagnosed by longwave solver", &
+           &  standard_name="cloud_area_fraction")
+    end if
+    if (config%do_sw .and. config%do_clouds) then
+      call out_file%define_variable("cloud_cover_sw", &
+           &  dim1_name="column", units_str="1", &
+           &  long_name="Total cloud cover diagnosed by shortwave solver", &
+           &  standard_name="cloud_area_fraction")
+    end if
+
+    ! Write variables
+
+    call out_file%put("pressure_hl", thermodynamics%pressure_hl)
+
+    if (config%do_lw) then
+      call out_file%put("flux_up_lw", flux%lw_up)
+      call out_file%put("flux_dn_lw", flux%lw_dn)
+      if (config%do_clear) then
+        call out_file%put("flux_up_lw_clear", flux%lw_up_clear)
+        call out_file%put("flux_dn_lw_clear", flux%lw_dn_clear)
+      end if
+
+      if (config%do_lw_derivatives) then
+        call out_file%put("lw_derivative", flux%lw_derivatives)
+      end if
+
+      if (config%do_save_spectral_flux) then
+        call out_file%put("spectral_flux_up_lw", flux%lw_up_band)
+        call out_file%put("spectral_flux_dn_lw", flux%lw_dn_band)
+        if (config%do_clear) then
+          call out_file%put("spectral_flux_up_lw_clear", flux%lw_up_clear_band)
+          call out_file%put("spectral_flux_dn_lw_clear", flux%lw_dn_clear_band)
+        end if
+      end if
+
+      if (config%do_canopy_fluxes_lw) then
+        call out_file%put("canopy_flux_dn_lw_surf", flux%lw_dn_surf_canopy, &
+             &            do_transp = .false.)
+      end if
+
+    end if
+
+    if (config%do_sw) then
+      call out_file%put("flux_up_sw", flux%sw_up)
+      call out_file%put("flux_dn_sw", flux%sw_dn)
+      if (config%do_sw_direct) then
+        call out_file%put("flux_dn_direct_sw", flux%sw_dn_direct)
+      end if
+      if (config%do_clear) then
+        call out_file%put("flux_up_sw_clear", flux%sw_up_clear)
+        call out_file%put("flux_dn_sw_clear", flux%sw_dn_clear)
+        if (config%do_sw_direct) then
+          call out_file%put("flux_dn_direct_sw_clear", flux%sw_dn_direct_clear)
+        end if
+      end if
+
+      if (config%do_save_spectral_flux) then
+        call out_file%put("spectral_flux_up_sw", flux%sw_up_band)
+        call out_file%put("spectral_flux_dn_sw", flux%sw_dn_band)
+        if (config%do_sw_direct) then
+          call out_file%put("spectral_flux_dn_direct_sw", &
+               &   flux%sw_dn_direct_band)
+        end if
+        if (config%do_clear) then
+          call out_file%put("spectral_flux_up_sw_clear", flux%sw_up_clear_band)
+          call out_file%put("spectral_flux_dn_sw_clear", flux%sw_dn_clear_band)
+          if (config%do_sw_direct) then
+            call out_file%put("spectral_flux_dn_direct_sw_clear", &
+                 &   flux%sw_dn_direct_clear_band)
+          end if
+        end if
+      else if (config%do_surface_sw_spectral_flux) then
+        call out_file%put("spectral_flux_dn_sw_surf", flux%sw_dn_surf_band, &
+               &   do_transp=.false.)
+        call out_file%put("spectral_flux_dn_direct_sw_surf", flux%sw_dn_direct_surf_band, &
+               &   do_transp=.false.)
+        if (config%do_clear) then
+          call out_file%put("spectral_flux_dn_sw_surf_clear", flux%sw_dn_surf_clear_band, &
+               &   do_transp=.false.)
+          call out_file%put("spectral_flux_dn_direct_sw_surf_clear", &
+               &            flux%sw_dn_direct_surf_clear_band, do_transp=.false.)
+        end if
+      end if
+
+      if (config%do_canopy_fluxes_sw) then
+        call out_file%put("canopy_flux_dn_diffuse_sw_surf", flux%sw_dn_diffuse_surf_canopy, &
+             &            do_transp = .false.)
+        call out_file%put("canopy_flux_dn_direct_sw_surf",  flux%sw_dn_direct_surf_canopy, &
+             &            do_transp = .false.)
+      end if
+
+    end if
+
+    if (config%do_lw .and. config%do_clouds) then
+      call out_file%put("cloud_cover_lw", flux%cloud_cover_lw)
+    end if
+    if (config%do_sw .and. config%do_clouds) then
+      call out_file%put("cloud_cover_sw", flux%cloud_cover_sw)
+    end if
+
+    ! Close file
+    call out_file%close()
+
+    if (lhook) call dr_hook('radiation_save:save_fluxes',1,hook_handle)
+
+  end subroutine save_fluxes
+  
+
+  !---------------------------------------------------------------------
+  ! Save intermediate radiative properties, specifically the
+  ! scattering and absorption properties at each g-point/band
+  subroutine save_radiative_properties(file_name, nlev, &
+       &  istartcol, iendcol, &
+       &  config, single_level, thermodynamics, cloud, &
+       &  planck_hl, lw_emission, lw_albedo, &
+       &  sw_albedo_direct, sw_albedo_diffuse, &
+       &  incoming_sw, &
+       &  od_lw, ssa_lw, g_lw, &
+       &  od_sw, ssa_sw, g_sw, &
+       &  od_lw_cloud, ssa_lw_cloud, g_lw_cloud, &
+       &  od_sw_cloud, ssa_sw_cloud, g_sw_cloud)
+
+    use radiation_config,        only : config_type
+    use radiation_single_level,  only : single_level_type
+    use radiation_thermodynamics,only : thermodynamics_type
+    use radiation_cloud,         only : cloud_type
+    use easy_netcdf
+
+    character(len=*),         intent(in) :: file_name
+    type(config_type),        intent(in) :: config
+    type(single_level_type),  intent(in) :: single_level
+    type(thermodynamics_type),intent(in) :: thermodynamics
+    type(cloud_type),         intent(in) :: cloud
+
+    integer, intent(in) :: nlev, istartcol, iendcol
+
+    ! Input variables, as defined in radiation_interface.F90
+
+    ! Layer optical depth, single scattering albedo and asymmetry factor of
+    ! gases and aerosols at each shortwave g-point
+    real(jprb), intent(in), dimension(config%n_g_sw,nlev,istartcol:iendcol) :: od_sw, ssa_sw, g_sw
+
+   ! Layer optical depth, single scattering albedo and asymmetry factor of
+    ! hydrometeors in each shortwave band
+    real(jprb), intent(in), dimension(config%n_bands_sw,nlev,istartcol:iendcol)   :: &
+         &  od_sw_cloud, ssa_sw_cloud, g_sw_cloud
+
+    ! Direct and diffuse surface albedo, and the incoming shortwave
+    ! flux into a plane perpendicular to the incoming radiation at
+    ! top-of-atmosphere in each of the shortwave g-points
+    real(jprb), intent(in), dimension(config%n_g_sw,istartcol:iendcol) &
+         &  :: sw_albedo_direct, sw_albedo_diffuse, incoming_sw
+
+    ! Layer optical depth, single scattering albedo and asymmetry factor of
+    ! gases and aerosols at each longwave g-point, where the latter
+    ! two variables are only defined if aerosol longwave scattering is
+    ! enabled (otherwise both are treated as zero).
+    real(jprb), intent(in), dimension(config%n_g_lw,nlev,istartcol:iendcol) :: od_lw
+    real(jprb), intent(in), dimension(config%n_g_lw_if_scattering,nlev,istartcol:iendcol) :: &
+         &  ssa_lw, g_lw
+
+    ! Layer optical depth, single scattering albedo and asymmetry factor of
+    ! hydrometeors in each longwave band, where the latter two
+    ! variables are only defined if hydrometeor longwave scattering is
+    ! enabled (otherwise both are treated as zero).
+    real(jprb), intent(in), dimension(config%n_bands_lw,nlev,istartcol:iendcol) :: od_lw_cloud
+    real(jprb), intent(in), dimension(config%n_bands_lw_if_scattering,nlev,istartcol:iendcol) :: &
+         &  ssa_lw_cloud, g_lw_cloud
+
+    ! The Planck function (emitted flux from a black body) at half
+    ! levels and at the surface at each longwave g-point
+    real(jprb), intent(in), dimension(config%n_g_lw,nlev+1,istartcol:iendcol) :: planck_hl
+
+    ! Emission (Planck*emissivity) and albedo (1-emissivity) at the
+    ! surface at each longwave g-point
+    real(jprb), dimension(config%n_g_lw, istartcol:iendcol) :: lw_emission, lw_albedo
+
+    integer :: n_col_local ! Number of columns from istartcol to iendcol
+
+    ! Object for output NetCDF file
+    type(netcdf_file) :: out_file
+
+    n_col_local = iendcol + 1 - istartcol
+
+    ! Alas the NetCDF library is not thread-safe for writing, so we
+    ! must write radiative-property files serially
+
+    !$OMP CRITICAL
+
+    ! Open the file
+    call out_file%create(trim(file_name), iverbose=config%iverbose)
+
+    ! Configure matrix and 3D-array orientation
+    call out_file%transpose_matrices(.true.)
+
+    ! Sometimes the Planck function values are very large or small
+    ! even if the fluxes are within a manageable range
+    call out_file%double_precision(.true.)
+
+    ! Define dimensions
+    !    call out_file%define_dimension("column", n_col_local)
+    call out_file%define_dimension("column", 0) ! "Unlimited" dimension
+    call out_file%define_dimension("level", nlev)
+    call out_file%define_dimension("half_level", nlev+1)
+    if (config%do_clouds) then
+      call out_file%define_dimension("level_interface", nlev-1)
+    end if
+
+    if (config%do_lw) then
+      call out_file%define_dimension("gpoint_lw", config%n_g_lw) 
+      if (config%do_clouds) then
+        call out_file%define_dimension("band_lw", config%n_bands_lw)
+      end if
+    end if
+    if (config%do_sw) then
+      call out_file%define_dimension("gpoint_sw", config%n_g_sw) 
+      if (config%do_clouds) then
+        call out_file%define_dimension("band_sw", config%n_bands_sw)
+      end if
+    end if
+
+    ! Put global attributes
+    call out_file%put_global_attributes( &
+         &   title_str="Spectral radiative properties from the ecRad offline radiation model", &
+         &   references_str="Hogan, R. J., and A. Bozzo, 2018: A flexible and efficient radiation " &
+         &   //"scheme for the ECMWF model. J. Adv. Modeling Earth Sys., 10, 1990–2008", &
+         &   source_str="ecRad offline radiation model")
+
+    ! Define variables
+    call out_file%define_variable("pressure_hl", &
+         &  dim2_name="column", dim1_name="half_level", &
+         &  units_str="Pa", long_name="Pressure on half-levels")
+
+    if (allocated(thermodynamics%h2o_sat_liq) .and. config%use_aerosols) then
+      call out_file%define_variable("q_sat_liquid", &
+           &  dim2_name="column", dim1_name="level", &
+           &  units_str="kg kg-1", long_name="Specific humidity at liquid saturation")
+    end if
+
+    if (config%do_sw) then
+      call out_file%define_variable("cos_solar_zenith_angle", &
+           &  dim1_name="column", units_str="1", &
+           &  long_name="Cosine of the solar zenith angle")
+    end if
+
+    if (config%do_clouds) then
+      call out_file%define_variable("cloud_fraction", &
+           &  dim2_name="column", dim1_name="level", &
+           &  units_str="1", long_name="Cloud fraction")
+      call out_file%define_variable("overlap_param", &
+           &  dim2_name="column", dim1_name="level_interface", &
+           &  units_str="1", long_name="Cloud overlap parameter")
+    end if
+
+    if (config%do_lw) then
+      call out_file%define_variable("planck_hl", &
+           &  dim3_name="column", dim2_name="half_level", dim1_name="gpoint_lw", &
+           &  units_str="W m-2", long_name="Planck function on half-levels")
+      call out_file%define_variable("lw_emission", &
+           &  dim2_name="column", dim1_name="gpoint_lw", &
+           &  units_str="W m-2", long_name="Longwave surface emission")
+      call out_file%define_variable("lw_emissivity", &
+           &  dim2_name="column", dim1_name="gpoint_lw", &
+           &  units_str="1", long_name="Surface longwave emissivity")
+
+      call out_file%define_variable("od_lw", &
+           &  dim3_name="column", dim2_name="level", dim1_name="gpoint_lw", &
+           &  units_str="1", long_name="Clear-sky longwave optical depth")
+      if (config%do_lw_aerosol_scattering) then
+        call out_file%define_variable("ssa_lw", &
+           &  dim3_name="column", dim2_name="level", dim1_name="gpoint_lw", &
+           &  units_str="1", long_name="Clear-sky longwave single scattering albedo")
+        call out_file%define_variable("asymmetry_lw", &
+           &  dim3_name="column", dim2_name="level", dim1_name="gpoint_lw", &
+           &  units_str="1", long_name="Clear-sky longwave asymmetry factor")
+      end if
+
+      if (config%do_clouds) then
+        call out_file%define_variable("od_lw_cloud", &
+             &  dim3_name="column", dim2_name="level", dim1_name="band_lw", &
+             &  units_str="1", long_name="In-cloud longwave optical depth")
+        if (config%do_lw_cloud_scattering) then
+          call out_file%define_variable("ssa_lw_cloud", &
+               &  dim3_name="column", dim2_name="level", dim1_name="band_lw", &
+               &  units_str="1", long_name="Cloud longwave single scattering albedo")
+          call out_file%define_variable("asymmetry_lw_cloud", &
+               &  dim3_name="column", dim2_name="level", dim1_name="band_lw", &
+               &  units_str="1", long_name="Cloud longwave asymmetry factor")
+        end if
+      end if ! do_clouds
+    end if ! do_lw
+    
+    if (config%do_sw) then
+      call out_file%define_variable("incoming_sw", &
+           &  dim2_name="column", dim1_name="gpoint_sw", &
+           &  units_str="W m-2", long_name="Incoming shortwave flux at top-of-atmosphere in direction of sun")
+
+      call out_file%define_variable("sw_albedo", &
+           &  dim2_name="column", dim1_name="gpoint_sw", &
+           &  units_str="1", long_name="Surface shortwave albedo to diffuse radiation")
+      call out_file%define_variable("sw_albedo_direct", &
+           &  dim2_name="column", dim1_name="gpoint_sw", &
+           &  units_str="1", long_name="Surface shortwave albedo to direct radiation")
+
+      call out_file%define_variable("od_sw", &
+           &  dim3_name="column", dim2_name="level", dim1_name="gpoint_sw", &
+           &  units_str="1", long_name="Clear-sky shortwave optical depth")
+      call out_file%define_variable("ssa_sw", &
+           &  dim3_name="column", dim2_name="level", dim1_name="gpoint_sw", &
+           &  units_str="1", long_name="Clear-sky shortwave single scattering albedo")
+      call out_file%define_variable("asymmetry_sw", &
+           &  dim3_name="column", dim2_name="level", dim1_name="gpoint_sw", &
+           &  units_str="1", long_name="Clear-sky shortwave asymmetry factor")
+
+      if (config%do_clouds) then
+        call out_file%define_variable("od_sw_cloud", &
+             &  dim3_name="column", dim2_name="level", dim1_name="band_sw", &
+             &  units_str="1", long_name="In-cloud shortwave optical depth")
+        call out_file%define_variable("ssa_sw_cloud", &
+             &  dim3_name="column", dim2_name="level", dim1_name="band_sw", &
+             &  units_str="1", long_name="Cloud shortwave single scattering albedo")
+        call out_file%define_variable("asymmetry_sw_cloud", &
+             &  dim3_name="column", dim2_name="level", dim1_name="band_sw", &
+             &  units_str="1", long_name="Cloud shortwave asymmetry factor")
+      end if
+    end if
+   
+    if (config%do_clouds) then
+      if (allocated(cloud%fractional_std)) then
+        call out_file%define_variable("fractional_std", &
+             &  dim2_name="column", dim1_name="level", units_str="1", &
+             &  long_name="Fractional standard deviation of cloud optical depth")
+      end if
+      if (allocated(cloud%inv_cloud_effective_size)) then
+        call out_file%define_variable("inv_cloud_effective_size", &
+             &  dim2_name="column", dim1_name="level", units_str="m-1", &
+             &  long_name="Inverse of cloud effective horizontal size")
+      end if
+      if (allocated(cloud%inv_inhom_effective_size)) then
+        call out_file%define_variable("inv_inhom_effective_size", &
+             &  dim2_name="column", dim1_name="level", units_str="m-1", &
+             &  long_name="Inverse of cloud inhomogeneity effective horizontal size")
+      end if
+   end if
+
+    ! Write variables
+    call out_file%put("pressure_hl", thermodynamics%pressure_hl(istartcol:iendcol,:))
+
+    if (allocated(thermodynamics%h2o_sat_liq) .and. config%use_aerosols) then
+      call out_file%put("q_sat_liquid", thermodynamics%h2o_sat_liq(istartcol:iendcol,:))
+    end if
+
+    if (config%do_clouds) then
+      call out_file%put("cloud_fraction", cloud%fraction(istartcol:iendcol,:))
+      call out_file%put("overlap_param", cloud%overlap_param(istartcol:iendcol,:))
+    end if
+
+    if (config%do_sw) then
+      call out_file%put("cos_solar_zenith_angle", single_level%cos_sza(istartcol:iendcol))
+      call out_file%put("sw_albedo", sw_albedo_diffuse, do_transp=.false.)
+      call out_file%put("sw_albedo_direct", sw_albedo_direct, do_transp=.false.)
+    end if
+
+    if (config%do_lw) then
+      call out_file%put("lw_emissivity", 1.0_jprb - lw_albedo, do_transp=.false.)
+      call out_file%put("planck_hl", planck_hl)
+      call out_file%put("lw_emission", lw_emission, do_transp=.false.)
+      
+      call out_file%put("od_lw", od_lw)
+      if (config%do_lw_aerosol_scattering) then
+        call out_file%put("ssa_lw", ssa_lw)
+        call out_file%put("asymmetry_lw", g_lw)
+      end if
+      
+      if (config%do_clouds) then
+        call out_file%put("od_lw_cloud", od_lw_cloud)
+        if (config%do_lw_cloud_scattering) then
+          call out_file%put("ssa_lw_cloud", ssa_lw_cloud)
+          call out_file%put("asymmetry_lw_cloud", g_lw_cloud)
+        end if
+      end if
+    end if
+    
+    if (config%do_sw) then
+      call out_file%put("incoming_sw", incoming_sw, do_transp=.false.)
+      
+      call out_file%put("od_sw", od_sw)
+      call out_file%put("ssa_sw", ssa_sw)
+      call out_file%put("asymmetry_sw", g_sw)
+      
+      if (config%do_clouds) then
+        call out_file%put("od_sw_cloud", od_sw_cloud)
+        call out_file%put("ssa_sw_cloud", ssa_sw_cloud)
+        call out_file%put("asymmetry_sw_cloud", g_sw_cloud)
+      end if
+    end if
+    
+    if (config%do_clouds) then
+      if (allocated(cloud%fractional_std)) then
+        call out_file%put("fractional_std", cloud%fractional_std(istartcol:iendcol,:))
+      end if
+      if (allocated(cloud%inv_cloud_effective_size)) then
+        call out_file%put("inv_cloud_effective_size", cloud%inv_cloud_effective_size(istartcol:iendcol,:))
+      end if
+      if (allocated(cloud%inv_inhom_effective_size)) then
+        call out_file%put("inv_inhom_effective_size", cloud%inv_inhom_effective_size(istartcol:iendcol,:))
+      end if
+    end if
+
+    ! Close the file
+    call out_file%close()
+
+    !$OMP END CRITICAL
+    
+  end subroutine save_radiative_properties
+  
+
+  !---------------------------------------------------------------------
+  ! Save inputs to the radiation scheme
+  subroutine save_inputs(file_name, config, single_level, thermodynamics, &
+       &                 gas, cloud, aerosol, lat, lon, iverbose)
+    use yomhook,                  only : lhook, dr_hook
+
+    use radiation_config,         only : config_type
+    use radiation_single_level,   only : single_level_type
+    use radiation_thermodynamics, only : thermodynamics_type
+    use radiation_gas
+    use radiation_cloud,          only : cloud_type
+    use radiation_aerosol,        only : aerosol_type
+    use easy_netcdf
+
+    character(len=*),             intent(in)   :: file_name
+    type(config_type),            intent(in)   :: config
+    type(single_level_type),      intent(in)   :: single_level
+    type(thermodynamics_type),    intent(in)   :: thermodynamics
+    type(gas_type),               intent(inout):: gas
+    type(cloud_type),             intent(in)   :: cloud
+    type(aerosol_type), optional, intent(in)   :: aerosol
+    real(jprb),         optional, intent(in)   :: lat(:), lon(:)
+    integer,            optional, intent(in)   :: iverbose
+
+    real(jprb), allocatable :: mixing_ratio(:,:)
+    real(jprb), allocatable :: aerosol_mmr(:,:,:)
+    real(jprb), allocatable :: seed(:)
+    integer       :: i_local_verbose
+    integer       :: ncol, nlev
+    integer       :: jgas
+    character(32) :: var_name, long_name
+
+    ! Object for output NetCDF file
+    type(netcdf_file) :: out_file
+
+    logical :: do_aerosol
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_save:save_inputs',0,hook_handle)
+
+    if (present(iverbose)) then
+      i_local_verbose = iverbose
+    else
+      i_local_verbose = config%iverbose
+    end if
+
+    ! Work out array dimensions
+    ncol = size(thermodynamics%pressure_hl,1)
+    nlev = size(thermodynamics%pressure_hl,2)
+    nlev = nlev - 1
+    
+    do_aerosol = config%use_aerosols .and. present(aerosol)
+
+    ! Open the file
+    call out_file%create(trim(file_name), iverbose=i_local_verbose)
+
+    ! Variables stored internally with column varying fastest, but in
+    ! output file column varies most slowly so need to transpose
+    call out_file%transpose_matrices(.true.)
+
+    ! In the case of aerosols we convert dimensions (ncol,nlev,ntype)
+    ! in memory to (nlev,ntype,ncol) in file (in both cases the first
+    ! dimension varying fastest).
+    call out_file%permute_3d_arrays( (/ 2, 3, 1 /) ) ! For aerosols
+
+    ! Define dimensions
+    call out_file%define_dimension("column",     ncol)
+    call out_file%define_dimension("level",      nlev)
+    call out_file%define_dimension("half_level", nlev+1)
+    if (allocated(cloud%overlap_param)) then
+      call out_file%define_dimension("level_interface", nlev-1)
+    end if
+    call out_file%define_dimension("sw_albedo_band", &
+         &                         size(single_level%sw_albedo,2))
+    call out_file%define_dimension("lw_emissivity_band", &
+         &                         size(single_level%lw_emissivity,2))
+
+    if (do_aerosol) then
+      call out_file%define_dimension("aerosol_type", size(aerosol%mixing_ratio,3))
+    end if
+
+    ! Put global attributes
+    call out_file%put_global_attributes( &
+         &   title_str="Input profiles to the ecRad offline radiation model", &
+         &   references_str="Hogan, R. J., and A. Bozzo, 2018: A flexible and efficient radiation " &
+         &   //"scheme for the ECMWF model. J. Adv. Modeling Earth Sys., 10, 1990–2008", &
+         &   source_str="ecRad offline radiation model")
+
+    ! Define single-level variables
+    call out_file%define_variable("solar_irradiance", &
+         &   units_str="W m-2", long_name="Solar irradiance at Earth's orbit")
+    if (present(lat)) then
+      call out_file%define_variable("lat", &
+           &   dim1_name="column", units_str="degrees_north", long_name="Latitude")
+    end if
+    if (present(lon)) then
+      call out_file%define_variable("lon", &
+           &   dim1_name="column", units_str="degrees_east", long_name="Longitude")
+    end if
+    call out_file%define_variable("skin_temperature", &
+         &   dim1_name="column", units_str="K", long_name="Skin_temperature")
+    if (config%do_sw) then
+      call out_file%define_variable("cos_solar_zenith_angle", &
+           &   dim1_name="column", units_str="1", &
+           &   long_name="Cosine of the solar zenith angle")
+    end if
+
+    if (allocated(single_level%sw_albedo_direct)) then
+      call out_file%define_variable("sw_albedo", &
+           &   dim2_name="column", dim1_name="sw_albedo_band", &
+           &   units_str="1", long_name="Shortwave surface albedo to diffuse radiation")
+            call out_file%define_variable("sw_albedo_direct", &
+           &   dim2_name="column", dim1_name="sw_albedo_band", &
+           &   units_str="1", long_name="Shortwave surface albedo to direct radiation")
+    else
+      call out_file%define_variable("sw_albedo", &
+           &   dim2_name="column", dim1_name="sw_albedo_band", &
+           &   units_str="1", long_name="Shortwave surface albedo")
+      
+    end if
+    call out_file%define_variable("lw_emissivity", &
+         &   dim2_name="column", dim1_name="lw_emissivity_band", &
+         &   units_str="1", long_name="Longwave surface emissivity")
+
+    if (allocated(single_level%iseed)) then
+      call out_file%define_variable("iseed", &
+           &   dim1_name="column", units_str="1", is_double=.true., &
+           &   long_name="Seed for random-number generator")
+    end if
+
+    ! Define thermodynamic variables on half levels
+    call out_file%define_variable("pressure_hl", &
+         &   dim2_name="column", dim1_name="half_level", &
+         &   units_str="Pa", long_name="Pressure")
+    call out_file%define_variable("temperature_hl", &
+         &   dim2_name="column", dim1_name="half_level", &
+         &   units_str="K", long_name="Temperature")
+
+    ! Define gas mixing ratios on full levels
+    call out_file%define_variable("q", &
+         &   dim2_name="column", dim1_name="level", &
+         &   units_str="1", long_name="Specific humidity")
+    call out_file%define_variable("o3_mmr", &
+         &   dim2_name="column", dim1_name="level", &
+         &   units_str="1", long_name="Ozone mass mixing ratio")
+    do jgas = 1,NMaxGases
+      if (gas%is_present(jgas) .and. jgas /= IH2O .and. jgas /= IO3) then
+        write(var_name,'(a,a)') trim(GasLowerCaseName(jgas)), '_vmr'
+        write(long_name,'(a,a)') trim(GasName(jgas)), ' volume mixing ratio'
+        call out_file%define_variable(trim(var_name), &
+             &   dim2_name="column", dim1_name="level", &
+             &   units_str="1", long_name=trim(long_name))
+      end if
+    end do
+
+    if (config%do_clouds) then
+      ! Define cloud variables on full levels
+      call out_file%define_variable("cloud_fraction", &
+           &   dim2_name="column", dim1_name="level", &
+           &   units_str="1", long_name="Cloud fraction")
+      call out_file%define_variable("q_liquid", &
+           &   dim2_name="column", dim1_name="level", &
+           &   units_str="1", long_name="Gridbox-mean liquid water mixing ratio")
+      call out_file%define_variable("q_ice", &
+           &   dim2_name="column", dim1_name="level", &
+           &   units_str="1", long_name="Gridbox-mean ice water mixing ratio")
+      call out_file%define_variable("re_liquid", &
+           &   dim2_name="column", dim1_name="level", &
+           &   units_str="m", long_name="Ice effective radius")
+      if (allocated(cloud%re_ice)) then
+        call out_file%define_variable("re_ice", &
+             &   dim2_name="column", dim1_name="level", &
+             &   units_str="m", long_name="Ice effective radius")
+      end if
+      if (allocated(cloud%overlap_param)) then
+        call out_file%define_variable("overlap_param", &
+             &  dim2_name="column", dim1_name="level_interface", &
+             &  units_str="1", long_name="Cloud overlap parameter")
+      end if
+      if (allocated(cloud%fractional_std)) then
+        call out_file%define_variable("fractional_std", &
+             &  dim2_name="column", dim1_name="level", units_str="1", &
+             &  long_name="Fractional standard deviation of cloud optical depth")
+      end if
+      if (allocated(cloud%inv_cloud_effective_size)) then
+        call out_file%define_variable("inv_cloud_effective_size", &
+             &   dim2_name="column", dim1_name="level", units_str="m-1", &
+             &   long_name="Inverse of cloud effective horizontal size")
+      end if
+      if (allocated(cloud%inv_inhom_effective_size)) then
+        call out_file%define_variable("inv_inhom_effective_size", &
+             &  dim2_name="column", dim1_name="level", units_str="m-1", &
+             &  long_name="Inverse of cloud inhomogeneity effective horizontal size")
+      end if
+    end if ! do_clouds
+
+    ! Define aerosol mass mixing ratio
+    if (do_aerosol) then
+      call out_file%define_variable("aerosol_mmr", &
+           &   dim3_name="column", dim2_name="aerosol_type", &
+           &   dim1_name="level", units_str="kg kg-1", &
+           &   long_name="Aerosol mass mixing ratio")
+    end if
+
+    ! Write variables
+    call out_file%put("solar_irradiance", single_level%solar_irradiance)
+    if (present(lat)) then
+      call out_file%put("lat", lat)
+    end if
+    if (present(lon)) then
+      call out_file%put("lon", lon)
+    end if
+    call out_file%put("skin_temperature", single_level%skin_temperature)
+    if (config%do_sw) then
+      call out_file%put("cos_solar_zenith_angle", single_level%cos_sza)
+    end if
+    call out_file%put("sw_albedo", single_level%sw_albedo)
+    if (allocated(single_level%sw_albedo_direct)) then
+      call out_file%put("sw_albedo_direct", single_level%sw_albedo_direct)
+    end if
+    call out_file%put("lw_emissivity", single_level%lw_emissivity)
+    if (config%do_clouds .and. allocated(single_level%iseed)) then
+      allocate(seed(ncol))
+      seed = single_level%iseed
+      call out_file%put("iseed", seed)
+      deallocate(seed)
+    end if
+
+    call out_file%put("pressure_hl", thermodynamics%pressure_hl)
+    call out_file%put("temperature_hl", thermodynamics%temperature_hl)
+
+    allocate(mixing_ratio(ncol,nlev))
+    call gas%get(IH2O, IMassMixingRatio, mixing_ratio)
+    call out_file%put("q", mixing_ratio)
+    call gas%get(IO3, IMassMixingRatio, mixing_ratio)
+    call out_file%put("o3_mmr", mixing_ratio)
+    do jgas = 1,NMaxGases
+      if (gas%is_present(jgas) .and. jgas /= IH2O .and. jgas /= IO3) then
+        write(var_name,'(a,a)') trim(GasLowerCaseName(jgas)), '_vmr'
+        call gas%get(jgas, IVolumeMixingRatio, mixing_ratio)
+        call out_file%put(trim(var_name), mixing_ratio)
+      end if
+    end do
+    deallocate(mixing_ratio)
+
+    if (config%do_clouds) then
+      call out_file%put("cloud_fraction", cloud%fraction)
+      call out_file%put("q_liquid", cloud%q_liq)
+      call out_file%put("q_ice", cloud%q_ice)
+      call out_file%put("re_liquid", cloud%re_liq)
+      if (allocated(cloud%re_ice)) then
+        call out_file%put("re_ice", cloud%re_ice)
+      end if
+      if (allocated(cloud%overlap_param)) then
+        call out_file%put("overlap_param", cloud%overlap_param)
+      end if
+      if (allocated(cloud%fractional_std)) then
+        call out_file%put("fractional_std", cloud%fractional_std)
+      end if
+      if (allocated(cloud%inv_cloud_effective_size)) then
+        call out_file%put("inv_cloud_effective_size", cloud%inv_cloud_effective_size)
+      end if
+      if (allocated(cloud%inv_inhom_effective_size)) then
+        call out_file%put("inv_inhom_effective_size", cloud%inv_inhom_effective_size)
+      end if
+    end if
+
+    if (do_aerosol) then
+      allocate(aerosol_mmr(ncol, nlev, size(aerosol%mixing_ratio,3)))
+      aerosol_mmr = 0.0_jprb
+      aerosol_mmr(:,aerosol%istartlev:aerosol%iendlev,:) = aerosol%mixing_ratio
+      call out_file%put("aerosol_mmr", aerosol_mmr)
+      deallocate(aerosol_mmr)
+    end if
+
+    ! Close the file
+    call out_file%close()
+
+    if (lhook) call dr_hook('radiation_save:save_inputs',1,hook_handle)
+    
+  end subroutine save_inputs
+
+end module radiation_save
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_scheme.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_scheme.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_scheme.F90	(revision 3908)
@@ -0,0 +1,736 @@
+! AI mars 2021
+! ====================== Interface between ECRAD and LMDZ ====================
+! radiation_scheme.F90 appelee dans radlwsw_m.F90 si iflag_rttm = 2
+! revoir toutes les parties avec "AI ATTENTION" 
+! Mars 2021 :
+!             - Revoir toutes les parties commentees AI ATTENTION
+!             1. Traitement des aerosols
+!             2. Verifier les parametres times issus de LMDZ (calcul issed)
+!             3. Configuration a partir de namelist
+!             4. frac_std = 0.75      
+! ============================================================================
+
+SUBROUTINE RADIATION_SCHEME &
+! Inputs
+     & (KIDIA, KFDIA, KLON, KLEV, KAEROLMDZ, NSW, &
+     &  IDAY, TIME, &
+     &  PSOLAR_IRRADIANCE, &
+     &  PMU0, PTEMPERATURE_SKIN, PALBEDO_DIF, PALBEDO_DIR, &
+     &  PEMIS, PEMIS_WINDOW, &
+     &  PCCN_LAND, PCCN_SEA, &
+     &  PGELAM, PGEMU, PLAND_SEA_MASK, &
+     &  PPRESSURE, PTEMPERATURE, &
+     &  PPRESSURE_H, PTEMPERATURE_H, PQ, PQSAT, &
+     &  PCO2, PCH4, PN2O, PNO2, PCFC11, PCFC12, PHCFC22, PCCL4, PO3_DP, &
+     &  PCLOUD_FRAC, PQ_LIQUID, PQ_ICE, PQ_RAIN, PQ_SNOW, &
+     &  ZRE_LIQUID_UM, ZRE_ICE_UM, &
+     &  PAEROSOL_OLD, PAEROSOL, &
+! Outputs
+     &  PFLUX_SW, PFLUX_LW, PFLUX_SW_CLEAR, PFLUX_LW_CLEAR, &
+     &  PFLUX_SW_DN, PFLUX_LW_DN, PFLUX_SW_DN_CLEAR, PFLUX_LW_DN_CLEAR, &
+     &  PFLUX_SW_UP, PFLUX_LW_UP, PFLUX_SW_UP_CLEAR, PFLUX_LW_UP_CLEAR, &
+     &  PFLUX_DIR, PFLUX_DIR_CLEAR, PFLUX_DIR_INTO_SUN, &
+     &  PFLUX_UV, PFLUX_PAR, PFLUX_PAR_CLEAR, &
+     &  PEMIS_OUT, PLWDERIVATIVE, &
+     &  PSWDIFFUSEBAND, PSWDIRECTBAND)
+
+
+! RADIATION_SCHEME - Interface to modular radiation scheme
+!
+! (C) Copyright 2015- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! PURPOSE
+! -------
+!   The modular radiation scheme is contained in a separate
+!   library. This routine puts the the IFS arrays into appropriate
+!   objects, computing the additional data that is required, and sends
+!   it to the radiation scheme.  It returns net fluxes and surface
+!   flux components needed by the rest of the model. 
+!
+!   Lower case is used for variables and types taken from the
+!   radiation library
+!
+! INTERFACE
+! ---------
+!    RADIATION_SCHEME is called from RADLSWR. The
+!    SETUP_RADIATION_SCHEME routine (in the RADIATION_SETUP module)
+!    should have been run first.
+!
+! AUTHOR
+! ------
+!   Robin Hogan, ECMWF
+!   Original: 2015-09-16
+!
+! MODIFICATIONS
+! -------------
+!
+! TO DO
+! -----
+!
+!-----------------------------------------------------------------------
+
+! Modules from ifs or ifsaux libraries
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
+! AI ATTENTION module propre a ifs commentes
+!USE YOERAD   , ONLY : YRERAD
+USE RADIATION_SETUP, ONLY : SETUP_RADIATION_SCHEME, rad_config, &
+!USE RADIATION_SETUP, ONLY : &
+     &  NWEIGHT_UV,  IBAND_UV,  WEIGHT_UV, &
+     &  NWEIGHT_PAR, IBAND_PAR, WEIGHT_PAR, &
+     &  ITYPE_TROP_BG_AER,  TROP_BG_AER_MASS_EXT, &
+     &  ITYPE_STRAT_BG_AER, STRAT_BG_AER_MASS_EXT
+! Commentes : jour, date de la simulation 
+!USE YOMRIP0  , ONLY : NINDAT
+!USE YOMCT3   , ONLY : NSTEP
+!USE YOMRIP   , ONLY : YRRIP
+USE YOMCST   , ONLY : RSIGMA ! Stefan-Boltzmann constant
+
+! Modules from radiation library
+! AI ATTENTION
+!use radiation_config,         only : config_type
+USE radiation_single_level,   ONLY : single_level_type
+USE radiation_thermodynamics, ONLY : thermodynamics_type
+USE radiation_gas
+USE radiation_cloud,          ONLY : cloud_type
+USE radiation_aerosol,        ONLY : aerosol_type
+USE radiation_flux,           ONLY : flux_type
+USE radiation_interface,      ONLY : radiation, set_gas_units
+USE radiation_save,           ONLY : save_inputs
+
+IMPLICIT NONE
+
+! INPUT ARGUMENTS
+! *** Array dimensions and ranges
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA    ! Start column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA    ! End column to process
+!INTEGER, INTENT(IN) :: KIDIA, KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLON     ! Number of columns
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV     ! Number of levels
+!INTEGER, INTENT(IN) :: KLON, KLEV
+INTEGER(KIND=JPIM),INTENT(IN) :: KAEROLMDZ ! Number of aerosol types
+INTEGER(KIND=JPIM),INTENT(IN) :: NSW ! Numbe of bands
+
+! AI ATTENTION
+INTEGER, PARAMETER :: KAEROSOL = 12
+
+! *** Single-level fields
+REAL(KIND=JPRB),   INTENT(IN) :: PSOLAR_IRRADIANCE ! (W m-2)
+REAL(KIND=JPRB),   INTENT(IN) :: PMU0(KLON) ! Cosine of solar zenith ang
+REAL(KIND=JPRB),   INTENT(IN) :: PTEMPERATURE_SKIN(KLON) ! (K)
+! Diffuse and direct components of surface shortwave albedo
+!REAL(KIND=JPRB),   INTENT(IN) :: PALBEDO_DIF(KLON,YRERAD%NSW)
+!REAL(KIND=JPRB),   INTENT(IN) :: PALBEDO_DIR(KLON,YRERAD%NSW)
+REAL(KIND=JPRB),   INTENT(IN) :: PALBEDO_DIF(KLON,NSW)
+REAL(KIND=JPRB),   INTENT(IN) :: PALBEDO_DIR(KLON,NSW)
+! Longwave emissivity outside and inside the window region
+REAL(KIND=JPRB),   INTENT(IN) :: PEMIS(KLON)
+REAL(KIND=JPRB),   INTENT(IN) :: PEMIS_WINDOW(KLON)
+! Longitude (radians), sine of latitude
+REAL(KIND=JPRB),   INTENT(IN) :: PGELAM(KLON)
+REAL(KIND=JPRB),   INTENT(IN) :: PGEMU(KLON)
+! Land-sea mask
+REAL(KIND=JPRB),   INTENT(IN) :: PLAND_SEA_MASK(KLON) 
+
+! *** Variables on full levels
+REAL(KIND=JPRB),   INTENT(IN) :: PPRESSURE(KLON,KLEV)    ! (Pa)
+REAL(KIND=JPRB),   INTENT(IN) :: PTEMPERATURE(KLON,KLEV) ! (K)
+! *** Variables on half levels
+REAL(KIND=JPRB),   INTENT(IN) :: PPRESSURE_H(KLON,KLEV+1)    ! (Pa)
+REAL(KIND=JPRB),   INTENT(IN) :: PTEMPERATURE_H(KLON,KLEV+1) ! (K)
+
+! *** Gas mass mixing ratios on full levels
+REAL(KIND=JPRB),   INTENT(IN) :: PQ(KLON,KLEV) 
+! AI
+REAL(KIND=JPRB),   INTENT(IN) :: PQSAT(KLON,KLEV)
+REAL(KIND=JPRB),   INTENT(IN) :: PCO2(KLON,KLEV) 
+REAL(KIND=JPRB),   INTENT(IN) :: PCH4(KLON,KLEV) 
+REAL(KIND=JPRB),   INTENT(IN) :: PN2O(KLON,KLEV) 
+REAL(KIND=JPRB),   INTENT(IN) :: PNO2(KLON,KLEV) 
+REAL(KIND=JPRB),   INTENT(IN) :: PCFC11(KLON,KLEV) 
+REAL(KIND=JPRB),   INTENT(IN) :: PCFC12(KLON,KLEV) 
+REAL(KIND=JPRB),   INTENT(IN) :: PHCFC22(KLON,KLEV) 
+REAL(KIND=JPRB),   INTENT(IN) :: PCCL4(KLON,KLEV) 
+REAL(KIND=JPRB),   INTENT(IN) :: PO3_DP(KLON,KLEV) ! AI (kg/kg) ATTENTION (Pa*kg/kg) 
+
+! *** Cloud fraction and hydrometeor mass mixing ratios
+REAL(KIND=JPRB),   INTENT(IN) :: PCLOUD_FRAC(KLON,KLEV)
+REAL(KIND=JPRB),   INTENT(IN) :: PQ_LIQUID(KLON,KLEV)
+REAL(KIND=JPRB),   INTENT(IN) :: PQ_ICE(KLON,KLEV)
+REAL(KIND=JPRB),   INTENT(IN) :: PQ_RAIN(KLON,KLEV)
+REAL(KIND=JPRB),   INTENT(IN) :: PQ_SNOW(KLON,KLEV)
+
+! *** Aerosol mass mixing ratios
+REAL(KIND=JPRB),   INTENT(IN) :: PAEROSOL_OLD(KLON,6,KLEV)
+REAL(KIND=JPRB),   INTENT(IN) :: PAEROSOL(KLON,KLEV,KAEROSOL)
+
+REAL(KIND=JPRB),   INTENT(IN) :: PCCN_LAND(KLON) 
+REAL(KIND=JPRB),   INTENT(IN) :: PCCN_SEA(KLON) 
+
+!AI mars 2021
+INTEGER(KIND=JPIM), INTENT(IN) :: IDAY
+REAL(KIND=JPRB), INTENT(IN)    :: TIME
+
+
+! OUTPUT ARGUMENTS
+
+! *** Net fluxes on half-levels (W m-2)
+REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_SW(KLON,KLEV+1) 
+REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_LW(KLON,KLEV+1) 
+REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_SW_CLEAR(KLON,KLEV+1) 
+REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_LW_CLEAR(KLON,KLEV+1) 
+
+!*** DN and UP flux on half-levels (W m-2)
+REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_SW_DN(KLON,KLEV+1)
+REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_LW_DN(KLON,KLEV+1)
+REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_SW_DN_CLEAR(KLON,KLEV+1)
+REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_LW_DN_CLEAR(KLON,KLEV+1)
+REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_SW_UP(KLON,KLEV+1)
+REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_LW_UP(KLON,KLEV+1)
+REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_SW_UP_CLEAR(KLON,KLEV+1)
+REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_LW_UP_CLEAR(KLON,KLEV+1)
+
+! *** Surface flux components (W m-2)
+! AI ATTENTION
+!REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_SW_DN_SURF(KLON) 
+!REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_LW_DN_SURF(KLON) 
+!REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_SW_DN_CLEAR_SURF(KLON)
+!REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_LW_DN_CLEAR_SURF(KLON)
+!REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_SW_UP_SURF(KLON)
+!REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_LW_UP_SURF(KLON)
+!REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_SW_UP_CLEAR_SURF(KLON)
+!REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_LW_UP_CLEAR_SURF(KLON)
+
+! Direct component of surface flux into horizontal plane
+REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_DIR(KLON)
+REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_DIR_CLEAR(KLON)
+! As PFLUX_DIR but into a plane perpendicular to the sun
+REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_DIR_INTO_SUN(KLON)
+
+! *** Ultraviolet and photosynthetically active radiation (W m-2)
+REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_UV(KLON)
+REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_PAR(KLON)
+REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_PAR_CLEAR(KLON)
+
+! *** Other single-level diagnostics
+! Top-of-atmosphere incident solar flux (W m-2)
+! AI ATTENTION
+!REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_SW_DN_TOA(KLON)
+!REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_SW_UP_TOA(KLON)
+!REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_LW_DN_TOA(KLON)
+!REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_LW_UP_TOA(KLON)
+
+! Diagnosed longwave surface emissivity across the whole spectrum
+REAL(KIND=JPRB),  INTENT(OUT) :: PEMIS_OUT(KLON)   
+
+! Partial derivative of total-sky longwave upward flux at each level
+! with respect to upward flux at surface, used to correct heating
+! rates at gridpoints/timesteps between calls to the full radiation
+! scheme.  Note that this version uses the convention of level index
+! increasing downwards, unlike the local variable ZLwDerivative that
+! is returned from the LW radiation scheme.
+REAL(KIND=JPRB),  INTENT(OUT) :: PLWDERIVATIVE(KLON,KLEV+1)
+
+! Surface diffuse and direct downwelling shortwave flux in each
+! shortwave albedo band, used in RADINTG to update the surface fluxes
+! accounting for high-resolution albedo information
+REAL(KIND=JPRB),  INTENT(OUT) :: PSWDIFFUSEBAND(KLON,NSW)
+REAL(KIND=JPRB),  INTENT(OUT) :: PSWDIRECTBAND (KLON,NSW)
+
+! LOCAL VARIABLES
+! AI ATTENTION
+!type(config_type)         :: rad_config
+TYPE(single_level_type)   :: single_level
+TYPE(thermodynamics_type) :: thermodynamics
+TYPE(gas_type)            :: gas
+TYPE(cloud_type)          :: cloud
+TYPE(aerosol_type)        :: aerosol
+TYPE(flux_type)           :: flux
+
+! Mass mixing ratio of ozone (kg/kg)
+REAL(KIND=JPRB)           :: ZO3(KLON,KLEV)
+
+! Cloud effective radii in microns
+REAL(KIND=JPRB)           :: ZRE_LIQUID_UM(KLON,KLEV)
+REAL(KIND=JPRB)           :: ZRE_ICE_UM(KLON,KLEV)
+
+! Cloud overlap decorrelation length for cloud boundaries in km
+REAL(KIND=JPRB)           :: ZDECORR_LEN_KM(KLON)
+
+! Ratio of cloud overlap decorrelation length for cloud water
+! inhomogeneities to that for cloud boundaries (typically 0.5)
+REAL(KIND=JPRB)           :: ZDECORR_LEN_RATIO
+
+! The surface net longwave flux if the surface was a black body, used
+! to compute the effective broadband surface emissivity
+REAL(KIND=JPRB)           :: ZBLACK_BODY_NET_LW(KIDIA:KFDIA)
+
+! Layer mass in kg m-2
+REAL(KIND=JPRB)           :: ZLAYER_MASS(KIDIA:KFDIA,KLEV)
+
+! Time integers
+INTEGER :: ITIM
+
+! Loop indices
+INTEGER :: JLON, JLEV, JBAND, JB_ALBEDO, JAER
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+! AI ATTENTION traitement aerosols
+INTEGER, PARAMETER :: NAERMACC = 1
+
+! AI ATTENTION
+real(jprb), parameter    :: frac_std = 0.75
+
+! Name of file names specified on command line
+character(len=512) :: file_name
+
+logical :: loutput=.true.
+logical :: lprint_input=.false.
+logical :: lprint_config=.true.
+
+! Import time functions for iseed calculation
+! AI ATTENTION propre a ifs
+!#include "fcttim.func.h"
+!#include "liquid_effective_radius.intfb.h"
+!#include "ice_effective_radius.intfb.h"
+!#include "cloud_overlap_decorr_len.intfb.h"
+!#include "satur.intfb.h"
+
+! Verifier les inputs
+print*,'=============== dans radiation_scheme : ==================='
+if (lprint_input) then
+  print*,'********** Verification des entrees *************'
+  print*,'KIDIA, KFDIA, KLON, KLEV, KAEROLMDZ, NSW =', &
+        KIDIA, KFDIA, KLON, KLEV, KAEROLMDZ, NSW
+  print*,'IDAY, TIME =', IDAY, TIME
+  print*,'PSOLAR_IRRADIANCE =', PSOLAR_IRRADIANCE
+  print*,'PMU0 =', PMU0
+  print*,'PTEMPERATURE_SKIN =',PTEMPERATURE_SKIN
+  print*,'PEMIS, PEMIS_WINDOW =', PEMIS, PEMIS_WINDOW
+  print*,'PCCN_LAND, PCCN_SEA =', PCCN_LAND, PCCN_SEA
+  print*,'PGELAM, PGEMU =', PGELAM, PGEMU
+  print*,'PPRESSURE =', PPRESSURE
+  print*,'PTEMPERATURE =', PTEMPERATURE
+  print*,'PPRESSURE_H =', PPRESSURE_H
+  print*,'PTEMPERATURE_H =', PTEMPERATURE_H
+  print*,'PQ =', PQ
+  print*,'PQSAT=',PQSAT
+  print*,'PCO2, PCH4, PN2O, PNO2, PCFC11, PCFC12, PHCFC22, PCCL4 =', &
+        PCO2, PCH4, PN2O, PNO2, PCFC11, PCFC12, PHCFC22, PCCL4
+  print*,'PO3_DP =',PO3_DP
+  print*,'PCLOUD_FRAC, PQ_LIQUID, PQ_ICE, PQ_RAIN, PQ_SNOW =', &
+        PCLOUD_FRAC, PQ_LIQUID, PQ_ICE, PQ_RAIN, PQ_SNOW
+  print*,'ZRE_LIQUID_UM, ZRE_ICE_UM =', &
+        ZRE_LIQUID_UM, ZRE_ICE_UM
+  print*,'PAEROSOL_OLD, PAEROSOL =', PAEROSOL_OLD, PAEROSOL
+endif
+! AI ATTENTION lecture de namelist 
+! alternative a l appel de radiation_setup ifs
+!file_name="namelist_ecrad"
+!call rad_config%read(file_name=file_name)
+! Setup the radiation scheme: load the coefficients for gas and
+! cloud optics, currently from RRTMG
+!call setup_radiation(rad_config)
+
+IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME',0,ZHOOK_HANDLE)
+print*,'Entree dans radiation_scheme'
+! AI appel radiation_setup
+call SETUP_RADIATION_SCHEME(loutput)
+
+if (lprint_config) then
+  print*,'************* Parametres de configuration  ********************'
+  print*,'rad_config%iverbosesetup = ',rad_config%iverbosesetup 
+  print*,'rad_config%iverbose = ',rad_config%iverbose
+  print*,'rad_config%directory_name =', rad_config%directory_name
+  print*,'rad_config%do_lw_derivatives =',rad_config%do_lw_derivatives
+  print*,'rad_config%do_surface_sw_spectral_flux =', &
+        rad_config%do_surface_sw_spectral_flux
+  print*,'rad_config%do_setup_ifsrrtm =', rad_config%do_setup_ifsrrtm
+  print*,'rad_config%i_liq_model =',rad_config%i_liq_model
+  print*,'rad_config%i_ice_model =',rad_config%i_ice_model
+  print*,'rad_config%i_overlap_scheme =', rad_config%i_overlap_scheme
+  print*,'rad_config%use_aerosols = ', rad_config%use_aerosols
+  print*,'rad_config%n_aerosol_types = ', rad_config%n_aerosol_types
+  print*,'rad_config%i_solver_lw =',rad_config%i_solver_lw
+  print*,'rad_config%i_solver_sw =',rad_config%i_solver_sw
+  print*,'rad_config%do_3d_effects =', rad_config%do_3d_effects
+  print*,'rad_config%do_sw_delta_scaling_with_gases =', &
+       rad_config%do_sw_delta_scaling_with_gases
+  print*,'rad_config%do_lw_aerosol_scattering =', &
+       rad_config%do_lw_aerosol_scattering
+  print*,'rad_config%i_albedo_from_band_sw = ', &
+       rad_config%i_albedo_from_band_sw
+  print*,'n_bands_lw =', rad_config%n_bands_lw
+  print*,'rad_config%i_emiss_from_band_lw =', rad_config%i_emiss_from_band_lw
+endif
+!stop
+! A EFFACER
+!print*,'n_g_lw, n_g_sw =', rad_config%n_g_lw, rad_config%n_g_sw
+!print*,'use_canopy_full_spectrum_lw = ', rad_config%use_canopy_full_spectrum_lw
+!print*,'rad_config%i_band_from_reordered_g_lw =', &
+!       rad_config%i_band_from_reordered_g_lw
+!print*,'use_canopy_full_spectrum_lw =', rad_config%use_canopy_full_spectrum_lw
+!rad_config%use_canopy_full_spectrum_lw = .TRUE.
+! AI ATTENTION
+!rad_config%i_band_from_reordered_g_lw = 1
+!rad_config%use_spectral_solar_scaling = .true.
+!endif
+! AI ATTENTION test
+!rad_config%i_gas_model = IGasModelMonochromatic
+
+! AI ATTENTION
+! Allocate memory in radiation objects
+CALL single_level%allocate(KLON, NSW, 2, &
+     &                     use_sw_albedo_direct=.TRUE.)
+
+print*,'************* THERMO (allocate + input) ************************************'
+! Set thermodynamic profiles: simply copy over the half-level
+! pressure and temperature
+print*,'Appel allocate thermo'
+CALL thermodynamics%allocate(KLON, KLEV, use_h2o_sat=.true.)
+print*,'Definir les champs thermo'
+! AI
+! pressure_hl > paprs
+! temperature_hl calculee dans radlsw de la meme facon que pour RRTM
+thermodynamics%pressure_hl   (KIDIA:KFDIA,:) = PPRESSURE_H   (KIDIA:KFDIA,:)
+thermodynamics%temperature_hl(KIDIA:KFDIA,:) = PTEMPERATURE_H(KIDIA:KFDIA,:)
+
+! IFS currently sets the half-level temperature at the surface to be
+! equal to the skin temperature. The radiation scheme takes as input
+! only the half-level temperatures and assumes the Planck function to
+! vary linearly in optical depth between half levels. In the lowest
+! atmospheric layer, where the atmospheric temperature can be much
+! cooler than the skin temperature, this can lead to significant
+! differences between the effective temperature of this lowest layer
+! and the true value in the model.
+!
+! We may approximate the temperature profile in the lowest model level
+! as piecewise linear between the top of the layer T[k-1/2], the
+! centre of the layer T[k] and the base of the layer Tskin.  The mean
+! temperature of the layer is then 0.25*T[k-1/2] + 0.5*T[k] +
+! 0.25*Tskin, which can be achieved by setting the atmospheric
+! temperature at the half-level corresponding to the surface as
+! follows:
+thermodynamics%temperature_hl(KIDIA:KFDIA,KLEV+1) &
+     &  = PTEMPERATURE(KIDIA:KFDIA,KLEV) &
+     &  + 0.5_JPRB * (PTEMPERATURE_H(KIDIA:KFDIA,KLEV+1) &
+     &               -PTEMPERATURE_H(KIDIA:KFDIA,KLEV))
+
+! Alternatively we respect the model's atmospheric temperature in the
+! lowest model level by setting the temperature at the lowest
+! half-level such that the mean temperature of the layer is correct:
+!thermodynamics%temperature_hl(KIDIA:KFDIA,KLEV+1) &
+!     &  = 2.0_JPRB * PTEMPERATURE(KIDIA:KFDIA,KLEV) &
+!     &             - PTEMPERATURE_H(KIDIA:KFDIA,KLEV)
+
+! Compute saturation specific humidity, used to hydrate aerosols. The
+! "2" for the last argument indicates that the routine is not being
+! called from within the convection scheme.
+!CALL SATUR(KIDIA, KFDIA, KLON, 1, KLEV, &
+!     &  PPRESSURE, PTEMPERATURE, thermodynamics%h2o_sat_liq, 2)  
+! Alternative approximate version using temperature and pressure from
+! the thermodynamics structure
+print*,'Compute saturation specific humidity'
+CALL thermodynamics%calc_saturation_wrt_liquid(KIDIA, KFDIA)
+
+print*,'********** SINGLE LEVEL VARS **********************************'
+!AI ATTENTION
+!thermodynamics%h2o_sat_liq = PQSAT
+! Set single-level fileds
+single_level%solar_irradiance              = PSOLAR_IRRADIANCE
+!allocate(single_level%cos_sza(KIDIA:KFDIA))
+single_level%cos_sza(KIDIA:KFDIA)          = PMU0(KIDIA:KFDIA)
+!allocate(single_level%skin_temperature(KIDIA:KFDIA))
+single_level%skin_temperature(KIDIA:KFDIA) = PTEMPERATURE_SKIN(KIDIA:KFDIA)
+!allocate(single_level%sw_albedo(KIDIA:KFDIA,1))
+single_level%sw_albedo(KIDIA:KFDIA,:)      = PALBEDO_DIF(KIDIA:KFDIA,:)
+!single_level%sw_albedo(KIDIA:KFDIA,:)      = 0.2_JPRB
+!allocate(single_level%sw_albedo_direct(KIDIA:KFDIA,1))
+single_level%sw_albedo_direct(KIDIA:KFDIA,:)=PALBEDO_DIR(KIDIA:KFDIA,:)
+!single_level%sw_albedo_direct(KIDIA:KFDIA,:)=0.2_JPRB
+! Longwave emissivity is in two bands
+!allocate(single_level%lw_emissivity(KIDIA:KFDIA,1))
+!single_level%lw_emissivity(KIDIA:KFDIA,1)  = 1.0_JPRB
+single_level%lw_emissivity(KIDIA:KFDIA,1)  = PEMIS(KIDIA:KFDIA)
+single_level%lw_emissivity(KIDIA:KFDIA,2)  = PEMIS_WINDOW(KIDIA:KFDIA)
+
+! Create the relevant seed from date and time get the starting day
+! and number of minutes since start
+!IDAY = NDD(NINDAT)
+!cur_day
+!ITIM = NINT(NSTEP * YRRIP%TSTEP / 60.0_JPRB)
+ITIM = NINT(TIME / 60.0_JPRB)
+!current_time
+!allocate(single_level%iseed(KIDIA:KFDIA))
+DO JLON = KIDIA, KFDIA
+  ! This method gives a unique value for roughly every 1-km square
+  ! on the globe and every minute.  ASIN(PGEMU)*60 gives rough
+  ! latitude in degrees, which we multiply by 100 to give a unique
+  ! value for roughly every km. PGELAM*60*100 gives a unique number
+  ! for roughly every km of longitude around the equator, which we
+  ! multiply by 180*100 so there is no overlap with the latitude
+  ! values.  The result can be contained in a 32-byte integer (but
+  ! since random numbers are generated with the help of integer
+  ! overflow, it should not matter if the number did overflow).
+  single_level%iseed(JLON) = ITIM + IDAY & 
+       &  +  NINT(PGELAM(JLON)*108000000.0_JPRB &
+       &          + ASIN(PGEMU(JLON))*6000.0_JPRB)
+ENDDO
+
+print*,'********** CLOUDS (allocate + input) *******************************************'
+print*,'Appel Allocate clouds'
+CALL cloud%allocate(KLON, KLEV)
+! Set cloud fields
+cloud%q_liq(KIDIA:KFDIA,:)    = PQ_LIQUID(KIDIA:KFDIA,:)
+cloud%q_ice(KIDIA:KFDIA,:)    = PQ_ICE(KIDIA:KFDIA,:) + PQ_SNOW(KIDIA:KFDIA,:)
+cloud%fraction(KIDIA:KFDIA,:) = PCLOUD_FRAC(KIDIA:KFDIA,:)
+
+! Compute effective radii and convert to metres
+!CALL LIQUID_EFFECTIVE_RADIUS(KIDIA, KFDIA, KLON, KLEV, &
+!     &  PPRESSURE, PTEMPERATURE, PCLOUD_FRAC, PQ_LIQUID, PQ_RAIN, &
+!     &  PLAND_SEA_MASK, PCCN_LAND, PCCN_SEA, &
+!     &  ZRE_LIQUID_UM)
+cloud%re_liq(KIDIA:KFDIA,:) = ZRE_LIQUID_UM(KIDIA:KFDIA,:) * 1.0e-6_JPRB
+
+!CALL ICE_EFFECTIVE_RADIUS(KIDIA, KFDIA, KLON, KLEV, &
+!     &  PPRESSURE, PTEMPERATURE, PCLOUD_FRAC, PQ_ICE, PQ_SNOW, PGEMU, &
+!     &  ZRE_ICE_UM)
+cloud%re_ice(KIDIA:KFDIA,:) = ZRE_ICE_UM(KIDIA:KFDIA,:) * 1.0e-6_JPRB
+
+! Get the cloud overlap decorrelation length (for cloud boundaries),
+! in km, according to the parameterization specified by NDECOLAT,
+! and insert into the "cloud" object. Also get the ratio of
+! decorrelation lengths for cloud water content inhomogeneities and
+! cloud boundaries, and set it in the "rad_config" object.
+!CALL CLOUD_OVERLAP_DECORR_LEN(KIDIA, KFDIA, KLON, PGEMU, YRERAD%NDECOLAT, &
+!     &    ZDECORR_LEN_KM, PDECORR_LEN_RATIO=ZDECORR_LEN_RATIO)
+! AI
+ZDECORR_LEN_RATIO = 0.5
+rad_config%cloud_inhom_decorr_scaling = ZDECORR_LEN_RATIO
+DO JLON = KIDIA,KFDIA
+  CALL cloud%set_overlap_param(thermodynamics, &
+       &                       ZDECORR_LEN_KM(JLON)*1000.0_JPRB, &
+       &                       istartcol=JLON, iendcol=JLON)
+ENDDO
+
+! Cloud water content fractional standard deviation is configurable
+! from namelist NAERAD but must be globally constant. Before it was
+! hard coded at 1.0.
+!CALL cloud%create_fractional_std(KLON, KLEV, YRERAD%RCLOUD_FRAC_STD)
+CALL cloud%create_fractional_std(KLON, KLEV, frac_std)
+
+! By default mid and high cloud effective size is 10 km
+CALL cloud%create_inv_cloud_effective_size(KLON,KLEV,1.0_JPRB/10000.0_JPRB)
+! But for boundary clouds (eta > 0.8) we set it to 1 km
+DO JLEV = 1,KLEV
+  DO JLON = KIDIA,KFDIA
+    IF (PPRESSURE(JLON,JLEV) > 0.8_JPRB * PPRESSURE_H(JLON,KLEV+1)) THEN
+      cloud%inv_cloud_effective_size(JLON,JLEV) = 1.0e-3_JPRB
+    ENDIF
+  ENDDO
+ENDDO
+
+print*,'******** AEROSOLS (allocate + input) **************************************'
+IF (NAERMACC > 0) THEN
+  CALL aerosol%allocate(KLON, 1, KLEV, KAEROSOL) ! MACC climatology
+ELSE
+  CALL aerosol%allocate(KLON, 1, KLEV, 6) ! Tegen climatology
+ENDIF
+! Compute the dry mass of each layer neglecting humidity effects, in
+! kg m-2, needed to scale some of the aerosol inputs
+! AI commente ATTENTION
+!CALL thermodynamics%get_layer_mass(ZLAYER_MASS)
+
+! Copy over aerosol mass mixing ratio
+!IF (NAERMACC > 0) THEN
+
+  ! MACC aerosol climatology - this is already in mass mixing ratio
+  ! units with the required array orientation so we can copy it over
+  ! directly
+  aerosol%mixing_ratio(KIDIA:KFDIA,:,:) = PAEROSOL(KIDIA:KFDIA,:,:)
+
+  ! Add the tropospheric and stratospheric backgrounds contained in the
+  ! old Tegen arrays - this is very ugly!
+! AI ATTENTION
+!  IF (TROP_BG_AER_MASS_EXT > 0.0_JPRB) THEN
+!    aerosol%mixing_ratio(KIDIA:KFDIA,:,ITYPE_TROP_BG_AER) &
+!         &  = aerosol%mixing_ratio(KIDIA:KFDIA,:,ITYPE_TROP_BG_AER) &
+!         &  + PAEROSOL_OLD(KIDIA:KFDIA,1,:) &
+!         &  / (ZLAYER_MASS * TROP_BG_AER_MASS_EXT)
+!  ENDIF
+!  IF (STRAT_BG_AER_MASS_EXT > 0.0_JPRB) THEN
+!    aerosol%mixing_ratio(KIDIA:KFDIA,:,ITYPE_STRAT_BG_AER) &
+!         &  = aerosol%mixing_ratio(KIDIA:KFDIA,:,ITYPE_STRAT_BG_AER) &
+!         &  + PAEROSOL_OLD(KIDIA:KFDIA,6,:) &
+!         &  / (ZLAYER_MASS * STRAT_BG_AER_MASS_EXT)
+!  ENDIF
+
+!ELSE
+
+  ! Tegen aerosol climatology - the array PAEROSOL_OLD contains the
+  ! 550-nm optical depth in each layer. The optics data file
+  ! aerosol_ifs_rrtm_tegen.nc does not contain mass extinction
+  ! coefficient, but a scaling factor that the 550-nm optical depth
+  ! should be multiplied by to obtain the optical depth in each
+  ! spectral band.  Therefore, in order for the units to work out, we
+  ! need to divide by the layer mass (in kg m-2) to obtain the 550-nm
+  ! cross-section per unit mass of dry air (so in m2 kg-1).  We also
+  ! need to permute the array.
+!  DO JLEV = 1,KLEV
+!    DO JAER = 1,6
+!      aerosol%mixing_ratio(KIDIA:KFDIA,JLEV,JAER) &
+!         &  = PAEROSOL_OLD(KIDIA:KFDIA,JAER,JLEV) &
+!         &  / ZLAYER_MASS(KIDIA:KFDIA,JLEV)
+!    ENDDO
+!  ENDDO
+
+!ENDIF
+
+print*,'********** GAS (allocate + input) ************************************************'
+print*,'Appel Allocate gas'
+CALL gas%allocate(KLON, KLEV)
+
+! Convert ozone Pa*kg/kg to kg/kg
+! AI ATTENTION
+!DO JLEV = 1,KLEV
+!  DO JLON = KIDIA,KFDIA
+!    ZO3(JLON,JLEV) = PO3_DP(JLON,JLEV) &
+!         &         / (PPRESSURE_H(JLON,JLEV+1)-PPRESSURE_H(JLON,JLEV))
+!  ENDDO
+!ENDDO
+ZO3 = PO3_DP
+
+!  Insert gas mixing ratios
+print*,'Insert gas mixing ratios'
+CALL gas%put(IH2O,    IMassMixingRatio, PQ)
+CALL gas%put(ICO2,    IMassMixingRatio, PCO2)
+CALL gas%put(ICH4,    IMassMixingRatio, PCH4)
+CALL gas%put(IN2O,    IMassMixingRatio, PN2O)
+CALL gas%put(ICFC11,  IMassMixingRatio, PCFC11)
+CALL gas%put(ICFC12,  IMassMixingRatio, PCFC12)
+CALL gas%put(IHCFC22, IMassMixingRatio, PHCFC22)
+CALL gas%put(ICCL4,   IMassMixingRatio, PCCL4)
+CALL gas%put(IO3,     IMassMixingRatio, ZO3)
+CALL gas%put_well_mixed(IO2, IVolumeMixingRatio, 0.20944_JPRB)
+! Ensure the units of the gas mixing ratios are what is required by
+! the gas absorption model
+call set_gas_units(rad_config, gas)
+
+print*,'************** FLUX (allocate) ***********************'
+CALL flux%allocate(rad_config, 1, KLON, KLEV)
+
+! Call radiation scheme
+print*,'******** Appel radiation scheme **************************'
+CALL radiation(KLON, KLEV, KIDIA, KFDIA, rad_config, &
+     &  single_level, thermodynamics, gas, cloud, aerosol, flux)
+
+! Compute required output fluxes
+! DN and UP flux
+PFLUX_SW_DN(KIDIA:KFDIA,:) = flux%sw_dn(KIDIA:KFDIA,:)
+PFLUX_SW_UP(KIDIA:KFDIA,:) = flux%sw_up(KIDIA:KFDIA,:)
+PFLUX_LW_DN(KIDIA:KFDIA,:) = flux%lw_dn(KIDIA:KFDIA,:)
+PFLUX_LW_UP(KIDIA:KFDIA,:) = flux%lw_up(KIDIA:KFDIA,:)
+PFLUX_SW_DN_CLEAR(KIDIA:KFDIA,:) = flux%sw_dn_clear(KIDIA:KFDIA,:)
+PFLUX_SW_UP_CLEAR(KIDIA:KFDIA,:) = flux%sw_up_clear(KIDIA:KFDIA,:)
+PFLUX_LW_DN_CLEAR(KIDIA:KFDIA,:) = flux%lw_dn_clear(KIDIA:KFDIA,:)
+PFLUX_LW_UP_CLEAR(KIDIA:KFDIA,:) = flux%lw_up_clear(KIDIA:KFDIA,:)
+
+! First the net fluxes
+PFLUX_SW(KIDIA:KFDIA,:) = flux%sw_dn(KIDIA:KFDIA,:) - flux%sw_up(KIDIA:KFDIA,:)
+PFLUX_LW(KIDIA:KFDIA,:) = flux%lw_dn(KIDIA:KFDIA,:) - flux%lw_up(KIDIA:KFDIA,:)
+PFLUX_SW_CLEAR(KIDIA:KFDIA,:) &
+     &  = flux%sw_dn_clear(KIDIA:KFDIA,:) - flux%sw_up_clear(KIDIA:KFDIA,:)
+PFLUX_LW_CLEAR(KIDIA:KFDIA,:) &
+     &  = flux%lw_dn_clear(KIDIA:KFDIA,:) - flux%lw_up_clear(KIDIA:KFDIA,:)
+
+! Now the surface fluxes
+!PFLUX_SW_DN_SURF(KIDIA:KFDIA) = flux%sw_dn(KIDIA:KFDIA,KLEV+1)
+!PFLUX_LW_DN_SURF(KIDIA:KFDIA) = flux%lw_dn(KIDIA:KFDIA,KLEV+1)
+!PFLUX_SW_UP_SURF(KIDIA:KFDIA) = flux%sw_up(KIDIA:KFDIA,KLEV+1)
+!PFLUX_LW_UP_SURF(KIDIA:KFDIA) = flux%lw_up(KIDIA:KFDIA,KLEV+1)
+!PFLUX_SW_DN_CLEAR_SURF(KIDIA:KFDIA) = flux%sw_dn_clear(KIDIA:KFDIA,KLEV+1)
+!PFLUX_LW_DN_CLEAR_SURF(KIDIA:KFDIA) = flux%lw_dn_clear(KIDIA:KFDIA,KLEV+1)
+!PFLUX_SW_UP_CLEAR_SURF(KIDIA:KFDIA) = flux%sw_up_clear(KIDIA:KFDIA,KLEV+1)
+!PFLUX_LW_UP_CLEAR_SURF(KIDIA:KFDIA) = flux%lw_up_clear(KIDIA:KFDIA,KLEV+1)
+PFLUX_DIR(KIDIA:KFDIA) = flux%sw_dn_direct(KIDIA:KFDIA,KLEV+1)
+PFLUX_DIR_CLEAR(KIDIA:KFDIA) = flux%sw_dn_direct_clear(KIDIA:KFDIA,KLEV+1)
+PFLUX_DIR_INTO_SUN(KIDIA:KFDIA) = 0.0_JPRB
+WHERE (PMU0(KIDIA:KFDIA) > EPSILON(1.0_JPRB))
+  PFLUX_DIR_INTO_SUN(KIDIA:KFDIA) = PFLUX_DIR(KIDIA:KFDIA) / PMU0(KIDIA:KFDIA)
+END WHERE
+
+! Top-of-atmosphere downwelling flux
+!PFLUX_SW_DN_TOA(KIDIA:KFDIA) = flux%sw_dn(KIDIA:KFDIA,1)
+!PFLUX_SW_UP_TOA(KIDIA:KFDIA) = flux%sw_up(KIDIA:KFDIA,1)
+!PFLUX_LW_DN_TOA(KIDIA:KFDIA) = flux%lw_dn(KIDIA:KFDIA,1)
+!PFLUX_LW_UP_TOA(KIDIA:KFDIA) = flux%lw_up(KIDIA:KFDIA,1)
+
+! Compute UV fluxes as weighted sum of appropriate shortwave bands
+PFLUX_UV       (KIDIA:KFDIA) = 0.0_JPRB
+! AI ATTENTION
+!DO JBAND = 1,NWEIGHT_UV
+!  PFLUX_UV(KIDIA:KFDIA) = PFLUX_UV(KIDIA:KFDIA) + WEIGHT_UV(JBAND) &
+!       &  * flux%sw_dn_surf_band(IBAND_UV(JBAND),KIDIA:KFDIA)
+!ENDDO
+
+! Compute photosynthetically active radiation similarly
+PFLUX_PAR      (KIDIA:KFDIA) = 0.0_JPRB
+PFLUX_PAR_CLEAR(KIDIA:KFDIA) = 0.0_JPRB
+!AI ATTENTION
+!DO JBAND = 1,NWEIGHT_PAR
+!  PFLUX_PAR(KIDIA:KFDIA) = PFLUX_PAR(KIDIA:KFDIA) + WEIGHT_PAR(JBAND) &
+!       &  * flux%sw_dn_surf_band(IBAND_PAR(JBAND),KIDIA:KFDIA)
+!  PFLUX_PAR_CLEAR(KIDIA:KFDIA) = PFLUX_PAR_CLEAR(KIDIA:KFDIA) &
+!       &  + WEIGHT_PAR(JBAND) &
+!       &  * flux%sw_dn_surf_clear_band(IBAND_PAR(JBAND),KIDIA:KFDIA)
+!ENDDO
+
+! Compute effective broadband emissivity
+ZBLACK_BODY_NET_LW = flux%lw_dn(KIDIA:KFDIA,KLEV+1) &
+     &  - RSIGMA*PTEMPERATURE_SKIN(KIDIA:KFDIA)**4
+PEMIS_OUT(KIDIA:KFDIA) = PEMIS(KIDIA:KFDIA)
+WHERE (ABS(ZBLACK_BODY_NET_LW) > 1.0E-5) 
+  PEMIS_OUT(KIDIA:KFDIA) = PFLUX_LW(KIDIA:KFDIA,KLEV+1) / ZBLACK_BODY_NET_LW
+END WHERE
+
+! Copy longwave derivatives
+!IF (YRERAD%LAPPROXLWUPDATE) THEN
+IF (rad_config%do_lw_derivatives) THEN
+  PLWDERIVATIVE(KIDIA:KFDIA,:) = flux%lw_derivatives(KIDIA:KFDIA,:)
+END IF
+
+! Store the shortwave downwelling fluxes in each albedo band
+!IF (YRERAD%LAPPROXSWUPDATE) THEN
+IF (rad_config%do_surface_sw_spectral_flux) THEN
+  PSWDIFFUSEBAND(KIDIA:KFDIA,:) = 0.0_JPRB
+  PSWDIRECTBAND (KIDIA:KFDIA,:) = 0.0_JPRB
+  DO JBAND = 1,rad_config%n_bands_sw
+    JB_ALBEDO = rad_config%i_albedo_from_band_sw(JBAND)
+    DO JLON = KIDIA,KFDIA
+      PSWDIFFUSEBAND(JLON,JB_ALBEDO) = PSWDIFFUSEBAND(JLON,JB_ALBEDO) &
+           &  + flux%sw_dn_surf_band(JBAND,JLON) &
+           &  - flux%sw_dn_direct_surf_band(JBAND,JLON)
+      PSWDIRECTBAND(JLON,JB_ALBEDO)  = PSWDIRECTBAND(JLON,JB_ALBEDO) &
+           &  + flux%sw_dn_direct_surf_band(JBAND,JLON)
+    ENDDO
+  ENDDO
+ENDIF
+
+CALL single_level%deallocate
+CALL thermodynamics%deallocate
+CALL gas%deallocate
+CALL cloud%deallocate
+CALL aerosol%deallocate
+CALL flux%deallocate
+
+IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME',1,ZHOOK_HANDLE)
+
+END SUBROUTINE RADIATION_SCHEME
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_setup.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_setup.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_setup.F90	(revision 3908)
@@ -0,0 +1,458 @@
+MODULE RADIATION_SETUP
+
+! RADIATION_SETUP - Setting up modular radiation scheme
+!
+! (C) Copyright 2015- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! PURPOSE
+! -------
+!   The modular radiation scheme is contained in a separate
+!   library. SETUP_RADIATION_SCHEME in this module sets up a small
+!   number of global variables needed to store the information for it.
+!
+!   Lower case is used for variables and types taken from the
+!   radiation library
+!
+! INTERFACE
+! ---------
+!   SETUP_RADIATION_SCHEME is called from SUECRAD.  The radiation
+!   scheme is actually run using the RADIATION_SCHEME routine (not in
+!   this module).
+!
+! AUTHOR
+! ------
+!   Robin Hogan, ECMWF
+!   Original: 2015-09-16
+!
+! MODIFICATIONS
+! -------------
+!
+!-----------------------------------------------------------------------
+
+  USE PARKIND1,         ONLY : JPRB
+  USE radiation_config, ONLY : config_type, &
+       &                       ISolverMcICA, ISolverSpartacus, &
+       &                       ILiquidModelSlingo, ILiquidModelSOCRATES, &
+       &                       IIceModelFu, IIceModelBaran, &
+       &                       IOverlapExponentialRandom
+
+  IMPLICIT NONE
+
+  ! Store configuration information for the radiation scheme in a
+  ! global variable
+  type(config_type) :: rad_config
+
+  ! Ultraviolet weightings
+  INTEGER         :: NWEIGHT_UV
+  INTEGER         :: IBAND_UV(100)
+  REAL(KIND=JPRB) :: WEIGHT_UV(100)
+  ! Photosynthetically active radiation weightings
+  INTEGER         :: NWEIGHT_PAR
+  INTEGER         :: IBAND_PAR(100)
+  REAL(KIND=JPRB) :: WEIGHT_PAR(100)
+
+  ! Background aerosol is specified in an ugly way: using the old
+  ! Tegen fields that are in terms of optical depth, and converted to
+  ! mass mixing ratio via the relevant mass-extinction coefficient
+  INTEGER, PARAMETER :: ITYPE_TROP_BG_AER = 8 ! hydrophobic organic
+  INTEGER, PARAMETER :: ITYPE_STRAT_BG_AER=12 ! non-absorbing sulphate
+  REAL(KIND=JPRB)    :: TROP_BG_AER_MASS_EXT
+  REAL(KIND=JPRB)    :: STRAT_BG_AER_MASS_EXT
+
+CONTAINS
+
+  ! This routine copies information between the IFS radiation
+  ! configuration (stored in global variables) and the radiation
+  ! configuration of the modular radiation scheme (stored in
+  ! rad_config).  The optional input logical LOUTPUT controls whether
+  ! to print lots of information during the setup stage (default is
+  ! no).
+  SUBROUTINE SETUP_RADIATION_SCHEME(LOUTPUT)
+
+    USE YOMHOOK,  ONLY : LHOOK, DR_HOOK
+!    USE YOMLUN,   ONLY : NULNAM, NULOUT, NULERR
+    USE YOMLUN,   ONLY : NULOUT, NULERR
+    USE YOESRTWN, ONLY : NMPSRTM
+! AI ATTENTION
+!    USE YOERAD,   ONLY : YRERAD
+
+    USE radiation_interface,      ONLY : setup_radiation
+    USE radiation_aerosol_optics, ONLY : dry_aerosol_sw_mass_extinction
+
+!#include "posname.intfb.h"
+
+    ! Whether or not to provide information on the radiation scheme
+    ! configuration
+    LOGICAL, INTENT(IN), OPTIONAL :: LOUTPUT
+
+    ! Verbosity of configuration information 0=none, 1=warning,
+    ! 2=info, 3=progress, 4=detailed, 5=debug
+    INTEGER :: IVERBOSESETUP
+    INTEGER :: ISTAT
+
+    REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+    character(len=512) :: file_name
+
+    logical :: lprint_setp=.TRUE.
+
+    IF (LHOOK) CALL DR_HOOK('RADIATION_SETUP:SETUP_RADIATION_SCHEME',0,ZHOOK_HANDLE)
+
+    ! *** GENERAL SETUP ***
+
+    ! Configure verbosity of setup of radiation scheme
+ 
+    print*,'********** Dans radiation_setup *****************'
+
+    IVERBOSESETUP = 4 ! Provide plenty of information
+    IF (PRESENT(LOUTPUT)) THEN
+      IF (.NOT. LOUTPUT) THEN
+        IVERBOSESETUP = 1 ! Warnings and errors only
+      ENDIF
+    ENDIF
+    rad_config%iverbosesetup = IVERBOSESETUP
+    if (lprint_setp) then
+      print*,'Dans radiation_setup '
+      print*,'rad_config%iverbosesetup =', rad_config%iverbosesetup
+    endif
+
+    IF (IVERBOSESETUP > 1) THEN
+      WRITE(NULOUT,'(a)') '-------------------------------------------------------------------------------'
+      WRITE(NULOUT,'(a)') 'RADIATION_SETUP'
+    ENDIF
+
+    ! Normal operation of the radiation scheme displays only errors
+    ! and warnings
+    rad_config%iverbose = 5
+    if (lprint_setp) then
+      print*,'rad_config%iverbose =', rad_config%iverbose
+    endif
+    ! For the time being, ensure a valid default directory name
+    rad_config%directory_name = '/d3/idelkadi/Ecrad/data'
+    if (lprint_setp) then
+      print*,'rad_config%directory_name =', rad_config%directory_name
+    endif
+
+    ! Do we do Hogan and Bozzo (2014) approximate longwave updates?
+! AI ATTENTION (ifs : )
+!    rad_config%do_lw_derivatives = YRERAD%LAPPROXLWUPDATE
+    rad_config%do_lw_derivatives = .false.
+    if (lprint_setp) then
+      print*,'rad_config%do_lw_derivatives =', rad_config%do_lw_derivatives    
+    endif
+
+    ! Surface spectral fluxes are needed for spectral shortwave albedo
+    ! calculation
+! AI ATTENTION test (ifs : T)
+!    rad_config%do_save_spectral_flux = .FALSE.
+    rad_config%do_surface_sw_spectral_flux = .TRUE.
+    if (lprint_setp) then
+      print*,'rad_config%do_surface_sw_spectral_flux =', &
+            rad_config%do_surface_sw_spectral_flux
+    endif
+
+    ! *** SETUP GAS OPTICS ***
+
+    ! Assume IFS has already set-up RRTM, so the setup_radiation
+    ! routine below does not have to (ifs : F)
+    print*,'i_gas_model =',rad_config%i_gas_model
+    rad_config%do_setup_ifsrrtm = .TRUE.
+    if (lprint_setp) then
+      print*,'rad_config%do_setup_ifsrrtm =', rad_config%do_setup_ifsrrtm
+    endif
+
+    ! *** SETUP CLOUD OPTICS ***
+
+    ! Setup liquid optics
+! AI ATTENTION
+! Choix offline : liquid_model_name = "SOCRATES"
+!    IF (YRERAD%NLIQOPT == 2) THEN
+!      rad_config%i_liq_model = ILiquidModelSlingo
+!    ELSEIF (YRERAD%NLIQOPT == 3) THEN
+      rad_config%i_liq_model = ILiquidModelSOCRATES
+      if (lprint_setp) then
+        print*,'rad_config%i_liq_model =',rad_config%i_liq_model
+      endif
+
+!    ELSE
+!      WRITE(NULERR,'(a,i0)') 'Unavailable liquid optics model in modular radiation scheme: NLIQOPT=', &
+!           &  YRERAD%NLIQOPT
+!      CALL ABOR1('RADIATION_SETUP: error interpreting NLIQOPT')   
+!    ENDIF
+
+    ! Setup ice optics
+! Choix offline : ice_model_name    = "Fu-IFS"
+!    IF (YRERAD%NICEOPT == 3) THEN
+      rad_config%i_ice_model = IIceModelFu
+      if (lprint_setp) then
+        print*,'rad_config%i_ice_model =', rad_config%i_ice_model
+      endif
+!    ELSEIF (YRERAD%NICEOPT == 4) THEN
+!      rad_config%i_ice_model = IIceModelBaran
+!    ELSE
+!      WRITE(NULERR,'(a,i0)') 'Unavailable ice optics model in modular radiation scheme: NICEOPT=', &
+!           &  YRERAD%NICEOPT
+!      CALL ABOR1('RADIATION_SETUP: error interpreting NICEOPT')   
+!    ENDIF
+
+    ! For consistency with earlier versions of the IFS radiation
+    ! scheme, we perform shortwave delta-Eddington scaling *after* the
+    ! merge of the cloud, aerosol and gas optical properties.  Set
+    ! this to "false" to do the scaling on the cloud and aerosol
+    ! properties separately before merging with gases. Note that this
+    ! is not compatible with the SPARTACUS solver.
+    rad_config%do_sw_delta_scaling_with_gases = .FALSE.
+    if (lprint_setp) then
+      print*,'rad_config%do_sw_delta_scaling_with_gases =', &
+            rad_config%do_sw_delta_scaling_with_gases
+    endif
+
+    ! Use Exponential-Exponential cloud overlap to match original IFS
+    ! implementation of Raisanen cloud generator
+    rad_config%i_overlap_scheme = IOverlapExponentialRandom
+    if (lprint_setp) then
+      print*,'rad_config%i_overlap_scheme =', rad_config%i_overlap_scheme
+    endif
+
+    ! *** SETUP AEROSOLS ***
+! AI ATTENTION 
+!    rad_config%use_aerosols = .TRUE. !(ifs)
+    rad_config%use_aerosols = .FALSE.
+    if (lprint_setp) then
+      print*,'rad_config%use_aerosols =', rad_config%use_aerosols
+    endif
+
+!    IF (YRERAD%NAERMACC > 0) THEN
+      ! Using MACC climatology - in this case the aerosol optics file
+      ! will be chosen automatically
+
+      ! 12 IFS aerosol classes: 1-3 Sea salt, 4-6 Boucher desert dust,
+      ! 7 hydrophilic organics, 8 hydrophobic organics, 9&10
+      ! hydrophobic black carbon, 11 ammonium sulphate, 12 inactive
+      ! SO2
+      rad_config%n_aerosol_types = 12
+      if (lprint_setp) then
+        print*,'rad_config%n_aerosol_types =', rad_config%n_aerosol_types
+      endif
+
+      ! Indices to the aerosol optical properties in
+      ! aerosol_ifs_rrtm_*.nc, for each class, where negative numbers
+      ! index hydrophilic aerosol types and positive numbers index
+      ! hydrophobic aerosol types
+      rad_config%i_aerosol_type_map = 0 ! There can be up to 256 types
+!      if (lprint_setp) then
+!        print*,'rad_config%i_aerosol_type_map =', rad_config%i_aerosol_type_map
+!      endif
+
+      rad_config%i_aerosol_type_map(1:12) = (/ &
+           &  -1, &  ! Sea salt, size bin 1 (OPAC)
+           &  -2, &  ! Sea salt, size bin 2 (OPAC)
+           &  -3, &  ! Sea salt, size bin 3 (OPAC)
+           &   7, &  ! Desert dust, size bin 1 (Woodward 2001)
+           &   8, &  ! Desert dust, size bin 2 (Woodward 2001)
+           &   9, &  ! Desert dust, size bin 3 (Woodward 2001)
+           &  -4, &  ! Hydrophilic organic matter (OPAC)
+           &  10, &  ! Hydrophobic organic matter (OPAC)
+           &  11, &  ! Black carbon (Boucher)
+           &  11, &  ! Black carbon (Boucher)
+           &  -5, &  ! Ammonium sulphate (OPAC)
+           &  14 /)  ! Stratospheric sulphate (hand edited from OPAC)
+!     if (lprint_setp) then
+!       print*,'rad_config%i_aerosol_type_map =', rad_config%i_aerosol_type_map
+!     endif
+
+      ! Background aerosol mass-extinction coefficients are obtained
+      ! after the configuration files have been read - see later in
+      ! this routine.
+
+!    ELSE
+      ! Using Tegen climatology
+!      rad_config%n_aerosol_types = 6
+!      rad_config%i_aerosol_type_map = 0 ! There can be up to 256 types
+!      rad_config%i_aerosol_type_map(1:6) = (/ &
+!           &  1, &  ! Continental background
+!           &  2, &  ! Maritime
+!           &  3, &  ! Desert
+!           &  4, &  ! Urban
+ !          &  5, &  ! Volcanic active
+!           &  6 /)  ! Stratospheric background
+
+      ! Manually set the aerosol optics file name (the directory will
+      ! be added automatically)
+!      rad_config%aerosol_optics_override_file_name = 'aerosol_ifs_rrtm_tegen.nc'
+!    ENDIF
+
+    ! *** SETUP SOLVER ***
+
+    ! 3D effects are off by default (ifs)
+    rad_config%do_3d_effects = .TRUE.
+    if (lprint_setp) then
+      print*,'rad_config%do_3d_effects=', rad_config%do_3d_effects
+    endif
+
+    ! Select longwave solver
+! AI ATTENTION
+!    SELECT CASE (YRERAD%NLWSOLVER)
+!    CASE(0)
+!      rad_config%i_solver_lw = ISolverMcICA
+!    CASE(1)
+      rad_config%i_solver_lw = ISolverSpartacus
+      if (lprint_setp) then
+        print*,'rad_config%i_solver_lw =', rad_config%i_solver_lw
+      endif
+
+!    CASE(2)
+!      rad_config%i_solver_lw = ISolverSpartacus
+!      rad_config%do_3d_effects = .TRUE.
+!    CASE DEFAULT
+!      WRITE(NULERR,'(a,i0)') 'Unknown value for NLWSOLVER: ', YRERAD%NLWSOLVER
+!      CALL ABOR1('RADIATION_SETUP: error interpreting NLWSOLVER')
+!    END SELECT
+
+    ! Select shortwave solver
+!    SELECT CASE (YRERAD%NSWSOLVER)
+!    CASE(0)
+!      rad_config%i_solver_sw = ISolverMcICA
+!    CASE(1)
+      rad_config%i_solver_sw = ISolverSpartacus
+      if (lprint_setp) then
+        print*,'rad_config%i_solver_sw =', rad_config%i_solver_sw
+      endif
+
+!      rad_config%do_3d_effects = .FALSE.
+!      IF (YRERAD%NLWSOLVER == 2) THEN
+!        CALL ABOR1('RADIATION_SETUP: cannot represent 3D effects in LW but not SW')
+!      ENDIF
+!    CASE(2)
+!      rad_config%i_solver_sw = ISolverSpartacus
+!      rad_config%do_3d_effects = .TRUE.
+!      IF (YRERAD%NLWSOLVER == 1) THEN
+!        CALL ABOR1('RADIATION_SETUP: cannot represent 3D effects in SW but not LW')
+!      ENDIF
+!    CASE DEFAULT
+!      WRITE(NULERR,'(a,i0)') 'Unknown value for NSWSOLVER: ', YRERAD%NSWSOLVER
+!      CALL ABOR1('RADIATION_SETUP: error interpreting NSWSOLVER')
+!    END SELECT
+
+    ! SPARTACUS solver requires delta scaling to be done separately
+    ! for clouds & aerosols
+    IF (rad_config%i_solver_sw == ISolverSpartacus) THEN
+      rad_config%do_sw_delta_scaling_with_gases = .FALSE.
+    ENDIF
+
+    ! Do we represent longwave scattering?
+    rad_config%do_lw_cloud_scattering = .TRUE.
+    rad_config%do_lw_aerosol_scattering = .TRUE.
+    if (lprint_setp) then
+      print*,'rad_config%do_lw_cloud_scattering =', &
+           rad_config%do_lw_cloud_scattering
+      print*,'rad_config%do_lw_aerosol_scattering =', &
+           rad_config%do_lw_aerosol_scattering
+    endif
+
+!    SELECT CASE (YRERAD%NLWSCATTERING)
+!    CASE(1)
+!      rad_config%do_lw_cloud_scattering = .TRUE.
+!    CASE(2)
+!      rad_config%do_lw_cloud_scattering = .TRUE.
+!      IF (YRERAD%NAERMACC > 0) THEN
+        ! Tegen climatology omits data required to do longwave
+        ! scattering by aerosols, so only turn this on with a more
+        ! recent scattering database
+!      ENDIF
+!    END SELECT
+
+
+    ! *** IMPLEMENT SETTINGS ***
+
+    ! For advanced configuration, the configuration data for the
+    ! "radiation" project can specified directly in the namelist.
+    ! However, the variable naming convention is not consistent with
+    ! the rest of the IFS.  For basic configuration there are specific
+    ! variables in the NAERAD namelist available in the YRERAD
+    ! structure.
+!    CALL POSNAME(NULNAM, 'RADIATION', ISTAT)
+!    SELECT CASE (ISTAT)
+!      CASE(0)
+!        CALL rad_config%read(unit=NULNAM)
+!      CASE(1)
+!        WRITE(NULOUT,'(a)') 'Namelist RADIATION not found, using settings from NAERAD only'
+!      CASE DEFAULT
+!        CALL ABOR1('RADIATION_SETUP: error reading RADIATION section of namelist file')
+!    END SELECT
+
+! AI ATTENTION test
+    file_name="namelist_ecrad"
+    call rad_config%read(file_name=file_name)
+
+    ! Print configuration
+!    IF (IVERBOSESETUP > 1) THEN
+!      WRITE(NULOUT,'(a)') 'Radiation scheme settings:'
+!      CALL rad_config%print(IVERBOSE=IVERBOSESETUP)
+!    ENDIF
+
+    ! Use configuration data to set-up radiation scheme, including
+    ! reading scattering datafiles
+    CALL setup_radiation(rad_config)
+
+    ! Populate the mapping between the 14 RRTM shortwave bands and the
+    ! 6 albedo inputs. The mapping according to the stated wavelength
+    ! ranges of the 6-band model does not match the hard-wired mapping
+    ! in NMPSRTM, but only the hard-wired values produce sensible
+    ! results...
+    ! Note that NMPSRTM(:)=(/  6, 6, 5, 5, 5, 5, 5, 4, 4, 3, 2, 2, 1, 6 /)
+! AI
+!!    NMPSRTM(:)=(/ 6, 6, 5, 5, 5, 5, 5, 4, 4, 3, 2, 2, 1, 6 /)
+!!    rad_config%i_albedo_from_band_sw = NMPSRTM
+    !call rad_config%define_sw_albedo_intervals(6, &
+    !         &  (/ 0.25e-6_jprb, 0.44e-6_jprb, 1.19e-6_jprb, &
+    !         &     2.38e-6_jprb, 4.00e-6_jprb /),  (/ 1,2,3,4,5,6 /))
+    
+    ! Likewise between the 16 RRTM longwave bands and the 2 emissivity
+    ! inputs (info taken from rrtm_ecrt_140gp_mcica.F90) representing
+    ! outside and inside the window region of the spectrum
+!     rad_config%i_emiss_from_band_lw = (/ 1,1,1,1,1,2,2,2,1,1,1,1,1,1,1,1 /)
+! AI
+!!    call rad_config%define_lw_emiss_intervals(3, &
+!!         &  (/ 8.0e-6_jprb,13.0e-6_jprb /),  (/ 1,2,1 /))
+
+!    ! Get spectral weightings for UV and PAR
+!!    call rad_config%get_sw_weights(0.2e-6_jprb, 0.4415e-6_jprb, &
+!!         &  NWEIGHT_UV, IBAND_UV, WEIGHT_UV, 'ultraviolet')
+!!    call rad_config%get_sw_weights(0.4e-6_jprb, 0.7e-6_jprb, &
+!!         &  NWEIGHT_PAR, IBAND_PAR, WEIGHT_PAR, &
+!!         &  'photosynthetically active radiation, PAR')
+
+!    IF (YRERAD%NAERMACC > 0) THEN
+      ! With the MACC aerosol climatology we need to add in the
+      ! background aerosol afterwards using the Tegen arrays.  In this
+      ! case we first configure the background aerosol mass-extinction
+      ! coefficient at 550 nm, which corresponds to the 10th RRTMG
+      ! shortwave band.
+!      TROP_BG_AER_MASS_EXT  = dry_aerosol_sw_mass_extinction(rad_config, &
+!           &                                   ITYPE_TROP_BG_AER, 10)
+!      STRAT_BG_AER_MASS_EXT = dry_aerosol_sw_mass_extinction(rad_config, &
+!           &                                   ITYPE_STRAT_BG_AER, 10)
+      
+!      WRITE(NULOUT,'(a,i0)') 'Tropospheric bacground uses aerosol type ', &
+!           &                 ITYPE_TROP_BG_AER
+!      WRITE(NULOUT,'(a,i0)') 'Stratospheric bacground uses aerosol type ', &
+!           &                 ITYPE_STRAT_BG_AER
+!    ENDIF     
+      
+    IF (IVERBOSESETUP > 1) THEN
+      WRITE(NULOUT,'(a)') '-------------------------------------------------------------------------------'
+    ENDIF
+
+    IF (LHOOK) CALL DR_HOOK('RADIATION_SETUP:SETUP_RADIATION_SCHEME',1,ZHOOK_HANDLE)
+
+  END SUBROUTINE SETUP_RADIATION_SCHEME
+
+END MODULE RADIATION_SETUP
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_single_level.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_single_level.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_single_level.F90	(revision 3908)
@@ -0,0 +1,371 @@
+! radiation_single_level.F90 - Derived type for single-level fields
+!
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2019-01-14  R. Hogan  Added out_of_physical_bounds routine
+!   2019-01-18  R. Hogan  Added weighted albedo mapping
+
+module radiation_single_level
+
+  use parkind1, only : jprb
+
+  implicit none
+  public
+
+  !---------------------------------------------------------------------
+  ! Derived type to contain variables that don't vary with height;
+  ! mostly they are surface properties
+  type single_level_type
+    ! Note that skin temperature is only defined if
+    ! is_simple_surface==.true.
+    real(jprb), allocatable, dimension(:) :: &
+         &   cos_sza, &       ! (ncol) Cosine of solar zenith angle
+         &   skin_temperature ! (ncol) Skin temperature (K)
+
+    ! Shortwave albedo: if sw_albedo_direct is not allocated then
+    ! sw_albedo will be used for both direct and diffuse solar
+    ! radiation; otherwise, sw_albedo will be used for diffuse
+    ! radiation and sw_albedo_direct for direct radiation.
+    real(jprb), allocatable, dimension(:,:) :: &
+         &   sw_albedo, &        ! (ncol,nalbedobands)
+         &   sw_albedo_direct    ! (ncol,nalbedobands) 
+    
+    ! If is_simple_surface==.true., we provide longwave emissivity
+    ! coarser spectral intervals, while if
+    ! is_simple_surface==.false. it will be generated by the surface
+    ! radiation scheme and may optionally be on the full spectral grid
+    ! of the atmospheric model.
+    real(jprb), allocatable, dimension(:,:) :: &
+         &   lw_emissivity       ! (ncol,nemissbands) If
+    ! is_simple_surface==.false. then we specify the emission instead
+    ! of the skin temperature, and again this may be on the emissivity
+    ! bands or the full spectral grid
+    real(jprb), allocatable, dimension(:,:) :: &
+         &   lw_emission         ! (ncol,nemissbands)
+
+    ! Incoming solar irradiance at the Earth is specified as the total
+    ! across the shortwave spectrum. Note that this needs to be
+    ! adjusted for Earth-Sun distance, solar cycle etc. To get
+    ! normalized fluxes out, simply set this to 1.0.
+    real(jprb) :: solar_irradiance = 1366.0_jprb ! W m-2
+
+    ! If config%use_spectral_solar_irradiance==true then this will be
+    ! scaled by spectral_solar_scaling
+    real(jprb), allocatable, dimension(:) :: &
+         &   spectral_solar_scaling ! (n_bands_sw)
+ 
+    ! Seed for random number generator in McICA; it is expected that
+    ! the host model generates this from the model time, longitude
+    ! and latitude, in order that the model is deterministic
+    integer, allocatable, dimension(:) :: iseed ! (ncol)
+
+    ! Is the underlying surface a simple single "flat" tile? If so we
+    ! describe it with skin_temperature and lw_emissivity. Otherwise
+    ! we describe it with lw_emission and lw_emissivity coming out of
+    ! the surface radiation scheme.
+    logical :: is_simple_surface = .true.
+
+    ! If is_simple_surface==.false., do we use the full number of g
+    ! points for dimensioning sw_albedo, sw_albedo_direct and
+    ! lw_emission?
+    !logical :: use_full_spectrum_sw = .false.
+    !logical :: use_full_spectrum_lw = .true.
+
+  contains
+    procedure :: allocate   => allocate_single_level
+    procedure :: deallocate => deallocate_single_level
+    procedure :: init_seed_simple
+    procedure :: get_albedos
+    procedure :: out_of_physical_bounds
+
+  end type single_level_type
+
+contains
+  
+  !---------------------------------------------------------------------
+  subroutine allocate_single_level(this, ncol, nalbedobands, nemisbands, &
+       &                           use_sw_albedo_direct, is_simple_surface)
+
+    use yomhook, only : lhook, dr_hook
+
+    class(single_level_type), intent(inout) :: this
+    integer,                  intent(in)    :: ncol, nalbedobands, nemisbands
+    logical,        optional, intent(in)    :: use_sw_albedo_direct
+    logical,        optional, intent(in)    :: is_simple_surface
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_single_level:allocate',0,hook_handle)
+
+    call this%deallocate()
+
+    if (present(is_simple_surface)) then
+      this%is_simple_surface = is_simple_surface
+    else
+      this%is_simple_surface = .true.
+    end if
+
+    allocate(this%cos_sza(ncol))
+
+    if (this%is_simple_surface) then
+      allocate(this%skin_temperature(ncol))
+    else
+      allocate(this%lw_emission(ncol, nemisbands))
+    end if
+    allocate(this%lw_emissivity(ncol, nemisbands))
+
+    allocate(this%sw_albedo(ncol, nalbedobands))
+
+    if (present(use_sw_albedo_direct)) then
+      if (use_sw_albedo_direct) then
+        allocate(this%sw_albedo_direct(ncol, nalbedobands))
+      end if
+    end if
+
+    allocate(this%iseed(ncol))
+
+    if (lhook) call dr_hook('radiation_single_level:allocate',1,hook_handle)
+
+  end subroutine allocate_single_level
+
+
+  !---------------------------------------------------------------------
+  subroutine deallocate_single_level(this)
+
+    use yomhook, only : lhook, dr_hook
+
+    class(single_level_type), intent(inout) :: this
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_single_level:deallocate',0,hook_handle)
+
+    if (allocated(this%cos_sza)) then
+      deallocate(this%cos_sza)
+    end if
+    if (allocated(this%skin_temperature)) then
+      deallocate(this%skin_temperature)
+    end if
+    if (allocated(this%sw_albedo)) then
+      deallocate(this%sw_albedo)
+    end if
+    if (allocated(this%sw_albedo_direct)) then
+      deallocate(this%sw_albedo_direct)
+    end if
+    if (allocated(this%lw_emissivity)) then
+      deallocate(this%lw_emissivity)
+    end if
+    if (allocated(this%lw_emission)) then
+      deallocate(this%lw_emission)
+    end if
+    if (allocated(this%spectral_solar_scaling)) then
+      deallocate(this%spectral_solar_scaling)
+    end if
+    if (allocated(this%iseed)) then
+      deallocate(this%iseed)
+    end if
+
+    if (lhook) call dr_hook('radiation_single_level:deallocate',1,hook_handle)
+
+  end subroutine deallocate_single_level
+
+
+  !---------------------------------------------------------------------
+  ! Unimaginative initialization of random-number seeds
+  subroutine init_seed_simple(this, istartcol, iendcol)
+    class(single_level_type), intent(inout) :: this
+    integer, intent(in)                     :: istartcol, iendcol
+
+    integer :: jcol
+
+    if (.not. allocated(this%iseed)) then
+      allocate(this%iseed(istartcol:iendcol))
+    end if
+
+    do jcol = istartcol,iendcol
+      this%iseed(jcol) = jcol
+    end do
+  end subroutine init_seed_simple
+
+
+  !---------------------------------------------------------------------
+  ! Extract the shortwave and longwave surface albedos in each g-point
+  subroutine get_albedos(this, istartcol, iendcol, config, &
+       &                 sw_albedo_direct, sw_albedo_diffuse, lw_albedo)
+
+    use radiation_config, only : config_type
+    use radiation_io,     only : nulerr, radiation_abort
+    use yomhook,          only : lhook, dr_hook
+
+    class(single_level_type), intent(in) :: this
+    type(config_type),        intent(in) :: config
+    integer,                  intent(in) :: istartcol, iendcol
+
+    ! The longwave albedo of the surface in each longwave g-point;
+    ! note that these are weighted averages of the values from
+    ! individual tiles
+    real(jprb), intent(out), optional &
+         &  :: lw_albedo(config%n_g_lw, istartcol:iendcol)
+
+    ! Direct and diffuse shortwave surface albedo in each shortwave
+    ! g-point; note that these are weighted averages of the values
+    ! from individual tiles
+    real(jprb), intent(out), dimension(config%n_g_sw, istartcol:iendcol) &
+         &  :: sw_albedo_direct, sw_albedo_diffuse
+
+    ! Temporary storage of albedo in ecRad bands
+    real(jprb) :: sw_albedo_band(istartcol:iendcol, config%n_bands_sw)
+    real(jprb) :: lw_albedo_band (istartcol:iendcol, config%n_bands_lw)
+
+    ! Number of albedo bands
+    integer :: nalbedoband
+
+    ! Loop indices for ecRad bands and albedo bands
+    integer :: jband, jalbedoband
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_single_level:get_albedos',0,hook_handle)
+
+    ! Albedos/emissivities are stored in single_level in their own
+    ! spectral intervals and with column as the first dimension
+    if (config%use_canopy_full_spectrum_sw) then
+      ! Albedos provided in each g point
+      sw_albedo_diffuse = transpose(this%sw_albedo(istartcol:iendcol,:))
+      if (allocated(this%sw_albedo_direct)) then
+        sw_albedo_direct = transpose(this%sw_albedo_direct(istartcol:iendcol,:))
+      end if
+    elseif (.not. config%do_nearest_spectral_sw_albedo) then
+      ! Albedos averaged accurately to ecRad spectral bands
+      nalbedoband = size(config%sw_albedo_weights,1)
+      sw_albedo_band = 0.0_jprb
+      do jband = 1,config%n_bands_sw
+        do jalbedoband = 1,nalbedoband
+          if (config%sw_albedo_weights(jalbedoband,jband) /= 0.0_jprb) then
+            sw_albedo_band(istartcol:iendcol,jband) &
+                 &  = sw_albedo_band(istartcol:iendcol,jband) & 
+                 &  + config%sw_albedo_weights(jalbedoband,jband) &
+                 &    * this%sw_albedo(istartcol:iendcol, jalbedoband)
+          end if
+        end do
+      end do
+
+      sw_albedo_diffuse = transpose(sw_albedo_band(istartcol:iendcol, &
+           &                              config%i_band_from_reordered_g_sw))
+      if (allocated(this%sw_albedo_direct)) then
+        sw_albedo_band = 0.0_jprb
+        do jband = 1,config%n_bands_sw
+          do jalbedoband = 1,nalbedoband
+            if (config%sw_albedo_weights(jalbedoband,jband) /= 0.0_jprb) then
+              sw_albedo_band(istartcol:iendcol,jband) &
+                   &  = sw_albedo_band(istartcol:iendcol,jband) & 
+                   &  + config%sw_albedo_weights(jalbedoband,jband) &
+                   &    * this%sw_albedo_direct(istartcol:iendcol, jalbedoband)
+            end if
+          end do
+        end do
+        sw_albedo_direct = transpose(sw_albedo_band(istartcol:iendcol, &
+             &                             config%i_band_from_reordered_g_sw))
+      else
+        sw_albedo_direct = sw_albedo_diffuse
+      end if
+    else
+      ! Albedos mapped less accurately to ecRad spectral bands
+      sw_albedo_diffuse = transpose(this%sw_albedo(istartcol:iendcol, &
+           &  config%i_albedo_from_band_sw(config%i_band_from_reordered_g_sw)))
+      if (allocated(this%sw_albedo_direct)) then
+        sw_albedo_direct = transpose(this%sw_albedo_direct(istartcol:iendcol, &
+             &  config%i_albedo_from_band_sw(config%i_band_from_reordered_g_sw)))
+      else
+        sw_albedo_direct = sw_albedo_diffuse
+      end if
+    end if
+
+    if (present(lw_albedo)) then
+      if (config%use_canopy_full_spectrum_lw) then
+        if (config%n_g_lw /= size(this%lw_emissivity,2)) then
+          write(nulerr,'(a)') '*** Error: single_level%lw_emissivity has the wrong number of spectral intervals'
+          call radiation_abort()   
+        end if
+        lw_albedo = 1.0_jprb - transpose(this%lw_emissivity(istartcol:iendcol,:))
+      else if (.not. config%do_nearest_spectral_lw_emiss) then
+        ! Albedos averaged accurately to ecRad spectral bands
+        nalbedoband = size(config%lw_emiss_weights,1)
+        lw_albedo_band = 0.0_jprb
+        do jband = 1,config%n_bands_lw
+          do jalbedoband = 1,nalbedoband
+            if (config%lw_emiss_weights(jalbedoband,jband) /= 0.0_jprb) then
+              lw_albedo_band(istartcol:iendcol,jband) &
+                   &  = lw_albedo_band(istartcol:iendcol,jband) & 
+                   &  + config%lw_emiss_weights(jalbedoband,jband) &
+                   &    * (1.0_jprb-this%lw_emissivity(istartcol:iendcol, jalbedoband))
+            end if
+          end do
+        end do
+
+        lw_albedo = transpose(lw_albedo_band(istartcol:iendcol, &
+             &                config%i_band_from_reordered_g_lw))
+      else
+        lw_albedo = 1.0_jprb - transpose(this%lw_emissivity(istartcol:iendcol, &
+             &  config%i_emiss_from_band_lw(config%i_band_from_reordered_g_lw)))
+      end if
+    end if
+
+    if (lhook) call dr_hook('radiation_single_level:get_albedos',1,hook_handle)
+
+  end subroutine get_albedos
+
+
+  !---------------------------------------------------------------------
+  ! Return .true. if the contents of a single_level structure are out
+  ! of a physically sensible range, optionally only considering only
+  ! columns between istartcol and iendcol
+  function out_of_physical_bounds(this, istartcol, iendcol, do_fix) result(is_bad)
+
+    use yomhook,          only : lhook, dr_hook
+    use radiation_config, only : out_of_bounds_1d, out_of_bounds_2d
+
+    class(single_level_type), intent(inout) :: this
+    integer,         optional,intent(in) :: istartcol, iendcol
+    logical,         optional,intent(in) :: do_fix
+    logical                              :: is_bad
+
+    logical    :: do_fix_local
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_single_level:out_of_physical_bounds',0,hook_handle)
+
+    if (present(do_fix)) then
+      do_fix_local = do_fix
+    else
+      do_fix_local = .false.
+    end if
+
+    is_bad =    out_of_bounds_1d(this%cos_sza, "cos_sza", -1.0_jprb, 1.0_jprb, &
+         &                       do_fix_local, i1=istartcol, i2=iendcol) &
+         & .or. out_of_bounds_1d(this%skin_temperature, "skin_temperature", 173.0_jprb, 373.0_jprb, &
+         &                       do_fix_local, i1=istartcol, i2=iendcol) &
+         & .or. out_of_bounds_2d(this%sw_albedo, "sw_albedo", 0.0_jprb, 1.0_jprb, &
+         &                       do_fix_local, i1=istartcol, i2=iendcol) &
+         & .or. out_of_bounds_2d(this%sw_albedo_direct, "sw_albedo", 0.0_jprb, 1.0_jprb, &
+         &                       do_fix_local, i1=istartcol, i2=iendcol) &
+         & .or. out_of_bounds_2d(this%lw_emissivity, "lw_emissivity", 0.0_jprb, 1.0_jprb, &
+         &                       do_fix_local, i1=istartcol, i2=iendcol)
+
+    if (lhook) call dr_hook('radiation_single_level:out_of_physical_bounds',1,hook_handle)
+
+  end function out_of_physical_bounds
+
+end module radiation_single_level
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_spartacus_lw.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_spartacus_lw.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_spartacus_lw.F90	(revision 3908)
@@ -0,0 +1,1085 @@
+! radiation_spartacus_lw.F90 - SPARTACUS longwave solver
+!
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2017-04-11  R. Hogan  Receive emission/albedo rather than planck/emissivity
+!   2017-04-22  R. Hogan  Store surface fluxes at all g-points
+!   2018-09-03  R. Hogan  Security via min_cloud_effective_size
+!   2018-10-08  R. Hogan  Call calc_region_properties
+!   2019-01-12  R. Hogan  Use inv_inhom_effective_size if allocated
+
+module radiation_spartacus_lw
+
+  public
+
+contains
+
+  ! Small routine for scaling cloud optical depth in the cloudy
+  ! regions
+#include "radiation_optical_depth_scaling.h"
+
+  ! This module contains just one subroutine, the longwave solver
+  ! using the Speedy Algorithm for Radiative Transfer through Cloud
+  ! Sides (SPARTACUS), which can represent 3D effects using a matrix
+  ! form of the two-stream equations.
+  !
+  ! Sections:
+  !   1: Prepare general variables and arrays
+  !   2: Prepare column-specific variables and arrays
+  !   3: First loop over layers
+  !     3.1: Layer-specific initialization
+  !     3.2: Compute gamma variables
+  !       3.2a: Clear-sky case
+  !       3.2b: Cloudy case
+  !     3.3: Compute reflection, transmission and emission
+  !       3.3a: g-points with 3D effects
+  !       3.3b: g-points without 3D effects
+  !   4: Compute total sources and albedos
+  !   5: Compute fluxes
+  subroutine solver_spartacus_lw(nlev,istartcol,iendcol, &
+       &  config, thermodynamics, cloud, & 
+       &  od, ssa, g, od_cloud, ssa_cloud, g_cloud, planck_hl, &
+       &  emission, albedo, &
+       &  flux)
+
+    use parkind1,                 only : jprb
+    use yomhook,                  only : lhook, dr_hook
+
+    use radiation_io,             only : nulout
+    use radiation_config,         only : config_type, IPdfShapeGamma
+    use radiation_thermodynamics, only : thermodynamics_type
+    use radiation_cloud,          only : cloud_type
+    use radiation_regions,        only : calc_region_properties
+    use radiation_overlap,        only : calc_overlap_matrices
+    use radiation_flux,           only : flux_type, indexed_sum
+    use radiation_matrix
+    use radiation_two_stream,     only : calc_two_stream_gammas_lw, &
+         calc_reflectance_transmittance_lw, LwDiffusivity
+    use radiation_lw_derivatives, only : calc_lw_derivatives_matrix
+    use radiation_constants,      only : Pi, GasConstantDryAir, &
+         AccelDueToGravity
+
+    implicit none
+
+    ! Inputs
+    integer, intent(in) :: nlev               ! number of model levels
+    integer, intent(in) :: istartcol, iendcol ! range of columns to process
+    type(config_type), intent(in)        :: config
+    type(thermodynamics_type),intent(in) :: thermodynamics
+    type(cloud_type),   intent(in)       :: cloud
+
+    ! Gas and aerosol optical depth of each layer at each longwave
+    ! g-point
+    real(jprb), intent(in), dimension(config%n_g_lw,nlev,istartcol:iendcol) :: od
+
+    ! Gas and aerosol single-scattering albedo and asymmetry factor,
+    ! only if longwave scattering by aerosols is to be represented
+    real(jprb), intent(in), &
+         &  dimension(config%n_g_lw_if_scattering,nlev,istartcol:iendcol) :: ssa, g
+
+    ! Cloud and precipitation optical depth of each layer in each
+    ! longwave band
+    real(jprb), intent(in) :: od_cloud(config%n_bands_lw,nlev,istartcol:iendcol)
+
+    ! Cloud and precipitation single-scattering albedo and asymmetry
+    ! factor, only if longwave scattering by clouds is to be
+    ! represented
+    real(jprb), intent(in), dimension(config%n_bands_lw_if_scattering, &
+         &                            nlev,istartcol:iendcol) :: ssa_cloud, g_cloud
+
+    ! Planck function (emitted flux from a black body) at half levels
+    real(jprb), intent(in), dimension(config%n_g_lw,nlev+1,istartcol:iendcol) &
+         &  :: planck_hl
+
+    ! Emission (Planck*emissivity) and albedo (1-emissivity) at the
+    ! surface at each longwave g-point
+    real(jprb), intent(in), dimension(config%n_g_lw, istartcol:iendcol) &
+         &  :: emission, albedo
+
+    ! Output
+    type(flux_type),          intent(inout):: flux
+
+    integer :: nreg, ng
+    integer :: nregActive ! =1 in clear layer, =nreg in a cloudy layer
+    integer :: jcol, jlev, jg, jreg, iband, jreg2
+    integer :: ng3D ! Number of g-points with small enough gas optical
+                    ! depth that 3D effects need to be represented
+
+    ! Ratio of gas constant for dry air to acceleration due to gravity
+    real(jprb), parameter &
+         &  :: R_over_g = GasConstantDryAir / AccelDueToGravity
+
+    ! Used in computing rates of lateral radiation transfer
+    real(jprb), parameter :: four_over_pi = 4.0_jprb / Pi
+
+    ! The tangent of the effective zenith angle for diffuse radiation
+    ! that is appropriate for 3D transport
+    real(jprb), parameter :: tan_diffuse_angle_3d = Pi * 0.5_jprb
+    ! Incorrect value of tand(53) used by Hogan & Shonk (2013)
+    !    real(jprb), parameter :: tan_diffuse_angle_3d = 1.32704482162041
+
+    ! Optical depth, single scattering albedo and asymmetry factor in
+    ! each region at each g-point
+    real(jprb), dimension(config%n_g_lw, config%nregions) &
+         &  :: od_region, ssa_region, g_region
+
+    ! Scattering optical depths of gases and clouds
+    real(jprb) :: scat_od, scat_od_cloud
+
+    ! The area fractions of each region
+    real(jprb) :: region_fracs(1:config%nregions,nlev,istartcol:iendcol)
+
+    ! The scaling used for the optical depth in the cloudy regions
+    real(jprb) :: od_scaling(2:config%nregions,nlev,istartcol:iendcol)
+
+    ! The length of the interface between regions per unit area of
+    ! gridbox, equal to L_diff^ab in Hogan and Shonk (2013). This is
+    ! actually the effective length oriented to a photon with random
+    ! azimuth angle. The three values are the edge length between
+    ! regions a-b, b-c and a-c.
+    real(jprb) :: edge_length(3)
+
+    ! Element i,j gives the rate of 3D transfer of diffuse
+    ! radiation from region i to region j, multiplied by the thickness
+    ! of the layer in m
+    real(jprb) :: transfer_rate(config%nregions,config%nregions)
+
+    ! Directional overlap matrices defined at all layer interfaces
+    ! including top-of-atmosphere and the surface
+    real(jprb), dimension(config%nregions,config%nregions,nlev+1,istartcol:iendcol) &
+         &  :: u_matrix, v_matrix
+
+    ! Two-stream variables
+    real(jprb), dimension(config%n_g_lw, config%nregions) &
+         &  :: gamma1, gamma2
+
+    ! Matrix Gamma multiplied by the layer thickness z1, so units
+    ! metres.  After calling expm, this array contains the matrix
+    ! exponential of the original.
+    real(jprb), dimension(config%n_g_lw, 2*config%nregions, &
+         &  2*config%nregions) :: Gamma_z1
+
+    ! Diffuse reflection and transmission matrices of each layer
+    real(jprb), dimension(config%n_g_lw, config%nregions, &
+         &  config%nregions, nlev) :: reflectance, transmittance
+
+    ! Clear-sky diffuse reflection and transmission matrices of each
+    ! layer
+    real(jprb), dimension(config%n_g_lw, nlev) :: ref_clear, trans_clear
+
+    ! If the Planck term at the top of a layer in each region is the
+    ! vector b0 then the following is vector [-b0; b0]*dz
+    real(jprb), dimension(config%n_g_lw,2*config%nregions) :: planck_top
+
+    ! The difference between the Planck terms at the bottom and top of
+    ! a layer, doubled as with planck_top; in terms of b' in the
+    ! paper, planck_diff is [-b'; b']*dz*dz
+    real(jprb), dimension(config%n_g_lw,2*config%nregions) :: planck_diff
+
+    ! Parts of the particular solution associated with the
+    ! inhomogeneous ODE. In terms of quantities from the paper,
+    ! solution0 is [c0;d0] and solution_diff is [c';d']*dz.
+    real(jprb), dimension(config%n_g_lw,2*config%nregions) &
+         &  :: solution0, solution_diff
+
+    ! Used for computing the Planck emission per layer
+    real(jprb), dimension(config%n_g_lw,config%nregions) &
+         &  :: tmp_vectors
+
+    ! The fluxes upwelling from the top of a layer (source_up) and
+    ! downwelling from the bottom of the layer (source_dn) due to
+    ! emission
+    real(jprb), dimension(config%n_g_lw, config%nregions, nlev) &
+         &  :: source_up, source_dn
+    ! ...clear-sky equivalents
+    real(jprb), dimension(config%n_g_lw, nlev) &
+         &  :: source_up_clear, source_dn_clear
+
+    ! Upwelling radiation just above a layer interface due to emission
+    ! below that interface, where level index = 1 corresponds to the
+    ! top-of-atmosphere
+    real(jprb), dimension(config%n_g_lw, config%nregions, nlev+1) &
+         &  :: total_source
+    ! ...clear-sky equivalent
+    real(jprb), dimension(config%n_g_lw, nlev+1) :: total_source_clear
+
+    ! As total_source, but just below a layer interface
+    real(jprb), dimension(config%n_g_lw, config%nregions) &
+         &  :: total_source_below
+
+    ! Total albedo of the atmosphere/surface just above a layer
+    ! interface with respect to downwelling diffuse radiation at that
+    ! interface, where level index = 1 corresponds to the
+    ! top-of-atmosphere
+    real(jprb), dimension(config%n_g_lw, config%nregions, &
+         &  config%nregions, nlev+1) :: total_albedo
+    ! ...clear-sky equivalent
+    real(jprb), dimension(config%n_g_lw, nlev+1) :: total_albedo_clear
+
+    ! As total_albedo, but just below a layer interface
+    real(jprb), dimension(config%n_g_lw, config%nregions, config%nregions) &
+         &  :: total_albedo_below
+
+    ! The following is used to store matrices of the form I-A*B that
+    ! are used on the denominator of some expressions
+    real(jprb), dimension(config%n_g_lw, config%nregions, config%nregions) &
+         &  :: denominator
+    ! Clear-sky equivalent, but actually its reciprocal to replace
+    ! some divisions by multiplications
+    real(jprb), dimension(config%n_g_lw) :: inv_denom_scalar
+
+    ! Layer depth (m)
+    real(jprb) :: dz
+
+    ! Upwelling and downwelling fluxes above/below layer interfaces
+    real(jprb), dimension(config%n_g_lw, config%nregions) &
+         &  :: flux_up_above, flux_dn_above, flux_dn_below
+    ! Clear-sky upwelling and downwelling fluxes (which don't
+    ! distinguish between whether they are above/below a layer
+    ! interface)
+    real(jprb), dimension(config%n_g_lw) :: flux_up_clear, flux_dn_clear
+
+    ! Parameterization of internal flux distribution in a cloud that
+    ! can lead to the flux just about to exit a cloud being different
+    ! from the mean in-cloud value.  "lateral_od" is the typical
+    ! absorption optical depth through the cloud in a horizontal
+    ! direction.
+    real(jprb), dimension(config%n_g_lw) :: lateral_od, sqrt_1_minus_ssa
+    real(jprb), dimension(config%n_g_lw) :: side_emiss_thick, side_emiss
+
+    ! In the optically thin limit, the flux near the edge is greater
+    ! than that in the interior
+    real(jprb), parameter :: side_emiss_thin = 1.4107
+
+    real(jprb) :: aspect_ratio
+
+    ! Keep a count of the number of calls to the two ways of computing
+    ! reflectance/transmittance matrices
+    integer :: n_calls_expm, n_calls_meador_weaver
+
+    ! Identify clear-sky layers, with pseudo layers for outer space
+    ! and below the ground, both treated as single-region clear skies
+    logical :: is_clear_sky_layer(0:nlev+1)
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_spartacus_lw:solver_spartacus_lw',0,hook_handle)
+
+    ! --------------------------------------------------------
+    ! Section 1: Prepare general variables and arrays
+    ! --------------------------------------------------------
+
+    ! Copy array dimensions to local variables for convenience
+    nreg = config%nregions
+    ng = config%n_g_lw
+
+    ! Reset count of number of calls to the two ways to compute
+    ! reflectance/transmission matrices
+    n_calls_expm = 0
+    n_calls_meador_weaver = 0
+
+    ! Initialize dz to avoid compiler warning
+    dz = 1.0_jprb
+
+    ! Compute the wavelength-independent region fractions and
+    ! optical-depth scalings
+    call calc_region_properties(nlev,nreg,istartcol,iendcol, &
+         &  config%i_cloud_pdf_shape == IPdfShapeGamma, &
+         &  cloud%fraction, cloud%fractional_std, region_fracs, &
+         &  od_scaling, config%cloud_fraction_threshold)
+
+    ! Compute wavelength-independent overlap matrices u_matrix and v_matrix
+    call calc_overlap_matrices(nlev, nreg, istartcol, iendcol, &
+         &  region_fracs, cloud%overlap_param, &
+         &  u_matrix, v_matrix, decorrelation_scaling=config%cloud_inhom_decorr_scaling, &
+         &  cloud_fraction_threshold=config%cloud_fraction_threshold, &
+         &  use_beta_overlap=config%use_beta_overlap, &
+         &  cloud_cover=flux%cloud_cover_lw)
+
+    if (config%iverbose >= 3) then
+      write(nulout,'(a)',advance='no') '  Processing columns'
+    end if
+
+    ! Main loop over columns
+    do jcol = istartcol, iendcol
+      ! --------------------------------------------------------
+      ! Section 2: Prepare column-specific variables and arrays
+      ! --------------------------------------------------------
+
+      if (config%iverbose >= 3) then
+        write(nulout,'(a)',advance='no') '.'
+      end if
+
+      ! Define which layers contain cloud; assume that
+      ! cloud%crop_cloud_fraction has already been called
+      is_clear_sky_layer = .true.
+      do jlev = 1,nlev
+        if (cloud%fraction(jcol,jlev) > 0.0_jprb) then
+          is_clear_sky_layer(jlev) = .false.
+        end if
+      end do
+
+      ! --------------------------------------------------------
+      ! Section 3: First loop over layers
+      ! --------------------------------------------------------
+      ! In this section the reflectance, transmittance and sources
+      ! are computed for each layer
+      do jlev = 1,nlev ! Start at top-of-atmosphere
+        ! --------------------------------------------------------
+        ! Section 3.1: Layer-specific initialization
+        ! --------------------------------------------------------
+        ! Array-wise assignments
+        gamma1 = 0.0_jprb
+        gamma2 = 0.0_jprb
+        Gamma_z1= 0.0_jprb
+        planck_top = 0.0_jprb
+        planck_diff = 0.0_jprb
+        transfer_rate(:,:) = 0.0_jprb
+        solution0 = 0.0_jprb
+        solution_diff = 0.0_jprb
+
+        ! Reset clear-sky absorption/scattering properties in each
+        ! region
+        od_region = 0.0_jprb
+        ssa_region = 0.0_jprb ! No Rayleigh scattering in longwave by default
+        g_region = 0.0_jprb
+
+        ! Set optical depth of clear-sky region (region 1) to the
+        ! gas/aerosol optical depth
+        od_region(1:ng,1) = od(1:ng, jlev, jcol)
+
+        ! Can't deal with zero gas optical depths, but this is now
+        ! dealt with in radiation_ifsrrtm
+        ! where (od_region(:,1) < 1.0e-15_jprb) od_region(:,1) = 1.0e-15_jprb
+
+        ! Set clear-sky single-scattering albedo and asymmetry
+        ! factor, if non-zero
+        if (config%do_lw_aerosol_scattering) then
+          ssa_region(1:ng,1) = ssa(1:ng, jlev, jcol)
+          g_region(1:ng,1)   = g(1:ng, jlev, jcol)
+        end if
+
+        ! --------------------------------------------------------
+        ! Section 3.2: Compute gamma variables
+        ! --------------------------------------------------------
+        if (is_clear_sky_layer(jlev)) then
+          ! --- Section 3.2a: Clear-sky case --------------------
+
+          nregActive = 1   ! Only region 1 (clear-sky) is active
+
+          ! Compute two-stream variables gamma1 and gamma2
+          call calc_two_stream_gammas_lw(ng, &
+               &  ssa_region(1:ng,1), g_region(1:ng,1), &
+               &  gamma1(1:ng,1), gamma2(1:ng,1))
+
+          if (config%use_expm_everywhere) then
+            ! Treat cloud-free layer as 3D: the matrix exponential
+            ! "expm" is used as much as possible (provided the
+            ! optical depth is not too high). ng3D is initially
+            ! set to the total number of g-points, then the
+            ! clear-sky optical depths are searched until a value
+            ! exceeds the threshold for treating 3D effects, and
+            ! if found it is reset to that.  Note that we are
+            ! assuming that the g-points have been reordered in
+            ! approximate order of gas optical depth.
+            ng3D = ng
+            do jg = 1, ng
+              if (od_region(jg,1) > config%max_gas_od_3D) then
+                ng3D = jg-1
+                exit
+              end if
+            end do
+          else
+            ! Otherwise treat cloud-free layer using the classical
+            ! Meador & Weaver formulae for all g-points
+            ng3D = 0
+          end if
+
+        else
+          ! --- Section 3.2b: Cloudy case -----------------------
+
+          ! Default number of g-points to treat with
+          ! matrix-exponential scheme
+          if (config%use_expm_everywhere) then
+            ng3D = ng   ! All g-points
+          else
+            ng3D = 0    ! No g-points
+          end if
+
+          ! Do we compute 3D effects; note that if we only have one
+          ! region and the sky is overcast then 3D calculations must
+          ! be turned off as there will be only one region
+          if (config%do_3d_effects .and. &
+               &  allocated(cloud%inv_cloud_effective_size) .and. &
+               &  .not. (nreg == 2 .and. cloud%fraction(jcol,jlev) &
+               &  > 1.0_jprb-config%cloud_fraction_threshold)) then
+            if (cloud%inv_cloud_effective_size(jcol,jlev) &
+                 &  > 0.0_jprb) then
+              ! 3D effects are only simulated if
+              ! inv_cloud_effective_size is defined and greater
+              ! than zero
+              ng3D = ng
+
+              ! The following is from the hydrostatic equation
+              ! and ideal gas law: dz = dp * R * T / (p * g)
+              dz = R_over_g &
+                   &  * (thermodynamics%pressure_hl(jcol,jlev+1) &
+                   &   - thermodynamics%pressure_hl(jcol,jlev)) &
+                   &  * (thermodynamics%temperature_hl(jcol,jlev) &
+                   &   + thermodynamics%temperature_hl(jcol,jlev+1)) &
+                   &  / (thermodynamics%pressure_hl(jcol,jlev) &
+                   &   + thermodynamics%pressure_hl(jcol,jlev+1))
+
+              ! Compute cloud edge length per unit area of gridbox
+              ! from rearranging Hogan & Shonk (2013) Eq. 45, but
+              ! adding a factor of (1-frac) so that a region that
+              ! fully occupies the gridbox (frac=1) has an edge of
+              ! zero. We can therefore use the fraction of clear sky,
+              ! region_fracs(1,jlev,jcol) for convenience instead. The
+              ! pi on the denominator means that this is actually edge
+              ! length with respect to a light ray with a random
+              ! azimuthal direction.
+              edge_length(1) = four_over_pi &
+                   &  * region_fracs(1,jlev,jcol)*(1.0_jprb-region_fracs(1,jlev,jcol)) &
+                   &  * min(cloud%inv_cloud_effective_size(jcol,jlev), &
+                   &        1.0_jprb / config%min_cloud_effective_size)
+              if (nreg > 2) then
+                ! The corresponding edge length between the two cloudy
+                ! regions is computed in the same way but treating the
+                ! optically denser of the two regions (region 3) as
+                ! the cloud; note that the fraction of this region may
+                ! be less than that of the optically less dense of the
+                ! two regions (region 2).  For increased flexibility,
+                ! the user may specify the effective size of
+                ! inhomogeneities separately from the cloud effective
+                ! size.
+                if (allocated(cloud%inv_inhom_effective_size)) then
+                  edge_length(2) = four_over_pi &
+                       &  * region_fracs(3,jlev,jcol)*(1.0_jprb-region_fracs(3,jlev,jcol)) &
+                       &  * min(cloud%inv_inhom_effective_size(jcol,jlev), &
+                       &        1.0_jprb / config%min_cloud_effective_size)
+                else
+                  edge_length(2) = four_over_pi &
+                       &  * region_fracs(3,jlev,jcol)*(1.0_jprb-region_fracs(3,jlev,jcol)) &
+                       &  * min(cloud%inv_cloud_effective_size(jcol,jlev), &
+                       &        1.0_jprb / config%min_cloud_effective_size)
+                end if
+                ! In the case of three regions, some of the cloud
+                ! boundary may go directly to the "thick" region
+                if (config%clear_to_thick_fraction > 0.0_jprb) then
+                  edge_length(3) = config%clear_to_thick_fraction &
+                       &  * min(edge_length(1), edge_length(2))
+                  edge_length(1) = edge_length(1) - edge_length(3)
+                  edge_length(2) = edge_length(2) - edge_length(3)
+                else 
+                  edge_length(3) = 0.0_jprb
+                end if
+              end if
+
+              do jreg = 1, nreg-1
+                ! Compute lateral transfer rate from region jreg to
+                ! jreg+1 following Hogan & Shonk (2013) Eq. 47, but
+                ! multiplied by dz because the transfer rate is
+                ! vertically integrated across the depth of the layer
+                if (region_fracs(jreg,jlev,jcol) > epsilon(1.0_jprb)) then
+                  transfer_rate(jreg,jreg+1) = dz &
+                       &  * edge_length(jreg) &
+                       &  * tan_diffuse_angle_3d / region_fracs(jreg,jlev,jcol)
+                end if
+                ! Compute transfer rate from region jreg+1 to jreg
+                if (region_fracs(jreg+1,jlev,jcol) > epsilon(1.0_jprb)) then
+                  transfer_rate(jreg+1,jreg) = dz &
+                       &  * edge_length(jreg) &
+                       &  * tan_diffuse_angle_3d / region_fracs(jreg+1,jlev,jcol)
+                end if
+              end do
+
+              ! Compute transfer rates directly between regions 1 and
+              ! 3
+              if (edge_length(3) > 0.0_jprb) then
+                if (region_fracs(1,jlev,jcol) > epsilon(1.0_jprb)) then
+                  transfer_rate(1,3) = dz &
+                       &  * edge_length(3) &
+                       &  * tan_diffuse_angle_3d / region_fracs(1,jlev,jcol)
+                end if
+                if (region_fracs(3,jlev,jcol) > epsilon(1.0_jprb)) then
+                  transfer_rate(3,1) = dz &
+                       &  * edge_length(3) &
+                       &  * tan_diffuse_angle_3d / region_fracs(3,jlev,jcol)
+                end if
+              end if
+
+              ! Don't allow the transfer rate out of a region to be
+              ! equivalent to a loss of exp(-10) through the layer
+              where (transfer_rate > config%max_3d_transfer_rate) 
+                transfer_rate = config%max_3d_transfer_rate
+              end where
+            end if ! Cloud has edge length required for 3D effects
+          end if ! Include 3D effects
+
+          ! In a cloudy layer the number of active regions equals
+          ! the number of regions
+          nregActive = nreg
+
+          ! Compute scattering properties of the regions at each
+          ! g-point, mapping from the cloud properties
+          ! defined in each band.
+          do jg = 1,ng
+            ! Mapping from g-point to band
+            iband = config%i_band_from_reordered_g_lw(jg)
+
+            ! Scattering optical depth of clear-sky region
+            scat_od = od_region(jg,1)*ssa_region(jg,1)
+
+            ! Loop over cloudy regions
+            do jreg = 2,nreg
+              ! Add scaled cloud optical depth to clear-sky value
+              od_region(jg,jreg) = od_region(jg,1) &
+                   &  + od_cloud(iband,jlev,jcol)*od_scaling(jreg,jlev,jcol)
+              if (config%do_lw_cloud_scattering) then
+                ! Compute single-scattering albedo of gas-cloud
+                ! combination
+                scat_od_cloud = od_cloud(iband,jlev,jcol) &
+                     &  * ssa_cloud(iband,jlev,jcol)*od_scaling(jreg,jlev,jcol)
+                ssa_region(jg,jreg) = (scat_od+scat_od_cloud) &
+                     &  / od_region(jg,jreg)
+                if (scat_od + scat_od_cloud > 0.0_jprb) then
+                  ! Compute asymmetry factor of gas-cloud
+                  ! combination
+                  g_region(jg,jreg) &
+                       &  = (scat_od*g_region(jg,1) &
+                       &  + scat_od_cloud*g_cloud(iband,jlev,jcol)) &
+                       &  / (scat_od + scat_od_cloud)
+                  ! else g_region is already set to zero
+                end if
+                ! else ssa_region is already set to zero
+              end if
+
+              ! Apply maximum cloud optical depth for stability in the
+              ! 3D case
+              if (od_region(jg,jreg) > config%max_cloud_od) then
+                od_region(jg,jreg) = config%max_cloud_od
+              end if
+
+            end do
+
+            ! Calculate two-stream variables gamma1 and gamma2 of
+            ! all regions at once
+            call calc_two_stream_gammas_lw(nreg, &
+                 &  ssa_region(jg,:), g_region(jg,:), &
+                 &  gamma1(jg,:), gamma2(jg,:))
+
+            ! Loop is in order of g-points with typically
+            ! increasing optical depth: if optical depth of
+            ! clear-sky region exceeds a threshold then turn off
+            ! 3D effects for any further g-points
+            if (ng3D == ng &
+                 &  .and. od_region(jg,1) > config%max_gas_od_3D) then
+              ng3D = jg-1
+            end if
+          end do ! Loop over g points
+        end if ! Cloudy level
+
+        ! --------------------------------------------------------
+        ! Section 3.3: Compute reflection, transmission and emission
+        ! --------------------------------------------------------
+        if (ng3D > 0) then
+          ! --- Section 3.3a: g-points with 3D effects ----------
+
+          ! 3D effects need to be represented in "ng3D" of the g
+          ! points.  This is done by creating ng3D square matrices
+          ! each of dimension 2*nreg by 2*nreg, computing the matrix
+          ! exponential, then computing the various
+          ! transmission/reflectance matrices from that.
+          do jreg = 1,nregActive
+            ! Write the diagonal elements of -Gamma1*z1
+            Gamma_z1(1:ng3D,jreg,jreg) &
+                 &  = od_region(1:ng3D,jreg)*gamma1(1:ng3D,jreg)
+            ! Write the diagonal elements of +Gamma2*z1
+            Gamma_z1(1:ng3D,jreg+nreg,jreg) &
+                 &  = od_region(1:ng3D,jreg)*gamma2(1:ng3D,jreg)
+
+            ! Write the vectors corresponding to the inhomogeneous
+            ! parts of the matrix ODE
+            planck_top(1:ng3D,nreg+jreg) = od_region(1:ng3D,jreg) &
+                 &  *(1.0_jprb-ssa_region(1:ng3D,jreg))*region_fracs(jreg,jlev,jcol) &
+                 &  *planck_hl(1:ng3D,jlev,jcol)*LwDiffusivity
+            planck_top(1:ng3D,jreg) = -planck_top(1:ng3D,nreg+jreg)
+            planck_diff(1:ng3D,nreg+jreg) = od_region(1:ng3D,jreg) &
+                 &  * (1.0_jprb-ssa_region(1:ng3D,jreg))*region_fracs(jreg,jlev,jcol) &
+                 &  * (planck_hl(1:ng3D,jlev+1,jcol) &
+                 &  -planck_hl(1:ng3D,jlev,jcol))*LwDiffusivity
+            planck_diff(1:ng3D,jreg) = -planck_diff(1:ng3D,nreg+jreg)
+          end do
+
+          if (nregActive < nreg) then
+            ! To avoid NaNs in some situations we need to put
+            ! non-zeros in the cloudy-sky regions even if the cloud
+            ! fraction is zero
+            do jreg = nregActive+1,nreg
+              Gamma_z1(1:ng3D,jreg,jreg) = Gamma_z1(1:ng3D,1,1)
+              Gamma_z1(1:ng3D,nreg+jreg,jreg) = Gamma_z1(1:ng3D,nreg+1,1)
+            end do
+          end if
+
+          ! Parameterization for the effective emissivity of the side
+          ! of the cloud
+          if (config%do_lw_side_emissivity &
+             & .and. region_fracs(1,jlev,jcol) > 0.0_jprb .and. region_fracs(2,jlev,jcol) > 0.0_jprb &
+             & .and. config%do_3d_effects &
+             & .and. cloud%inv_cloud_effective_size(jcol,jlev) > 0.0_jprb) then
+            aspect_ratio = 1.0_jprb / (min(cloud%inv_cloud_effective_size(jcol,jlev), &
+                 &                         1.0_jprb / config%min_cloud_effective_size) &
+                 &                     * region_fracs(1,jlev,jcol) * dz)
+            lateral_od(1:ng3D) = (aspect_ratio / (nreg-1.0_jprb)) &
+                 &  * sum(od_region(1:ng3D,2:nreg)*(1.0_jprb-ssa_region(1:ng3D,2:nreg)),2)
+            sqrt_1_minus_ssa(1:ng3D) = sqrt(1.0_jprb - ssa_region(1:ng3D,2))
+            side_emiss_thick(1:ng3D) = 2.0_jprb * sqrt_1_minus_ssa(1:ng3D) / &
+                 & (sqrt_1_minus_ssa(1:ng3D) &
+                 &  + sqrt(1.0_jprb-ssa_region(1:ng3D,2)*g_region(1:ng3D,2)))
+            side_emiss(1:ng3D) = (side_emiss_thin - side_emiss_thick(1:ng3D)) &
+                 &  / (lateral_od(1:ng3D) + 1.0_jprb) & 
+                 &  + side_emiss_thick(1:ng3D)
+          else
+            side_emiss(1:ng3D) = 1.0_jprb
+          end if
+
+          do jreg = 1,nregActive-1
+            ! Add the terms assocated with 3D transport to Gamma1*z1.
+            ! First the rate from region jreg to jreg+1
+            Gamma_z1(1:ng3D,jreg,jreg) = Gamma_z1(1:ng3D,jreg,jreg) &
+                 &  + transfer_rate(jreg,jreg+1)
+            Gamma_z1(1:ng3D,jreg+1,jreg) = -transfer_rate(jreg,jreg+1)
+
+            ! Next the rate from region jreg+1 to jreg
+            if (jreg > 1) then
+              ! Flow between one cloudy region and another
+              Gamma_z1(1:ng3D,jreg+1,jreg+1) = Gamma_z1(1:ng3D,jreg+1,jreg+1) &
+                   &  + transfer_rate(jreg+1,jreg)
+              Gamma_z1(1:ng3D,jreg,jreg+1) = -transfer_rate(jreg+1,jreg)
+            else
+              ! Only for the lateral transfer between cloud and clear
+              ! skies do we account for the effective emissivity of
+              ! the side of the cloud
+              Gamma_z1(1:ng3D,jreg+1,jreg+1) = Gamma_z1(1:ng3D,jreg+1,jreg+1) &
+                   &  + side_emiss(1:ng3D) * transfer_rate(jreg+1,jreg)
+              Gamma_z1(1:ng3D,jreg,jreg+1) = -side_emiss(1:ng3D)*transfer_rate(jreg+1,jreg)
+            end if
+          end do
+
+          ! Possible flow between regions a and c
+          if (edge_length(3) > 0.0_jprb) then
+            Gamma_z1(1:ng3D,1,1) = Gamma_z1(1:ng3D,1,1) &
+                 &  + transfer_rate(1,3)
+            Gamma_z1(1:ng3D,3,1) = -transfer_rate(1,3)
+            Gamma_z1(1:ng3D,3,3) = Gamma_z1(1:ng3D,3,3) &
+                 &  + side_emiss(1:ng3D) * transfer_rate(3,1)
+            Gamma_z1(1:ng3D,1,3) = -side_emiss(1:ng3D)*transfer_rate(3,1)
+          end if
+
+          ! Copy Gamma1*z1
+          Gamma_z1(1:ng3D,nreg+1:2*nreg,nreg+1:2*nreg) &
+               &  = -Gamma_z1(1:ng3D,1:nreg,1:nreg)
+          ! Copy Gamma2*z1
+          Gamma_z1(1:ng3D,1:nreg,nreg+1:2*nreg) &
+               &  = -Gamma_z1(1:ng3D,nreg+1:2*nreg,1:nreg)
+
+          ! Compute the parts of the particular solution
+          solution_diff(1:ng3D,1:2*nreg) &
+               &  = solve_vec(ng,ng3D,2*nreg,Gamma_z1,planck_diff)
+          solution_diff(1:ng3D,1:2*nreg) = - solution_diff(1:ng3D,1:2*nreg) 
+          solution0(1:ng3D,1:2*nreg) = solve_vec(ng,ng3D,2*nreg,Gamma_z1, &
+               &  solution_diff-planck_top)
+
+          ! Compute the matrix exponential of Gamma_z1, returning the
+          ! result in-place
+          call expm(ng, ng3D, 2*nreg, Gamma_z1, IMatrixPatternDense)
+
+          ! Update count of expm calls
+          n_calls_expm = n_calls_expm + ng3D
+
+          ! Diffuse reflectance matrix
+          reflectance(1:ng3D,:,:,jlev) = -solve_mat(ng,ng3D,nreg, &
+               &  Gamma_z1(1:ng3D,1:nreg,1:nreg), &
+               &  Gamma_z1(1:ng3D,1:nreg,nreg+1:2*nreg))
+          ! Diffuse transmission matrix
+          transmittance(1:ng3D,:,:,jlev) = mat_x_mat(ng,ng3D,nreg, &
+               &  Gamma_z1(1:ng3D,nreg+1:2*nreg,1:nreg), &
+               &  reflectance(1:ng3D,:,:,jlev)) &
+               &  + Gamma_z1(1:ng3D,nreg+1:2*nreg,nreg+1:2*nreg)
+
+          ! Upward and downward sources due to emission within the
+          ! layer
+          tmp_vectors(1:ng3D,:) = solution0(1:ng3D,1:nreg) &
+               &  + solution_diff(1:ng3D,1:nreg) &
+               &  - mat_x_vec(ng,ng3D,nreg,Gamma_z1(:,1:nreg,nreg+1:2*nreg), &
+               &  solution0(:,nreg+1:2*nreg))
+          source_up(1:ng3D,:,jlev) = solution0(1:ng3D,1:nreg) &
+               &  - solve_vec(ng,ng3D,nreg,Gamma_z1(:,1:nreg,1:nreg), &
+               &  tmp_vectors)
+          tmp_vectors(1:ng3D,:) = source_up(1:ng3D,:,jlev) &
+               &  - solution0(1:ng3D,1:nreg)
+          source_dn(1:ng3D,:,jlev) = mat_x_vec(ng,ng3D,nreg,&
+               &  Gamma_z1(:,nreg+1:2*nreg,1:nreg),tmp_vectors) &
+               &  + solution0(1:ng3D,nreg+1:2*nreg) &
+               &  - mat_x_vec(ng,ng3D,nreg, &
+               &  Gamma_z1(:,nreg+1:2*nreg,nreg+1:2*nreg), &
+               &  solution0(:,nreg+1:2*nreg)) &
+               &  + solution_diff(1:ng3D,nreg+1:2*nreg)
+        end if ! we are treating 3D effects for some g points
+
+        ! --- Section 3.3b: g-points without 3D effects ----------
+
+        ! Compute reflectance, transmittance and upward and downward
+        ! sources for clear skies, using the Meador-Weaver formulas
+        ! for reflectance and transmittance, and equivalent solutions
+        ! to the coupled ODEs for the sources.
+        call calc_reflectance_transmittance_lw(ng, &
+             &  od_region(1:ng,1), &
+             &  gamma1(1:ng,1), gamma2(1:ng,1), &
+             &  planck_hl(1:ng,jlev,jcol), planck_hl(1:ng,jlev+1,jcol), &
+             &  ref_clear(1:ng,jlev), trans_clear(1:ng,jlev), &
+             &  source_up_clear(1:ng,jlev), source_dn_clear(1:ng,jlev))
+
+        n_calls_meador_weaver = n_calls_meador_weaver + ng
+
+        if (ng3D < ng) then
+          ! Some of the g points are to be treated using the
+          ! conventional plane-parallel method.  First zero the
+          ! relevant parts of the arrays
+          reflectance  (ng3D+1:ng,:,:,jlev) = 0.0_jprb
+          transmittance(ng3D+1:ng,:,:,jlev) = 0.0_jprb
+          source_up    (ng3D+1:ng,:,jlev) = 0.0_jprb
+          source_dn    (ng3D+1:ng,:,jlev) = 0.0_jprb
+
+          ! Since there is no lateral transport, the clear-sky parts
+          ! of the arrays can be copied from the clear-sky arrays
+          reflectance(ng3D+1:ng,1,1,jlev) = ref_clear(ng3D+1:ng,jlev)
+          transmittance(ng3D+1:ng,1,1,jlev) = trans_clear(ng3D+1:ng,jlev)
+          source_up(ng3D+1:ng,1,jlev) = region_fracs(1,jlev,jcol)*source_up_clear(ng3D+1:ng,jlev)
+          source_dn(ng3D+1:ng,1,jlev) = region_fracs(1,jlev,jcol)*source_dn_clear(ng3D+1:ng,jlev)
+
+          ! Compute reflectance, transmittance and upward and downward
+          ! sources, for each cloudy region, using the Meador-Weaver
+          ! formulas for reflectance and transmittance, and equivalent
+          ! solutions to the coupled ODEs for the sources.
+          do jreg = 2, nregActive
+            call calc_reflectance_transmittance_lw(ng-ng3D, &
+                 &  od_region(ng3D+1:ng,jreg), &
+                 &  gamma1(ng3D+1:ng,jreg), gamma2(ng3D+1:ng,jreg), &
+                 &  region_fracs(jreg,jlev,jcol)*planck_hl(ng3D+1:ng,jlev,jcol), &
+                 &  region_fracs(jreg,jlev,jcol)*planck_hl(ng3D+1:ng,jlev+1,jcol), &
+                 &  reflectance(ng3D+1:ng,jreg,jreg,jlev), &
+                 &  transmittance(ng3D+1:ng,jreg,jreg,jlev), &
+                 &  source_up(ng3D+1:ng,jreg,jlev), &
+                 &  source_dn(ng3D+1:ng,jreg,jlev))
+          end do
+          n_calls_meador_weaver &
+               &  = n_calls_meador_weaver + (ng-ng3D)*(nregActive-1)
+        end if
+
+      end do ! Loop over levels
+
+      ! --------------------------------------------------------
+      ! Section 4: Compute total sources and albedos
+      ! --------------------------------------------------------
+
+      total_albedo(:,:,:,:) = 0.0_jprb
+      total_source(:,:,:) = 0.0_jprb
+
+      if (config%do_clear) then
+        total_albedo_clear(:,:) = 0.0_jprb
+        total_source_clear(:,:) = 0.0_jprb
+      end if
+
+      ! Calculate the upwelling radiation emitted by the surface, and
+      ! copy the surface albedo into total_albedo 
+      do jreg = 1,nreg
+        do jg = 1,ng
+          ! region_fracs(jreg,nlev,jcol) is the fraction of each
+          ! region in the lowest model level
+          total_source(jg,jreg,nlev+1) = region_fracs(jreg,nlev,jcol)*emission(jg,jcol)
+          total_albedo(jg,jreg,jreg,nlev+1) = albedo(jg,jcol)
+        end do
+      end do
+      ! Equivalent surface values for computing clear-sky fluxes 
+      if (config%do_clear) then
+        do jg = 1,ng
+          total_source_clear(jg,nlev+1) = emission(jg,jcol)
+        end do
+        ! In the case of surface albedo there is no dependence on
+        ! cloud fraction so we can copy the all-sky value
+        total_albedo_clear(1:ng,nlev+1) = total_albedo(1:ng,1,1,nlev+1)
+      end if
+
+      ! Loop back up through the atmosphere computing the total albedo
+      ! and the total upwelling due to emission below each level
+      do jlev = nlev,1,-1
+        if (config%do_clear) then
+          ! Use adding method for clear-sky arrays; note that there
+          ! is no need to consider "above" and "below" quantities
+          ! since with no cloud overlap to worry about, these are
+          ! the same
+          inv_denom_scalar(:) = 1.0_jprb &
+               &  / (1.0_jprb - total_albedo_clear(:,jlev+1)*ref_clear(:,jlev))
+          total_albedo_clear(:,jlev) = ref_clear(:,jlev) &
+               &  + trans_clear(:,jlev)*trans_clear(:,jlev)*total_albedo_clear(:,jlev+1) &
+               &  * inv_denom_scalar(:)
+          total_source_clear(:,jlev) = source_up_clear(:,jlev) &
+               &  + trans_clear(:,jlev)*(total_source_clear(:,jlev+1) &
+               &  + total_albedo_clear(:,jlev+1)*source_dn_clear(:,jlev)) &
+               &  * inv_denom_scalar(:)
+        end if
+
+        if (is_clear_sky_layer(jlev)) then
+          ! Clear-sky layer: use scalar adding method
+          inv_denom_scalar(:) = 1.0_jprb &
+               &  / (1.0_jprb - total_albedo(:,1,1,jlev+1)*reflectance(:,1,1,jlev))
+          total_albedo_below = 0.0_jprb
+          total_albedo_below(:,1,1) = reflectance(:,1,1,jlev) &
+               &  + transmittance(:,1,1,jlev)  * transmittance(:,1,1,jlev) &
+               &  * total_albedo(:,1,1,jlev+1) * inv_denom_scalar(:)
+          total_source_below = 0.0_jprb
+          total_source_below(:,1) = source_up(:,1,jlev) &
+               &  + transmittance(:,1,1,jlev)*(total_source(:,1,jlev+1) &
+               &  + total_albedo(:,1,1,jlev+1)*source_dn(:,1,jlev)) &
+               &  * inv_denom_scalar(:)
+        else if (config%do_3d_effects .or. &
+             &   config%do_3d_lw_multilayer_effects) then
+          ! Cloudy layer: use matrix adding method
+          denominator = identity_minus_mat_x_mat(ng,ng,nreg,&
+               &  total_albedo(:,:,:,jlev+1), reflectance(:,:,:,jlev))
+          total_albedo_below = reflectance(:,:,:,jlev) &
+               &  + mat_x_mat(ng,ng,nreg,transmittance(:,:,:,jlev), &
+               &  solve_mat(ng,ng,nreg,denominator, &
+               &  mat_x_mat(ng,ng,nreg,total_albedo(:,:,:,jlev+1), &
+               &  transmittance(:,:,:,jlev))))
+          total_source_below = source_up(:,:,jlev) & 
+               &  + mat_x_vec(ng,ng,nreg,transmittance(:,:,:,jlev), &
+               &  solve_vec(ng,ng,nreg,denominator, &
+               &  total_source(:,:,jlev+1) + mat_x_vec(ng,ng,nreg, &
+               &  total_albedo(:,:,:,jlev+1),source_dn(:,:,jlev))))
+        else 
+          ! Cloudy layer for which reflectance, transmittance and
+          ! total_albedo matrices are diagonal
+          total_albedo_below = 0.0_jprb
+          total_source_below = 0.0_jprb
+          do jreg = 1,nreg
+            inv_denom_scalar(:) = 1.0_jprb / (1.0_jprb &
+                 &  - total_albedo(:,jreg,jreg,jlev+1)*reflectance(:,jreg,jreg,jlev))
+            total_albedo_below(:,jreg,jreg) = reflectance(:,jreg,jreg,jlev) &
+                 &  + transmittance(:,jreg,jreg,jlev)*transmittance(:,jreg,jreg,jlev) &
+                 &  * total_albedo(:,jreg,jreg,jlev+1) &
+                 &  * inv_denom_scalar(:)
+            total_source_below(:,jreg) = source_up(:,jreg,jlev) &
+                 &  + transmittance(:,jreg,jreg,jlev)*(total_source(:,jreg,jlev+1) &
+                 &  + total_albedo(:,jreg,jreg,jlev+1)*source_dn(:,jreg,jlev)) &
+                 &  * inv_denom_scalar(:)
+          end do
+
+        end if
+
+        ! Account for cloud overlap when converting albedo and
+        ! source below a layer interface to the equivalent values
+        ! just above
+        if (is_clear_sky_layer(jlev) .and. is_clear_sky_layer(jlev-1)) then
+          ! If both layers are cloud free, this is trivial...
+          total_albedo(:,:,:,jlev) = 0.0_jprb
+          total_albedo(:,1,1,jlev) = total_albedo_below(:,1,1)
+          total_source(:,:,jlev) = 0.0_jprb
+          total_source(:,1,jlev) = total_source_below(:,1)
+        else 
+          total_source(:,:,jlev) = singlemat_x_vec(ng,ng,nreg,&
+               &  u_matrix(:,:,jlev,jcol), total_source_below)
+
+!          if (config%do_3d_effects .or. config%do_3d_lw_multilayer_effects) then
+          if (config%do_3d_lw_multilayer_effects) then
+            ! Use the overlap matrices u_matrix and v_matrix
+            total_albedo(:,:,:,jlev) = singlemat_x_mat(ng,ng,nreg,&
+                 &  u_matrix(:,:,jlev,jcol), &
+                 &  mat_x_singlemat(ng,ng,nreg,total_albedo_below,&
+                 &  v_matrix(:,:,jlev,jcol)))
+          else
+            total_albedo(:,:,:,jlev) = 0.0_jprb
+            ! "total_albedo" is diagonal and we wish to exclude
+            ! anomalous horizontal transport described by Shonk &
+            ! Hogan (2008).  Therefore, the operation we perform is
+            ! essentially diag(total_albedo) = matmul(transpose(v_matrix),
+            ! diag(total_albedo_below)).
+            do jreg = 1,nreg
+              do jreg2 = 1,nreg
+                total_albedo(:,jreg,jreg,jlev) &
+                     &  = total_albedo(:,jreg,jreg,jlev) &
+                     &  + total_albedo_below(:,jreg2,jreg2) &
+                     &  * v_matrix(jreg2,jreg,jlev,jcol)
+              end do
+            end do
+          end if
+        end if
+
+      end do ! Reverse loop over levels
+
+      ! --------------------------------------------------------
+      ! Section 5: Compute fluxes
+      ! --------------------------------------------------------
+
+      ! Top-of-atmosphere fluxes into the regions of the top-most
+      ! layer: zero since we assume no extraterrestrial longwave
+      ! radiation (the shortwave scheme accounts for solar radiation
+      ! in the "longwave" part of the spectrum)
+      flux_dn_below = 0.0_jprb
+      flux%lw_dn(jcol,1) = 0.0_jprb
+      if (config%do_clear) then
+        flux_dn_clear = 0.0_jprb
+        flux%lw_dn_clear(jcol,1) = 0.0_jprb
+      end if
+
+      ! Store the outgoing longwave radiation at top-of-atmosphere
+      flux%lw_up(jcol,1) = sum(sum(total_source(:,:,1),1))
+      if (config%do_clear) then
+        flux%lw_up_clear(jcol,1) = sum(total_source_clear(:,1))
+      end if
+
+      if (config%do_save_spectral_flux) then
+        call indexed_sum(sum(total_source(:,:,1),2), &
+             &           config%i_spec_from_reordered_g_lw, &
+             &           flux%lw_up_band(:,jcol,1))
+        flux%lw_dn_band(:,jcol,1) = 0.0_jprb
+        if (config%do_clear) then
+          call indexed_sum(total_source_clear(:,1), &
+               &           config%i_spec_from_reordered_g_lw, &
+               &           flux%lw_up_clear_band(:,jcol,1))
+          flux%lw_dn_clear_band(:,jcol,1) = 0.0_jprb
+        end if
+      end if
+
+      ! Final loop back down through the atmosphere to compute fluxes
+      do jlev = 1,nlev
+        if (config%do_clear) then
+          ! Scalar operations for clear-sky fluxes
+          flux_dn_clear(:) = (trans_clear(:,jlev)*flux_dn_clear(:) &
+               + ref_clear(:,jlev)*total_source_clear(:,jlev+1) &
+               + source_dn_clear(:,jlev)) &
+               / (1.0_jprb - ref_clear(:,jlev)*total_albedo_clear(:,jlev+1))
+          flux_up_clear(:) = total_source_clear(:,jlev+1) &
+               + total_albedo_clear(:,jlev+1)*flux_dn_clear(:)
+        end if
+
+        if (is_clear_sky_layer(jlev)) then
+          ! Scalar operations for clear-sky layer
+          flux_dn_above(:,1) = (transmittance(:,1,1,jlev)*flux_dn_below(:,1) &
+               &  + reflectance(:,1,1,jlev)*total_source(:,1,jlev+1) &
+               &  + source_dn(:,1,jlev)) &
+               &  / (1.0_jprb - reflectance(:,1,1,jlev)*total_albedo(:,1,1,jlev+1))
+          flux_dn_above(:,2:nreg) = 0.0_jprb
+          flux_up_above(:,1) = total_source(:,1,jlev+1) &
+               &  + total_albedo(:,1,1,jlev+1)*flux_dn_above(:,1)
+          flux_up_above(:,2:nreg) = 0.0_jprb
+        else if (config%do_3d_effects .or. config%do_3d_lw_multilayer_effects) then
+          ! Matrix operations for cloudy layer
+          denominator = identity_minus_mat_x_mat(ng,ng,nreg,reflectance(:,:,:,jlev), &
+               &  total_albedo(:,:,:,jlev+1))
+          flux_dn_above = solve_vec(ng,ng,nreg,denominator, &
+               &  mat_x_vec(ng,ng,nreg,transmittance(:,:,:,jlev),flux_dn_below) &
+               &  + mat_x_vec(ng,ng,nreg,reflectance(:,:,:,jlev), &
+               &  total_source(:,:,jlev+1)) &
+               &  + source_dn(:,:,jlev))
+          flux_up_above = mat_x_vec(ng,ng,nreg,total_albedo(:,:,:,jlev+1), &
+               &  flux_dn_above) + total_source(:,:,jlev+1)
+        else
+          do jreg = 1,nreg
+            ! Scalar operations for all regions, requiring that
+            ! reflectance, transmittance and total_albedo are diagonal
+            flux_dn_above(:,jreg) = (transmittance(:,jreg,jreg,jlev)*flux_dn_below(:,jreg) &
+                 &  + reflectance(:,jreg,jreg,jlev)*total_source(:,jreg,jlev+1) &
+                 &  + source_dn(:,jreg,jlev)) &
+                 &  / (1.0_jprb - reflectance(:,jreg,jreg,jlev) &
+                 &              * total_albedo(:,jreg,jreg,jlev+1))
+            flux_up_above(:,jreg) = total_source(:,jreg,jlev+1) &
+                 &  + total_albedo(:,jreg,jreg,jlev+1)*flux_dn_above(:,jreg)
+          end do
+        end if
+
+        ! Account for overlap rules in translating fluxes just above
+        ! a layer interface to the values just below
+        if (is_clear_sky_layer(jlev) .and. is_clear_sky_layer(jlev+1)) then
+          flux_dn_below = flux_dn_above
+        else
+          flux_dn_below = singlemat_x_vec(ng,ng,nreg,v_matrix(:,:,jlev+1,jcol), &
+               &    flux_dn_above)
+        end if
+
+        ! Store the broadband fluxes
+        flux%lw_up(jcol,jlev+1) = sum(sum(flux_up_above,1))
+        flux%lw_dn(jcol,jlev+1) = sum(sum(flux_dn_above,1))
+        if (config%do_clear) then
+          flux%lw_up_clear(jcol,jlev+1) = sum(flux_up_clear)
+          flux%lw_dn_clear(jcol,jlev+1) = sum(flux_dn_clear)
+        end if
+
+        if (config%do_save_spectral_flux) then
+          call indexed_sum(sum(flux_up_above,2), &
+               &           config%i_spec_from_reordered_g_lw, &
+               &           flux%lw_up_band(:,jcol,jlev+1))
+          call indexed_sum(sum(flux_dn_above,2), &
+               &           config%i_spec_from_reordered_g_lw, &
+               &           flux%lw_dn_band(:,jcol,jlev+1))
+          if (config%do_clear) then
+            call indexed_sum(flux_up_clear, &
+                 &           config%i_spec_from_reordered_g_lw, &
+                 &           flux%lw_up_clear_band(:,jcol,jlev+1))
+            call indexed_sum(flux_dn_clear, &
+                 &           config%i_spec_from_reordered_g_lw, &
+                 &           flux%lw_dn_clear_band(:,jcol,jlev+1))
+          end if
+        end if
+
+      end do ! Final loop over levels
+
+      ! Store surface spectral downwelling fluxes, which at this point
+      ! are at the surface
+      flux%lw_dn_surf_g(:,jcol) = sum(flux_dn_above,2)
+      if (config%do_clear) then
+        flux%lw_dn_surf_clear_g(:,jcol) = flux_dn_clear
+      end if
+
+      ! Compute the longwave derivatives needed by Hogan and Bozzo
+      ! (2015) approximate radiation update scheme
+      if (config%do_lw_derivatives) then
+        ! Note that at this point flux_up_above contains the spectral
+        ! fluxes into the regions of the lowest layer; we sum over
+        ! regions first to provide a simple spectral flux upwelling
+        ! from the surface
+        call calc_lw_derivatives_matrix(ng, nlev, nreg, jcol, transmittance, &
+             &  u_matrix(:,:,:,jcol), sum(flux_up_above,2), flux%lw_derivatives)
+      end if
+        
+    end do ! Loop over columns
+
+    if (config%iverbose >= 3) then
+      write(nulout,*)
+    end if
+
+    ! Report number of calls to each method of solving single-layer
+    ! two-stream equations
+    if (config%iverbose >= 4) then
+      write(nulout,'(a,i0)') '  Matrix-exponential calls: ', n_calls_expm
+      write(nulout,'(a,i0)') '  Meador-Weaver calls: ', n_calls_meador_weaver
+    end if
+
+    if (lhook) call dr_hook('radiation_spartacus_lw:solver_spartacus_lw',1,hook_handle)
+
+  end subroutine solver_spartacus_lw
+
+end module radiation_spartacus_lw
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_spartacus_sw.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_spartacus_sw.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_spartacus_sw.F90	(revision 3908)
@@ -0,0 +1,1720 @@
+! radiation_spartacus_sw.F90 - SPARTACUS shortwave solver
+!
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2017-04-11  R. Hogan  Receive albedos at g-points
+!   2017-04-22  R. Hogan  Store surface fluxes at all g-points
+!   2017-06-30  R. Hogan  Reformulate to use total_albedo_direct not total_source
+!   2017-07-03  R. Hogan  Explicit calculation of encroachment
+!   2017-10-23  R. Hogan  Renamed single-character variables
+!   2018-02-20  R. Hogan  Corrected "computed" encroachment
+!   2018-03-09  R. Hogan  Security on computed encroachment, transmittance and reflectance
+!   2018-08-29  R. Hogan  Reformulate horizontal migration distances in step_migrations
+!   2018-09-02  R. Hogan  Bug fix in x_direct in step_migrations
+!   2018-09-03  R. Hogan  Security via min_cloud_effective_size
+!   2018-09-04  R. Hogan  Use encroachment_scaling and read encroachment edge_length from upper layer
+!   2018-09-13  R. Hogan  Added "Fractal" encroachment option
+!   2018-09-14  R. Hogan  Added "Zero" encroachment option
+!   2018-10-08  R. Hogan  Call calc_region_properties
+!   2018-10-15  R. Hogan  Added call to fast_expm_exchange instead of expm
+!   2019-01-12  R. Hogan  Use inv_inhom_effective_size if allocated
+!   2019-02-10  R. Hogan  Renamed "encroachment" to "entrapment"
+
+module radiation_spartacus_sw
+
+  public
+
+contains
+
+  ! Small routine for scaling cloud optical depth in the cloudy
+  ! regions
+#include "radiation_optical_depth_scaling.h"
+
+  ! This module contains just one exported subroutine, the shortwave
+  ! solver using the Speedy Algorithm for Radiative Transfer through
+  ! Cloud Sides (SPARTACUS), which can represent 3D effects using a
+  ! matrix form of the two-stream equations.
+  !
+  ! Sections:
+  !   1: Prepare general variables and arrays
+  !   2: Prepare column-specific variables and arrays
+  !   3: First loop over layers
+  !     3.1: Layer-specific initialization
+  !     3.2: Compute gamma variables
+  !       3.2a: Clear-sky case
+  !       3.2b: Cloudy case
+  !     3.3: Compute reflection, transmission and sources
+  !       3.3a: g-points with 3D effects
+  !       3.3b: g-points without 3D effects
+  !   4: Compute total albedos
+  !     4.1: Adding method
+  !     4.2: Overlap and entrapment
+  !   5: Compute fluxes
+  subroutine solver_spartacus_sw(nlev,istartcol,iendcol, &
+       &  config, single_level, thermodynamics, cloud, & 
+       &  od, ssa, g, od_cloud, ssa_cloud, g_cloud, &
+       &  albedo_direct, albedo_diffuse, incoming_sw, &
+       &  flux)
+
+    use parkind1, only           : jprb
+    use yomhook,  only           : lhook, dr_hook
+
+    use radiation_io, only             : nulout
+    use radiation_config, only         : config_type, IPdfShapeGamma, &
+         &  IEntrapmentZero, IEntrapmentEdgeOnly, IEntrapmentExplicit, &
+         &  IEntrapmentExplicitNonFractal, IEntrapmentMaximum
+    use radiation_single_level, only   : single_level_type
+    use radiation_thermodynamics, only : thermodynamics_type
+    use radiation_cloud, only          : cloud_type
+    use radiation_regions, only        : calc_region_properties
+    use radiation_overlap, only        : calc_overlap_matrices
+    use radiation_flux, only           : flux_type, &
+         &                               indexed_sum, add_indexed_sum
+    use radiation_matrix
+    use radiation_two_stream, only     : calc_two_stream_gammas_sw, &
+         &  calc_reflectance_transmittance_sw, calc_frac_scattered_diffuse_sw, &
+         &  SwDiffusivity
+    use radiation_constants, only      : Pi, GasConstantDryAir, &
+         &                               AccelDueToGravity
+
+    implicit none
+
+    ! Inputs
+    integer, intent(in) :: nlev               ! number of model levels
+    integer, intent(in) :: istartcol, iendcol ! range of columns to process
+    type(config_type),        intent(in) :: config
+    type(single_level_type),  intent(in) :: single_level
+    type(thermodynamics_type),intent(in) :: thermodynamics
+    type(cloud_type),         intent(in) :: cloud
+
+    ! Gas and aerosol optical depth, single-scattering albedo and
+    ! asymmetry factor at each shortwave g-point
+    real(jprb), intent(in), dimension(config%n_g_sw,nlev,istartcol:iendcol) :: &
+         &  od, ssa, g
+
+    ! Cloud and precipitation optical depth, single-scattering albedo and
+    ! asymmetry factor in each shortwave band
+    real(jprb), intent(in), dimension(config%n_bands_sw,nlev,istartcol:iendcol)   :: &
+         &  od_cloud, ssa_cloud, g_cloud
+
+    ! Direct and diffuse surface albedos, and the incoming shortwave
+    ! flux into a plane perpendicular to the incoming radiation at
+    ! top-of-atmosphere in each of the shortwave g points
+    real(jprb), intent(in), dimension(config%n_g_sw,istartcol:iendcol) :: &
+         &  albedo_direct, albedo_diffuse, incoming_sw
+
+    ! Output
+    type(flux_type), intent(inout):: flux
+
+    integer :: nreg, ng
+    integer :: nregactive ! =1 in clear layer, =nreg in a cloudy layer
+    integer :: jcol, jlev, jg, jreg, iband, jreg2,jreg3
+#ifdef EXPLICIT_EDGE_ENTRAPMENT
+    integer :: jreg4
+#endif
+    integer :: ng3D ! Number of g-points with small enough gas optical
+                    ! depth that 3D effects need to be represented
+
+    ! Ratio of gas constant for dry air to acceleration due to gravity
+    real(jprb), parameter :: R_over_g = GasConstantDryAir / AccelDueToGravity
+
+    real(jprb) :: mu0, one_over_mu0, tan_sza, transfer_scaling
+
+    ! The tangent of the effective zenith angle for diffuse radiation
+    ! that is appropriate for 3D transport
+    real(jprb), parameter :: tan_diffuse_angle_3d = Pi * 0.5_jprb
+
+    ! The minimum cosine of solar zenith angle to consider for 3D
+    ! effects, equivalent to one solar radius (0.2615 degrees)
+    real(jprb), parameter :: min_mu0_3d = 0.004625_jprb
+
+    ! Optical depth, single scattering albedo and asymmetry factor in
+    ! each region and (except for asymmetry) at each g-point
+    real(jprb), dimension(config%n_g_sw, config%nregions) &
+         &  :: od_region, ssa_region
+    real(jprb), dimension(config%nregions) :: g_region
+
+    ! Scattering optical depths of gases and clouds
+    real(jprb) :: scat_od, scat_od_cloud
+
+    ! The area fractions of each region
+    real(jprb) :: region_fracs(1:config%nregions,nlev,istartcol:iendcol)
+
+    ! The scaling used for the optical depth in the cloudy regions
+    real(jprb) :: od_scaling(2:config%nregions,nlev,istartcol:iendcol)
+
+    ! The length of the interface between regions jreg and jreg+1 per
+    ! unit area of gridbox, equal to L_diff^ab in Hogan and Shonk
+    ! (2013). When the first index is 3, this is the length of the
+    ! interface between regions 3 and 1. This is actually the
+    ! effective length oriented to a photon with random azimuth angle,
+    ! so is the true edge length divided by pi.
+    real(jprb) :: edge_length(3,nlev)
+
+    ! Element i,j gives the rate of 3D transfer of diffuse/direct
+    ! radiation from region i to region j, multiplied by the thickness
+    ! of the layer in m
+    real(jprb) :: transfer_rate_diffuse(config%nregions,config%nregions)
+    real(jprb) :: transfer_rate_direct(config%nregions,config%nregions)
+
+    ! Directional overlap matrices defined at all layer interfaces
+    ! including top-of-atmosphere and the surface
+    real(jprb), dimension(config%nregions,config%nregions,nlev+1, &
+         &                istartcol:iendcol) :: u_matrix, v_matrix
+
+    ! Two-stream variables
+    real(jprb), dimension(config%n_g_sw, config%nregions) &
+         &  :: gamma1, gamma2, gamma3
+
+    ! Matrix Gamma multiplied by the layer thickness z1, so units
+    ! metres.  After calling expm, this array contains the matrix
+    ! exponential of the original.
+    real(jprb) :: Gamma_z1(config%n_g_sw,3*config%nregions,3*config%nregions)
+
+    ! Diffuse reflection and transmission matrices of each layer
+    real(jprb), dimension(config%n_g_sw, config%nregions, &
+         &  config%nregions, nlev) :: reflectance, transmittance
+
+    ! Clear-sky diffuse reflection and transmission matrices of each
+    ! layer
+    real(jprb), dimension(config%n_g_sw, nlev) :: ref_clear, trans_clear
+
+    ! Matrices translating the direct flux entering the layer from
+    ! above to the reflected radiation exiting upwards (ref_dir) and
+    ! the scattered radiation exiting downwards (trans_dir_diff),
+    ! along with the direct unscattered transmission matrix
+    ! (trans_dir_dir).
+    real(jprb), dimension(config%n_g_sw, config%nregions, config%nregions, nlev) &
+         &  :: ref_dir, trans_dir_diff, trans_dir_dir
+    ! ...clear-sky equivalents
+    real(jprb), dimension(config%n_g_sw, nlev) &
+         &  :: ref_dir_clear, trans_dir_diff_clear, trans_dir_dir_clear
+
+    ! The fluxes downwelling from the bottom of the layer due to
+    ! scattering by the direct beam within the layer
+    real(jprb), dimension(config%n_g_sw, config%nregions) :: source_dn
+    ! ...clear-sky equivalent
+    real(jprb), dimension(config%n_g_sw) :: source_dn_clear
+
+    ! The fluxes upwelling just above the base of a layer due to
+    ! reflection of the direct downwelling beam; this is just used as
+    ! a temporary variable
+    real(jprb), dimension(config%n_g_sw, config%nregions) :: total_source
+
+    ! Direct downwelling flux below and above an interface between
+    ! layers into a plane perpendicular to the direction of the sun
+    real(jprb), dimension(config%n_g_sw, config%nregions) &
+         &  :: direct_dn_below, direct_dn_above
+    ! ...clear-sky equivalent (no distinction between "above/below")
+    real(jprb), dimension(config%n_g_sw) :: direct_dn_clear
+
+    ! Total albedo of the atmosphere/surface just above a layer
+    ! interface with respect to downwelling diffuse and direct
+    ! radiation at that interface, where level index = 1 corresponds
+    ! to the top-of-atmosphere
+    real(jprb), dimension(config%n_g_sw, config%nregions, &
+         &  config%nregions, nlev+1) :: total_albedo, total_albedo_direct
+    ! ...clear-sky equivalent
+    real(jprb), dimension(config%n_g_sw, nlev+1) &
+         &  :: total_albedo_clear, total_albedo_clear_direct
+
+    ! As total_albedo, but just below a layer interface
+    real(jprb), dimension(config%n_g_sw, config%nregions, config%nregions) &
+         &  :: total_albedo_below, total_albedo_below_direct
+
+    ! Temporary array for applying adding method with entrapment to
+    ! albedo matrices
+    real(jprb), dimension(config%n_g_sw, config%nregions, config%nregions) &
+         &  :: albedo_part
+
+    ! Horizontal migration distance (m) of reflected light
+    real(jprb), dimension(config%n_g_sw, config%nregions) &
+         &  :: x_diffuse, x_direct
+    ! Temporary variables when applying overlap rules
+    real(jprb), dimension(config%n_g_sw, config%nregions) &
+         &  :: x_diffuse_above, x_direct_above
+
+    real(jprb), dimension(config%n_g_sw, config%nregions, config%nregions) &
+         &  :: entrapment
+
+    ! The following is used to store matrices of the form I-A*B that
+    ! are used on the denominator of some expressions
+    real(jprb) :: denominator(config%n_g_sw,config%nregions,config%nregions)
+
+    ! Clear-sky equivalent, but actually its reciprocal to replace
+    ! some divisions by multiplications
+    real(jprb), dimension(config%n_g_sw) :: inv_denom_scalar
+
+    ! Final step in working out how much transport between regions
+    ! above occurs
+    real(jprb), dimension(config%n_g_sw) :: fractal_factor
+
+    ! Inverse of cloud effective size (m^-1)
+    real(jprb) :: inv_effective_size
+
+    ! Layer depth (m)
+    real(jprb) :: dz, layer_depth(nlev)
+
+    ! Upwelling and downwelling fluxes above/below layer interfaces
+    real(jprb), dimension(config%n_g_sw, config%nregions) &
+         &  :: flux_up_above, flux_dn_above, flux_dn_below
+    ! Clear-sky upwelling and downwelling fluxes (which don't
+    ! distinguish between whether they are above/below a layer
+    ! interface)
+    real(jprb), dimension(config%n_g_sw) :: flux_up_clear, flux_dn_clear
+
+    ! Index of top-most cloudy layer, or nlev+1 if no cloud
+    integer :: i_cloud_top
+
+    ! Keep a count of the number of calls to the two ways of computing
+    ! reflectance/transmittance matrices
+    integer :: n_calls_expm, n_calls_meador_weaver
+
+    ! Identify clear-sky layers, with pseudo layers for outer space
+    ! and below the ground, both treated as single-region clear skies
+    logical :: is_clear_sky_layer(0:nlev+1)
+
+    ! Used in computing rates of lateral radiation transfer
+    real(jprb), parameter :: four_over_pi = 4.0_jprb / Pi
+
+    ! Maximum entrapment coefficient
+    real(jprb) :: max_entr
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_spartacus_sw:solver_spartacus_sw',0,hook_handle)
+
+    ! --------------------------------------------------------
+    ! Section 1: Prepare general variables and arrays
+    ! --------------------------------------------------------
+
+    ! Copy array dimensions to local variables for convenience
+    nreg = config%nregions
+    ng   = config%n_g_sw
+
+    ! Reset count of number of calls to the two ways to compute
+    ! reflectance/transmission matrices
+    n_calls_expm          = 0
+    n_calls_meador_weaver = 0
+
+    ! Compute the wavelength-independent region fractions and
+    ! optical-depth scalings
+    call calc_region_properties(nlev,nreg,istartcol,iendcol, &
+         &  config%i_cloud_pdf_shape == IPdfShapeGamma, &
+         &  cloud%fraction, cloud%fractional_std, region_fracs, &
+         &  od_scaling, config%cloud_fraction_threshold)
+
+    ! Compute wavelength-independent overlap matrices u_matrix and v_matrix
+    call calc_overlap_matrices(nlev,nreg,istartcol,iendcol, &
+         &  region_fracs, cloud%overlap_param, &
+         &  u_matrix, v_matrix, decorrelation_scaling=config%cloud_inhom_decorr_scaling, &
+         &  cloud_fraction_threshold=config%cloud_fraction_threshold, &
+         &  use_beta_overlap=config%use_beta_overlap, &
+         &  cloud_cover=flux%cloud_cover_sw)
+
+    if (config%iverbose >= 3) then
+      write(nulout,'(a)',advance='no') '  Processing columns'
+    end if
+
+    ! Main loop over columns
+    do jcol = istartcol, iendcol
+      ! --------------------------------------------------------
+      ! Section 2: Prepare column-specific variables and arrays
+      ! --------------------------------------------------------
+
+      if (config%iverbose >= 3) then
+        write(nulout,'(a)',advance='no') '.'
+      end if
+
+      ! Copy local cosine of the solar zenith angle
+      mu0 = single_level%cos_sza(jcol)
+
+      ! Skip profile if sun is too low in the sky
+      if (mu0 < 1.0e-10_jprb) then
+        flux%sw_dn(jcol,:) = 0.0_jprb
+        flux%sw_up(jcol,:) = 0.0_jprb
+        if (allocated(flux%sw_dn_direct)) then
+          flux%sw_dn_direct(jcol,:) = 0.0_jprb
+        end if
+        if (config%do_clear) then
+          flux%sw_dn_clear(jcol,:) = 0.0_jprb
+          flux%sw_up_clear(jcol,:) = 0.0_jprb
+          if (allocated(flux%sw_dn_direct_clear)) then
+            flux%sw_dn_direct_clear(jcol,:) = 0.0_jprb
+          end if
+        end if
+
+        if (config%do_save_spectral_flux) then
+          flux%sw_dn_band(:,jcol,:) = 0.0_jprb
+          flux%sw_up_band(:,jcol,:) = 0.0_jprb
+          if (allocated(flux%sw_dn_direct_band)) then
+            flux%sw_dn_direct_band(:,jcol,:) = 0.0_jprb
+          end if
+          if (config%do_clear) then
+            flux%sw_dn_clear_band(:,jcol,:) = 0.0_jprb
+            flux%sw_up_clear_band(:,jcol,:) = 0.0_jprb
+            if (allocated(flux%sw_dn_direct_clear_band)) then
+              flux%sw_dn_direct_clear_band(:,jcol,:) = 0.0_jprb
+            end if
+          end if
+        end if
+
+        flux%sw_dn_diffuse_surf_g(:,jcol) = 0.0_jprb
+        flux%sw_dn_direct_surf_g(:,jcol)  = 0.0_jprb
+        if (config%do_clear) then
+          flux%sw_dn_diffuse_surf_clear_g(:,jcol) = 0.0_jprb
+          flux%sw_dn_direct_surf_clear_g(:,jcol)  = 0.0_jprb
+        end if
+
+        cycle
+      end if ! sun is below the horizon
+
+      ! At this point mu0 >= 1.0e-10
+
+      ! Used to compute rate of attenuation of direct solar beam
+      ! through the atmosphere
+      one_over_mu0 = 1.0_jprb / mu0
+
+      ! The rate at which direct radiation enters cloud sides is
+      ! proportional to the tangent of the solar zenith angle, but
+      ! this gets very large when the sun is low in the sky, in which
+      ! case we limit it to one solar radius above the horizon
+      if (mu0 < min_mu0_3d) then
+        tan_sza = sqrt(1.0_jprb/(min_mu0_3d*min_mu0_3d) - 1.0_jprb)
+      else if (one_over_mu0 > 1.0_jprb) then
+        tan_sza = sqrt(one_over_mu0*one_over_mu0 - 1.0_jprb &
+             &         + config%overhead_sun_factor)
+      else
+        ! Just in case we get mu0 > 1...
+        tan_sza = sqrt(config%overhead_sun_factor)
+      end if
+
+      ! Define which layers contain cloud; assume that
+      ! cloud%crop_cloud_fraction has already been called
+      is_clear_sky_layer = .true.
+      i_cloud_top = nlev+1
+      do jlev = nlev,1,-1
+        if (cloud%fraction(jcol,jlev) > 0.0_jprb) then
+          is_clear_sky_layer(jlev) = .false.
+          i_cloud_top = jlev
+        end if
+      end do
+
+      ! --------------------------------------------------------
+      ! Section 3: First loop over layers
+      ! --------------------------------------------------------
+      ! In this section the reflectance, transmittance and sources
+      ! are computed for each layer
+      do jlev = 1,nlev ! Start at top-of-atmosphere
+        ! --------------------------------------------------------
+        ! Section 3.1: Layer-specific initialization
+        ! --------------------------------------------------------
+
+        ! Array-wise assignments
+        gamma1 = 0.0_jprb
+        gamma2 = 0.0_jprb
+        gamma3 = 0.0_jprb
+        Gamma_z1= 0.0_jprb
+        transfer_rate_direct(:,:)  = 0.0_jprb
+        transfer_rate_diffuse(:,:) = 0.0_jprb
+        edge_length(:,jlev) = 0.0_jprb
+
+        ! The following is from the hydrostatic equation
+        ! and ideal gas law: dz = dp * R * T / (p * g)
+        layer_depth(jlev) = R_over_g &
+             &  * (thermodynamics%pressure_hl(jcol,jlev+1) &
+             &     - thermodynamics%pressure_hl(jcol,jlev)) &
+             &  * (thermodynamics%temperature_hl(jcol,jlev) &
+             &     + thermodynamics%temperature_hl(jcol,jlev+1)) &
+             &  / (thermodynamics%pressure_hl(jcol,jlev) &
+             &     + thermodynamics%pressure_hl(jcol,jlev+1))
+
+        ! --------------------------------------------------------
+        ! Section 3.2: Compute gamma variables
+        ! --------------------------------------------------------
+        if (is_clear_sky_layer(jlev)) then
+          ! --- Section 3.2a: Clear-sky case --------------------
+
+          nregactive = 1   ! Only region 1 (clear-sky) is active
+
+          ! Copy optical depth and single-scattering albedo of
+          ! clear-sky region
+          od_region(1:ng,1) = od(1:ng,jlev,jcol)
+          ssa_region(1:ng,1) = ssa(1:ng,jlev,jcol)
+
+          ! Compute two-stream variables gamma1-gamma3 (gamma4=1-gamma3)
+          call calc_two_stream_gammas_sw(ng, &
+               &  mu0, ssa(1:ng,jlev,jcol), g(1:ng,jlev,jcol), &
+               &  gamma1(1:ng,1), gamma2(1:ng,1), gamma3(1:ng,1))
+
+          if (config%use_expm_everywhere) then
+            ! Treat cloud-free layer as 3D: the matrix exponential
+            ! "expm" is used as much as possible (provided the
+            ! optical depth is not too high). ng3D is initially
+            ! set to the total number of g-points, then the
+            ! clear-sky optical depths are searched until a value
+            ! exceeds the threshold for treating 3D effects, and
+            ! if found it is reset to that.  Note that we are
+            ! assuming that the g-points have been reordered in
+            ! approximate order of gas optical depth.
+            ng3D = ng
+            do jg = 1, ng
+              if (od_region(jg,1) > config%max_gas_od_3D) then
+                ng3D = jg-1
+                exit
+              end if
+            end do
+          else
+            ! Otherwise treat cloud-free layer using the classical
+            ! Meador & Weaver formulae for all g-points
+            ng3D = 0
+          end if
+
+
+        else
+          ! --- Section 3.2b: Cloudy case -----------------------
+
+          ! Default number of g-points to treat with
+          ! matrix-exponential scheme
+          if (config%use_expm_everywhere) then
+            ng3D = ng   ! All g-points
+          else
+            ng3D = 0    ! No g-points
+          end if
+
+          if (config%do_3d_effects .and. &
+               &  allocated(cloud%inv_cloud_effective_size) .and. &
+               &  .not. (nreg == 2 .and. cloud%fraction(jcol,jlev) &
+               &  > 1.0-config%cloud_fraction_threshold)) then
+            if (cloud%inv_cloud_effective_size(jcol,jlev) > 0.0_jprb) then
+              ! 3D effects are only simulated if
+              ! inv_cloud_effective_size is defined and greater
+              ! than zero
+              ng3D = ng
+
+              ! Depth of current layer
+              dz = layer_depth(jlev)
+
+              ! Compute cloud edge length per unit area of gridbox
+              ! from rearranging Hogan & Shonk (2013) Eq. 45, but
+              ! adding a factor of (1-frac) so that a region that
+              ! fully occupies the gridbox (frac=1) has an edge of
+              ! zero. We can therefore use the fraction of clear sky,
+              ! region_fracs(1,jlev,jcol) for convenience instead. The
+              ! pi on the denominator means that this is actually edge
+              ! length with respect to a light ray with a random
+              ! azimuthal direction.
+              edge_length(1,jlev) = four_over_pi &
+                   &  * region_fracs(1,jlev,jcol)*(1.0_jprb-region_fracs(1,jlev,jcol)) &
+                   &  * min(cloud%inv_cloud_effective_size(jcol,jlev), &
+                   &        1.0_jprb / config%min_cloud_effective_size)
+              if (nreg > 2) then
+                ! The corresponding edge length between the two cloudy
+                ! regions is computed in the same way but treating the
+                ! optically denser of the two regions (region 3) as
+                ! the cloud; note that the fraction of this region may
+                ! be less than that of the optically less dense of the
+                ! two regions (region 2).  For increased flexibility,
+                ! the user may specify the effective size of
+                ! inhomogeneities separately from the cloud effective
+                ! size.
+                if (allocated(cloud%inv_inhom_effective_size)) then
+                  edge_length(2,jlev) = four_over_pi &
+                       &  * region_fracs(3,jlev,jcol)*(1.0_jprb-region_fracs(3,jlev,jcol)) &
+                       &  * min(cloud%inv_inhom_effective_size(jcol,jlev), &
+                       &        1.0_jprb / config%min_cloud_effective_size)
+                else
+                  edge_length(2,jlev) = four_over_pi &
+                       &  * region_fracs(3,jlev,jcol)*(1.0_jprb-region_fracs(3,jlev,jcol)) &
+                       &  * min(cloud%inv_cloud_effective_size(jcol,jlev), &
+                       &        1.0_jprb / config%min_cloud_effective_size)
+                end if
+
+                ! In the case of three regions, some of the cloud
+                ! boundary may go directly to the "thick" region
+                if (config%clear_to_thick_fraction > 0.0_jprb) then
+                  edge_length(3,jlev) = config%clear_to_thick_fraction &
+                       &  * min(edge_length(1,jlev), edge_length(2,jlev))
+                  edge_length(1,jlev) = edge_length(1,jlev) - edge_length(3,jlev)
+                  edge_length(2,jlev) = edge_length(2,jlev) - edge_length(3,jlev)
+                else 
+                  edge_length(3,jlev) = 0.0_jprb
+                end if
+              end if
+
+              do jreg = 1, nreg-1
+                ! Compute lateral transfer rates from region jreg to
+                ! jreg+1 following Hogan & Shonk (2013) Eq. 47, but
+                ! multiplied by dz because the transfer rate is
+                ! vertically integrated across the depth of the layer
+                if (region_fracs(jreg,jlev,jcol) > epsilon(1.0_jprb)) then
+                  transfer_rate_direct(jreg,jreg+1) = dz &
+                       &  * edge_length(jreg,jlev) * tan_sza / region_fracs(jreg,jlev,jcol)
+                  transfer_rate_diffuse(jreg,jreg+1) = dz &
+                       &  * edge_length(jreg,jlev) &
+                       &  * tan_diffuse_angle_3d / region_fracs(jreg,jlev,jcol)
+                end if
+                ! Compute transfer rates from region jreg+1 to
+                ! jreg
+                if (region_fracs(jreg+1,jlev,jcol) > epsilon(1.0_jprb)) then
+                  transfer_rate_direct(jreg+1,jreg) = dz &
+                       &  * edge_length(jreg,jlev) &
+                       &  * tan_sza / region_fracs(jreg+1,jlev,jcol)
+                  transfer_rate_diffuse(jreg+1,jreg) = dz &
+                       &  * edge_length(jreg,jlev) &
+                       &  * tan_diffuse_angle_3d / region_fracs(jreg+1,jlev,jcol)
+                end if
+              end do
+
+              ! Compute transfer rates directly between regions 1 and
+              ! 3
+              if (edge_length(3,jlev) > 0.0_jprb) then
+                if (region_fracs(1,jlev,jcol) > epsilon(1.0_jprb)) then
+                  transfer_rate_direct(1,3) = dz &
+                       &  * edge_length(3,jlev) * tan_sza / region_fracs(1,jlev,jcol)
+                  transfer_rate_diffuse(1,3) = dz &
+                       &  * edge_length(3,jlev) &
+                       &  * tan_diffuse_angle_3d / region_fracs(1,jlev,jcol)
+                end if
+                if (region_fracs(3,jlev,jcol) > epsilon(1.0_jprb)) then
+                  transfer_rate_direct(3,1) = dz &
+                       &  * edge_length(3,jlev) * tan_sza / region_fracs(3,jlev,jcol)
+                  transfer_rate_diffuse(3,1) = dz &
+                       &  * edge_length(3,jlev) &
+                       &  * tan_diffuse_angle_3d / region_fracs(3,jlev,jcol)
+                end if
+              end if
+
+              ! Don't allow the transfer rate out of a region to be
+              ! equivalent to a loss of exp(-10) through the layer
+              where (transfer_rate_direct > config%max_3d_transfer_rate) 
+                transfer_rate_direct = config%max_3d_transfer_rate
+              end where
+              where (transfer_rate_diffuse > config%max_3d_transfer_rate) 
+                transfer_rate_diffuse = config%max_3d_transfer_rate
+              end where
+
+            end if ! Cloud has edge length required for 3D effects
+          end if ! Include 3D effects
+
+          ! In a cloudy layer the number of active regions equals
+          ! the number of regions
+          nregactive = nreg
+
+          ! Compute scattering properties of the regions at each
+          ! g-point, mapping from the cloud properties
+          ! defined in each band.
+          do jg = 1,ng
+            ! Mapping from g-point to band
+            iband = config%i_band_from_reordered_g_sw(jg)
+
+            ! Scattering optical depth of clear-sky region
+            scat_od = od(jg,jlev,jcol)*ssa(jg,jlev,jcol)
+
+            ! Scattering properties of clear-sky regions copied
+            ! over
+            od_region(jg,1)  = od(jg, jlev, jcol)
+            ssa_region(jg,1) = ssa(jg, jlev, jcol)
+            g_region(1)      = g(jg, jlev, jcol)
+
+            ! Loop over cloudy regions
+            do jreg = 2,nreg
+              scat_od_cloud = od_cloud(iband,jlev,jcol) &
+                   &  * ssa_cloud(iband,jlev,jcol)*od_scaling(jreg,jlev,jcol)
+              ! Add scaled cloud optical depth to clear-sky value
+              od_region(jg,jreg) = od(jg,jlev,jcol) &
+                   &  + od_cloud(iband,jlev,jcol)*od_scaling(jreg,jlev,jcol)
+              ! Compute single-scattering albedo and asymmetry
+              ! factor of gas-cloud combination
+              ssa_region(jg,jreg) = (scat_od+scat_od_cloud) &
+                   &  / od_region(jg,jreg)
+              g_region(jreg) = (scat_od*g(jg,jlev,jcol) &
+                   &  + scat_od_cloud * g_cloud(iband,jlev,jcol)) &
+                   &  / (scat_od + scat_od_cloud)
+
+              ! Apply maximum cloud optical depth for stability in the
+              ! 3D case
+              if (od_region(jg,jreg) > config%max_cloud_od) then
+                od_region(jg,jreg) = config%max_cloud_od
+              end if
+
+            end do
+
+            ! Calculate two-stream variables gamma1-gamma3 of all
+            ! regions at once
+            call calc_two_stream_gammas_sw(nreg, &
+                 &  mu0, ssa_region(jg,:), g_region, &
+                 &  gamma1(jg,:), gamma2(jg,:), gamma3(jg,:))
+
+            ! Loop is in order of g-points with typically
+            ! increasing optical depth: if optical depth of
+            ! clear-sky region exceeds a threshold then turn off
+            ! 3D effects for any further g-points
+            if (ng3D == ng &
+                 &  .and. od_region(jg,1) > config%max_gas_od_3D) then
+              ng3D = jg-1
+            end if
+          end do ! Loop over g points
+        end if ! Cloudy level
+
+        ! --------------------------------------------------------
+        ! Section 3.3: Compute reflection, transmission and emission
+        ! --------------------------------------------------------
+        if (ng3D > 0) then
+          ! --- Section 3.3a: g-points with 3D effects ----------
+
+          ! 3D effects need to be represented in "ng3D" of the g
+          ! points.  This is done by creating ng3D square matrices
+          ! each of dimension 3*nreg by 3*nreg, computing the matrix
+          ! exponential, then computing the various
+          ! transmission/reflectance matrices from that.
+          do jreg = 1,nregactive
+            ! Write the diagonal elements of -Gamma1*z1
+            Gamma_z1(1:ng3D,jreg,jreg) &
+                 &  = od_region(1:ng3D,jreg)*gamma1(1:ng3D,jreg)
+            ! Write the diagonal elements of +Gamma2*z1
+            Gamma_z1(1:ng3D,jreg+nreg,jreg) &
+                 &  = od_region(1:ng3D,jreg)*gamma2(1:ng3D,jreg)
+            ! Write the diagonal elements of -Gamma3*z1
+            Gamma_z1(1:ng3D,jreg,jreg+2*nreg) &
+                 &  = -od_region(1:ng3D,jreg)*ssa_region(1:ng3D,jreg) &
+                 &  * gamma3(1:ng3D,jreg)
+
+            ! Write the diagonal elements of +Gamma4*z1
+            Gamma_z1(1:ng3D,jreg+nreg,jreg+2*nreg) &
+                 &  = od_region(1:ng3D,jreg)*ssa_region(1:ng3D,jreg) &
+                 &  * (1.0_jprb - gamma3(1:ng3D,jreg))
+
+            ! Write the diagonal elements of +Gamma0*z1
+            Gamma_z1(1:ng3D,jreg+2*nreg,jreg+2*nreg) &
+                 &  = -od_region(1:ng3D,jreg)*one_over_mu0
+          end do
+
+          do jreg = 1,nregactive-1
+            ! Write the elements of -Gamma1*z1 concerned with 3D
+            ! transport
+            Gamma_z1(1:ng3D,jreg,jreg) = Gamma_z1(1:ng3D,jreg,jreg) &
+                 &  + transfer_rate_diffuse(jreg,jreg+1)
+            Gamma_z1(1:ng3D,jreg+1,jreg+1) = Gamma_z1(1:ng3D,jreg+1,jreg+1) &
+                 &  + transfer_rate_diffuse(jreg+1,jreg)
+            Gamma_z1(1:ng3D,jreg+1,jreg) = -transfer_rate_diffuse(jreg,jreg+1)
+            Gamma_z1(1:ng3D,jreg,jreg+1) = -transfer_rate_diffuse(jreg+1,jreg)
+            ! Write the elements of +Gamma0*z1 concerned with 3D
+            ! transport
+            Gamma_z1(1:ng3D,jreg+2*nreg,jreg+2*nreg) &
+                 &  = Gamma_z1(1:ng3D,jreg+2*nreg,jreg+2*nreg) &
+                 &  - transfer_rate_direct(jreg,jreg+1)
+            Gamma_z1(1:ng3D,jreg+2*nreg+1,jreg+2*nreg+1) &
+                 &  = Gamma_z1(1:ng3D,jreg+2*nreg+1,jreg+2*nreg+1) &
+                 &  - transfer_rate_direct(jreg+1,jreg)
+            Gamma_z1(1:ng3D,jreg+2*nreg+1,jreg+2*nreg) &
+                 &  = transfer_rate_direct(jreg,jreg+1)
+            Gamma_z1(1:ng3D,jreg+2*nreg,jreg+2*nreg+1) &
+                 &  = transfer_rate_direct(jreg+1,jreg)
+          end do
+
+          ! Possible flow between regions a and c
+          if (edge_length(3,jlev) > 0.0_jprb) then
+            ! Diffuse transport
+            Gamma_z1(1:ng3D,1,1) = Gamma_z1(1:ng3D,1,1) &
+                 &  + transfer_rate_diffuse(1,3)
+            Gamma_z1(1:ng3D,3,3) = Gamma_z1(1:ng3D,3,3) &
+                 &  + transfer_rate_diffuse(3,1)
+            Gamma_z1(1:ng3D,3,1) = -transfer_rate_diffuse(1,3)
+            Gamma_z1(1:ng3D,1,3) = -transfer_rate_diffuse(3,1)
+            ! Direct transport
+            Gamma_z1(1:ng3D,1+2*nreg,1+2*nreg) = Gamma_z1(1:ng3D,1+2*nreg,1+2*nreg) &
+                 &  - transfer_rate_direct(1,3)
+            Gamma_z1(1:ng3D,3+2*nreg,3+2*nreg) = Gamma_z1(1:ng3D,3+2*nreg,3+2*nreg) &
+                 &  - transfer_rate_direct(3,1)
+            Gamma_z1(1:ng3D,3+2*nreg,1+2*nreg) = transfer_rate_direct(1,3)
+            Gamma_z1(1:ng3D,1+2*nreg,3+2*nreg) = transfer_rate_direct(3,1)
+          end if
+
+          ! Copy Gamma1*z1
+          Gamma_z1(1:ng3D,nreg+1:nreg+nregactive,nreg+1:nreg+nregactive) &
+               &  = -Gamma_z1(1:ng3D,1:nregactive,1:nregactive)
+          ! Copy Gamma2*z1
+          Gamma_z1(1:ng3D,1:nregactive,nreg+1:nreg+nregactive) &
+               &  = -Gamma_z1(1:ng3D,nreg+1:nreg+nregactive,1:nregactive)
+
+          ! Compute the matrix exponential of Gamma_z1, returning the
+          ! result in-place
+          call expm(ng, ng3D, 3*nreg, Gamma_z1, IMatrixPatternShortwave)
+
+          ! Update count of expm calls
+          n_calls_expm = n_calls_expm + ng3D
+
+          ! Direct transmission matrix
+          trans_dir_dir(1:ng3D,:,:,jlev) = min(1.0_jprb,max(0.0_jprb, &
+               &  Gamma_z1(1:ng3D,2*nreg+1:3*nreg, 2*nreg+1:3*nreg)))
+          ! Diffuse reflectance matrix; security on negative values
+          ! necessary occasionally for very low cloud fraction and very high
+          ! in-cloud optical depth
+          reflectance(1:ng3D,:,:,jlev) = min(1.0_jprb,max(0.0_jprb, &
+               &  -solve_mat(ng,ng3D,nreg,Gamma_z1(1:ng3D,1:nreg,1:nreg), &
+               &             Gamma_z1(1:ng3D,1:nreg,nreg+1:2*nreg))))
+          ! Diffuse transmission matrix
+          transmittance(1:ng3D,:,:,jlev) = min(1.0_jprb,max(0.0_jprb, &
+               &  mat_x_mat(ng,ng3D,nreg,Gamma_z1(1:ng3D,nreg+1:2*nreg,1:nreg), &
+               &            reflectance(1:ng3D,:,:,jlev)) &
+               &  + Gamma_z1(1:ng3D,nreg+1:2*nreg,nreg+1:2*nreg)))
+          ! Transfer matrix between downward direct and upward
+          ! diffuse
+          ref_dir(1:ng3D,:,:,jlev) = min(mu0,max(0.0_jprb, &
+               &  -solve_mat(ng,ng3D,nreg,Gamma_z1(1:ng3D,1:nreg,1:nreg), &
+               &             Gamma_z1(1:ng3D,1:nreg,2*nreg+1:3*nreg))))
+          ! Transfer matrix between downward direct and downward
+          ! diffuse in layer interface below.  Include correction for
+          ! trans_dir_diff out of plausible bounds (note that Meador &
+          ! Weaver has the same correction in radiation_two_stream.F90
+          ! - this is not just an expm thing)
+          trans_dir_diff(1:ng3D,:,:,jlev) = min(mu0,max(0.0_jprb, &
+               &  mat_x_mat(ng,ng3D,nreg,Gamma_z1(1:ng3D,nreg+1:2*nreg,1:nreg), &
+               &            ref_dir(1:ng3D,:,:,jlev)) &
+               &  + Gamma_z1(1:ng3D,nreg+1:2*nreg,2*nreg+1:3*nreg)))
+
+        end if ! we are treating 3D effects for some g points
+
+        ! --- Section 3.3b: g-points without 3D effects ----------
+
+        ! Compute reflectance, transmittance and associated terms for
+        ! clear skies, using the Meador-Weaver formulas
+        call calc_reflectance_transmittance_sw(ng, &
+             &  mu0, od_region(1:ng,1), ssa_region(1:ng,1), &
+             &  gamma1(1:ng,1), gamma2(1:ng,1), gamma3(1:ng,1), &
+             &  ref_clear(1:ng,jlev), trans_clear(1:ng,jlev), &
+             &  ref_dir_clear(1:ng,jlev), trans_dir_diff_clear(1:ng,jlev), &
+             &  trans_dir_dir_clear(1:ng,jlev) )
+
+        n_calls_meador_weaver = n_calls_meador_weaver + ng
+
+        if (ng3D < ng) then
+          ! Some of the g points are to be treated using the
+          ! conventional plane-parallel method.  First zero the
+          ! relevant parts of the matrices
+          trans_dir_dir (ng3D+1:ng,:,:,jlev) = 0.0_jprb
+          reflectance   (ng3D+1:ng,:,:,jlev) = 0.0_jprb
+          transmittance (ng3D+1:ng,:,:,jlev) = 0.0_jprb
+          ref_dir       (ng3D+1:ng,:,:,jlev) = 0.0_jprb
+          trans_dir_diff(ng3D+1:ng,:,:,jlev) = 0.0_jprb
+
+          ! Since there is no lateral transport, the clear-sky parts
+          ! of the arrays can be copied from the clear-sky arrays
+          trans_dir_dir (ng3D+1:ng,1,1,jlev) = trans_dir_dir_clear (ng3D+1:ng,jlev)
+          reflectance   (ng3D+1:ng,1,1,jlev) = ref_clear           (ng3D+1:ng,jlev)
+          transmittance (ng3D+1:ng,1,1,jlev) = trans_clear         (ng3D+1:ng,jlev)
+          ref_dir       (ng3D+1:ng,1,1,jlev) = ref_dir_clear       (ng3D+1:ng,jlev)
+          trans_dir_diff(ng3D+1:ng,1,1,jlev) = trans_dir_diff_clear(ng3D+1:ng,jlev)
+
+          ! Compute reflectance, transmittance and associated terms
+          ! for each cloudy region, using the Meador-Weaver formulas
+          do jreg = 2, nregactive
+            call calc_reflectance_transmittance_sw(ng-ng3D, &
+                 &  mu0, &
+                 &  od_region(ng3D+1:ng,jreg), ssa_region(ng3D+1:ng,jreg), &
+                 &  gamma1(ng3D+1:ng,jreg), gamma2(ng3D+1:ng,jreg), &
+                 &  gamma3(ng3D+1:ng,jreg), &
+                 &  reflectance(ng3D+1:ng,jreg,jreg,jlev), &
+                 &  transmittance(ng3D+1:ng,jreg,jreg,jlev), &
+                 &  ref_dir(ng3D+1:ng,jreg,jreg,jlev), &
+                 &  trans_dir_diff(ng3D+1:ng,jreg,jreg,jlev), &
+                 &  trans_dir_dir(ng3D+1:ng,jreg,jreg,jlev) )
+          end do
+          n_calls_meador_weaver &
+               &  = n_calls_meador_weaver + (ng-ng3D)*(nregactive-1)
+        end if
+
+      end do ! Loop over levels
+
+      ! --------------------------------------------------------
+      ! Section 4: Compute total albedos
+      ! --------------------------------------------------------
+
+      total_albedo(:,:,:,:)        = 0.0_jprb
+      total_albedo_direct(:,:,:,:) = 0.0_jprb
+
+      if (config%do_clear) then
+        total_albedo_clear(:,:)        = 0.0_jprb
+        total_albedo_clear_direct(:,:) = 0.0_jprb
+      end if
+
+      ! Calculate the upwelling radiation scattered from the direct
+      ! beam incident on the surface, and copy the surface albedo
+      ! into total_albedo
+      do jreg = 1,nreg
+        do jg = 1,ng
+          total_albedo(jg,jreg,jreg,nlev+1) = albedo_diffuse(jg,jcol)
+          total_albedo_direct(jg,jreg,jreg,nlev+1) &
+               &  = mu0 * albedo_direct(jg,jcol)
+        end do
+      end do
+
+      if (config%do_clear) then
+        ! Surface albedo is the same
+        total_albedo_clear(1:ng,nlev+1) = total_albedo(1:ng,1,1,nlev+1)
+        total_albedo_clear_direct(1:ng,nlev+1) &
+             &  = total_albedo_direct(1:ng,1,1,nlev+1)
+      end if
+
+      ! Horizontal migration distances of reflected radiation at the
+      ! surface are zero
+      x_diffuse = 0.0_jprb
+      x_direct  = 0.0_jprb
+
+      ! Work back up through the atmosphere computing the total albedo
+      ! of the atmosphere below that point using the adding method
+      do jlev = nlev,1,-1
+
+        ! --------------------------------------------------------
+        ! Section 4.1: Adding method
+        ! --------------------------------------------------------
+
+        if (config%do_clear) then
+          ! Use adding method for clear-sky arrays; note that there
+          ! is no need to consider "above" and "below" quantities
+          ! since with no cloud overlap to worry about, these are
+          ! the same
+          inv_denom_scalar(:) = 1.0_jprb &
+               &  / (1.0_jprb - total_albedo_clear(:,jlev+1)*ref_clear(:,jlev))
+          total_albedo_clear(:,jlev) = ref_clear(:,jlev) &
+               &  + trans_clear(:,jlev)*trans_clear(:,jlev)*total_albedo_clear(:,jlev+1) &
+               &  * inv_denom_scalar(:)
+          total_albedo_clear_direct(:,jlev) = ref_dir_clear(:,jlev) &
+               &  + (trans_dir_dir_clear(:,jlev) * total_albedo_clear_direct(:,jlev+1) &
+               &    +trans_dir_diff_clear(:,jlev) * total_albedo_clear(:,jlev+1)) &
+               &  * trans_clear(:,jlev) * inv_denom_scalar(:)
+        end if
+
+        if (is_clear_sky_layer(jlev)) then
+          ! Clear-sky layer: use scalar adding method
+          inv_denom_scalar(:) = 1.0_jprb &
+               &  / (1.0_jprb - total_albedo(:,1,1,jlev+1)*reflectance(:,1,1,jlev))
+          total_albedo_below = 0.0_jprb
+          total_albedo_below(:,1,1) = reflectance(:,1,1,jlev) &
+               &  + transmittance(:,1,1,jlev)  * transmittance(:,1,1,jlev) &
+               &  * total_albedo(:,1,1,jlev+1) * inv_denom_scalar(:)
+          total_albedo_below_direct = 0.0_jprb
+          total_albedo_below_direct(:,1,1) = ref_dir(:,1,1,jlev) &
+               &  + (trans_dir_dir(:,1,1,jlev)*total_albedo_direct(:,1,1,jlev+1) &
+               &    +trans_dir_diff(:,1,1,jlev)*total_albedo(:,1,1,jlev+1)) &
+               &  * transmittance(:,1,1,jlev) * inv_denom_scalar(:)
+        else 
+          ! Cloudy layer: use matrix adding method
+          denominator = identity_minus_mat_x_mat(ng,ng,nreg, &
+               &  total_albedo(:,:,:,jlev+1), reflectance(:,:,:,jlev))
+          total_albedo_below = reflectance(:,:,:,jlev) &
+               &  + mat_x_mat(ng,ng,nreg,transmittance(:,:,:,jlev), &
+               &  solve_mat(ng,ng,nreg,denominator, &
+               &  mat_x_mat(ng,ng,nreg,total_albedo(:,:,:,jlev+1), &
+               &  transmittance(:,:,:,jlev))))
+          total_albedo_below_direct = ref_dir(:,:,:,jlev) &
+               &  + mat_x_mat(ng,ng,nreg,transmittance(:,:,:,jlev), &
+               &  solve_mat(ng,ng,nreg,denominator, &
+               &    mat_x_mat(ng,ng,nreg,total_albedo_direct(:,:,:,jlev+1), &
+               &                       trans_dir_dir(:,:,:,jlev)) &
+               &   +mat_x_mat(ng,ng,nreg,total_albedo(:,:,:,jlev+1), &
+               &                       trans_dir_diff(:,:,:,jlev))))
+        end if
+
+        ! --------------------------------------------------------
+        ! Section 4.2: Overlap and entrapment
+        ! --------------------------------------------------------
+
+#ifndef PRINT_ENTRAPMENT_DATA
+        if ((config%i_3d_sw_entrapment == IEntrapmentExplicitNonFractal &
+             &  .or. config%i_3d_sw_entrapment == IEntrapmentExplicit) &
+             &  .and. jlev >= i_cloud_top) then
+#else
+        if (config%i_3d_sw_entrapment == IEntrapmentExplicitNonFractal &
+             &  .or. config%i_3d_sw_entrapment == IEntrapmentExplicit) then
+#endif
+          !  "Explicit entrapment": we have the horizontal migration
+          !  distances just above the base of the layer, and need to
+          !  step them to just below the top of the same layer
+          call step_migrations(ng, nreg, cloud%fraction(jcol,jlev), &
+               & layer_depth(jlev), tan_diffuse_angle_3d, tan_sza, &
+               &  reflectance(:,:,:,jlev), transmittance(:,:,:,jlev), &
+               &  ref_dir(:,:,:,jlev), trans_dir_dir(:,:,:,jlev), &
+               &  trans_dir_diff(:,:,:,jlev), total_albedo(:,:,:,jlev+1), &
+               &  total_albedo_direct(:,:,:,jlev+1), &
+               &  x_diffuse, x_direct)
+
+#ifdef PRINT_ENTRAPMENT_DATA
+          ! Write out for later analysis: these are the entrapment
+          ! statistics at the top of layer "jlev"
+          ! Note that number of scattering events is now not computed,
+          ! so print "1.0"
+          if (nreg == 2) then
+            write(101,'(i4,i4,6e14.6)') jcol, jlev, &
+                 &  x_direct(1,:), x_diffuse(1,:), x_direct(1,:)*0.0_jprb+1.0_jprb
+          else
+            write(101,'(i4,i4,9e14.6)') jcol, jlev, &
+                 &  x_direct(1,1:3), x_diffuse(1,1:3), 1.0_jprb,1.0_jprb,1.0_jprb
+          end if
+#endif
+
+        end if
+
+        ! Account for cloud overlap when converting albedo and source
+        ! below a layer interface to the equivalent values just above
+        if (is_clear_sky_layer(jlev) .and. is_clear_sky_layer(jlev-1)) then
+          ! If both layers are cloud free, this is trivial...
+          total_albedo(:,:,:,jlev) = 0.0_jprb
+          total_albedo(:,1,1,jlev) = total_albedo_below(:,1,1)
+          total_albedo_direct(:,:,:,jlev) = 0.0_jprb
+          total_albedo_direct(:,1,1,jlev) = total_albedo_below_direct(:,1,1)
+
+        else if (config%i_3d_sw_entrapment == IEntrapmentMaximum &
+             &  .or. is_clear_sky_layer(jlev-1)) then
+          ! "Maximum entrapment": use the overlap matrices u_matrix and v_matrix
+          ! (this is the original SPARTACUS method)
+          total_albedo(:,:,:,jlev) = singlemat_x_mat(ng,ng,nreg,&
+               &  u_matrix(:,:,jlev,jcol), &
+               &  mat_x_singlemat(ng,ng,nreg,total_albedo_below,&
+               &  v_matrix(:,:,jlev,jcol)))
+          total_albedo_direct(:,:,:,jlev) = singlemat_x_mat(ng,ng,nreg,&
+               &  u_matrix(:,:,jlev,jcol), &
+               &  mat_x_singlemat(ng,ng,nreg,total_albedo_below_direct,&
+               &  v_matrix(:,:,jlev,jcol)))
+
+        else if (config%i_3d_sw_entrapment == IEntrapmentZero) then
+          ! "Zero entrapment": even radiation transported
+          ! laterally between regions in the layers below is
+          ! reflected back up into the same region. First diffuse
+          ! radiation:
+          total_albedo(:,:,:,jlev) = 0.0_jprb
+          do jreg = 1,nreg    ! Target layer (jlev-1)
+            do jreg2 = 1,nreg ! Current layer (jlev)
+              total_albedo(:,jreg,jreg,jlev) = total_albedo(:,jreg,jreg,jlev) &
+                   &  + sum(total_albedo_below(:,:,jreg2),2) &
+                   &  * v_matrix(jreg2,jreg,jlev,jcol)
+            end do
+          end do
+          ! ...then direct radiation:
+          total_albedo_direct(:,:,:,jlev) = 0.0_jprb
+          do jreg = 1,nreg    ! Target layer (jlev-1)
+            do jreg2 = 1,nreg ! Current layer (jlev)
+              total_albedo_direct(:,jreg,jreg,jlev) = total_albedo_direct(:,jreg,jreg,jlev) &
+                   &  + sum(total_albedo_below_direct(:,:,jreg2),2) &
+                   &  * v_matrix(jreg2,jreg,jlev,jcol)
+            end do
+          end do
+
+        else
+          ! Controlled entrapment
+
+#ifdef EXPLICIT_EDGE_ENTRAPMENT
+          ! If "EXPLICIT_EDGE_ENTRAPMENT" is defined then we use the
+          ! explicit entrapment approach for both horizontal transport
+          ! within regions, and horizontal transport between regions
+          ! (otherwise, horizontal transport between regions is
+          ! automatically treated using maximum entrapment). This is
+          ! experimental, which is why it is not a run-time option.
+
+          if (config%i_3d_sw_entrapment == IEntrapmentEdgeOnly) then
+#endif
+          ! Add the contribution from off-diagonal elements of the
+          ! albedo matrix in the lower layer, i.e. radiation that
+          ! flows between regions...
+
+          ! First diffuse radiation:
+          albedo_part = total_albedo_below
+          do jreg = 1,nreg
+            albedo_part(:,jreg,jreg) = 0.0_jprb
+          end do
+          total_albedo(:,:,:,jlev) = singlemat_x_mat(ng,ng,nreg,&
+               &  u_matrix(:,:,jlev,jcol), &
+               &  mat_x_singlemat(ng,ng,nreg,albedo_part,&
+               &  v_matrix(:,:,jlev,jcol)))
+          ! ...then direct radiation:
+          albedo_part = total_albedo_below_direct
+          do jreg = 1,nreg
+            albedo_part(:,jreg,jreg) = 0.0_jprb
+          end do
+          total_albedo_direct(:,:,:,jlev) = singlemat_x_mat(ng,ng,nreg,&
+               &  u_matrix(:,:,jlev,jcol), &
+               &  mat_x_singlemat(ng,ng,nreg,albedo_part,&
+               &  v_matrix(:,:,jlev,jcol)))
+
+#ifdef EXPLICIT_EDGE_ENTRAPMENT
+end if
+#endif
+          
+          ! Now the contribution from the diagonals of the albedo
+          ! matrix in the lower layer
+          if (config%i_3d_sw_entrapment == IEntrapmentEdgeOnly &
+               &  .or. (.not. config%do_3d_effects)) then
+            ! "Edge-only entrapment": the operation we perform is
+            ! essentially diag(total_albedo) += matmul(transpose(v_matrix),
+            ! diag(total_albedo_below)).
+            do jreg = 1,nreg
+              do jreg2 = 1,nreg
+                total_albedo(:,jreg,jreg,jlev) &
+                     &  = total_albedo(:,jreg,jreg,jlev) &
+                     &  + total_albedo_below(:,jreg2,jreg2) &
+                     &  * v_matrix(jreg2,jreg,jlev,jcol)
+                total_albedo_direct(:,jreg,jreg,jlev) &
+                     &  = total_albedo_direct(:,jreg,jreg,jlev) &
+                     &  + total_albedo_below_direct(:,jreg2,jreg2) &
+                     &  * v_matrix(jreg2,jreg,jlev,jcol)
+              end do
+            end do
+
+          else
+            ! "Explicit entrapment"
+
+            do jreg2 = 1,nreg
+              ! Loop through each region in the lower layer. For one
+              ! of the regions in the lower layer, we are imagining it
+              ! to be divided into "nreg" subregions that map onto the
+              ! regions in the upper layer. The rate of exchange
+              ! between these subregions is computed via a coupled
+              ! differential equation written in terms of a singular
+              ! exchange matrix (there are only terms for the exchange
+              ! between subregions, but no propagation effects since
+              ! we already know the albedo of this region). This is
+              ! solved using the matrix-exponential method.
+
+              ! Use the following array for the transfer of either
+              ! diffuse or direct radiation (despite the name), per
+              ! unit horizontal distance travelled
+              transfer_rate_diffuse = 0.0_jprb
+
+              ! As we need to reference the layer above the interface,
+              ! don't do the following on the highest layer
+              if (jlev > 1) then
+
+                ! Given a horizontal migration distance, there is
+                ! still uncertainty about how much entrapment occurs
+                ! associated with how one assumes cloud boundaries
+                ! line up in adjacent layers. "overhang_factor"
+                ! can be varied between 0.0 (the boundaries line up to
+                ! the greatest extent possible given the overlap
+                ! parameter) and 1.0 (the boundaries line up to the
+                ! minimum extent possible); here this is used to
+                ! produce a scaling factor for the transfer rate.
+                transfer_scaling = 1.0_jprb - (1.0_jprb - config%overhang_factor) & 
+                     &  * cloud%overlap_param(jcol,jlev-1) &
+                     &  * min(region_fracs(jreg2,jlev,jcol),region_fracs(jreg2,jlev-1,jcol)) &
+                     &  / max(config%cloud_fraction_threshold, region_fracs(jreg2,jlev,jcol))
+
+                do jreg = 1, nreg-1
+                  ! Compute lateral transfer rates from region jreg to
+                  ! jreg+1 as before, but without length scale which
+                  ! is wavelength dependent.
+
+                  ! Recall that overlap indexing is
+                  ! u_matrix(upper_region, lower_region, level,
+                  ! column).
+                  transfer_rate_diffuse(jreg,jreg+1) = transfer_scaling &
+                       &  * edge_length(jreg,jlev-1) / max(u_matrix(jreg,jreg2,jlev,jcol),1.0e-5_jprb)
+                  ! Compute transfer rates from region jreg+1 to jreg
+                  transfer_rate_diffuse(jreg+1,jreg) = transfer_scaling &
+                       &  * edge_length(jreg,jlev-1) / max(u_matrix(jreg+1,jreg2,jlev,jcol),1.0e-5_jprb)
+                end do
+              
+                ! Compute transfer rates directly between regions 1
+                ! and 3 (not used below)
+                if (edge_length(3,jlev) > 0.0_jprb) then
+                  transfer_rate_diffuse(1,3) = transfer_scaling &
+                       &  * edge_length(3,jlev-1) / max(u_matrix(1,jreg2,jlev,jcol),1.0e-5_jprb)
+                  transfer_rate_diffuse(3,1) = transfer_scaling &
+                       &  * edge_length(3,jlev-1) / max(u_matrix(3,jreg2,jlev,jcol),1.0e-5_jprb)
+                end if
+              end if
+
+              ! Compute matrix of exchange coefficients
+              entrapment = 0.0_jprb
+              inv_effective_size = min(cloud%inv_cloud_effective_size(jcol,jlev-1), &
+                   &                   1.0_jprb/config%min_cloud_effective_size)
+              do jreg = 1,nreg-1
+                ! Diffuse transport down and up with one random
+                ! scattering event
+                if (config%i_3d_sw_entrapment == IEntrapmentExplicit) then
+                  fractal_factor = 1.0_jprb / sqrt(max(1.0_jprb, 2.5_jprb*x_diffuse(:,jreg2) &
+                       &                                         * inv_effective_size))
+                  entrapment(:,jreg+1,jreg) = entrapment(:,jreg+1,jreg) &
+                       &  + transfer_rate_diffuse(jreg,jreg+1)*x_diffuse(:,jreg2) &
+                       &  * fractal_factor
+                  entrapment(:,jreg,jreg+1) = entrapment(:,jreg,jreg+1) &
+                       &  + transfer_rate_diffuse(jreg+1,jreg)*x_diffuse(:,jreg2) &
+                       &  * fractal_factor
+                else
+                  entrapment(:,jreg+1,jreg) = entrapment(:,jreg+1,jreg) &
+                       &  + transfer_rate_diffuse(jreg,jreg+1)*x_diffuse(:,jreg2)
+                  entrapment(:,jreg,jreg+1) = entrapment(:,jreg,jreg+1) &
+                       &  + transfer_rate_diffuse(jreg+1,jreg)*x_diffuse(:,jreg2)                  
+                end if
+                entrapment(:,jreg,jreg) = entrapment(:,jreg,jreg) &
+                     &  - entrapment(:,jreg+1,jreg)
+                entrapment(:,jreg+1,jreg+1) = entrapment(:,jreg+1,jreg+1) &
+                     &  - entrapment(:,jreg,jreg+1)
+              end do
+
+              ! If rate of exchange is excessive the expm can throw a
+              ! floating point exception, even if it tends towards a
+              ! trival limit, so we cap the maximum input to expm by
+              ! scaling down if necessary
+              do jg = 1,ng
+                max_entr = -min(entrapment(jg,1,1),entrapment(jg,2,2))
+                if (max_entr > config%max_cloud_od) then
+                  ! Scale down all inputs for this g point
+                  entrapment(jg,:,:) = entrapment(jg,:,:) * (config%max_cloud_od/max_entr)
+                end if
+              end do
+
+              ! Since the matrix to be exponentiated has a simple
+              ! structure we may use a faster method described in the
+              ! appendix of Hogan et al. (GMD 2018)
+#define USE_FAST_EXPM_EXCHANGE 1
+#ifdef USE_FAST_EXPM_EXCHANGE
+              if (nreg == 2) then
+                call fast_expm_exchange(ng, ng, entrapment(:,2,1), entrapment(:,1,2), &
+                     &                  albedo_part)
+              else
+                call fast_expm_exchange(ng, ng, entrapment(:,2,1), entrapment(:,1,2), &
+                     &                          entrapment(:,3,2), entrapment(:,2,3), &
+                     &                  albedo_part)
+              end if
+#else
+              ! Use matrix exponential to compute rate of exchange
+              albedo_part = entrapment
+              call expm(ng, ng, nreg, albedo_part, IMatrixPatternDense)
+              n_calls_expm = n_calls_expm + ng
+#endif
+
+#ifndef EXPLICIT_EDGE_ENTRAPMENT
+              ! Scale to get the contribution to the diffuse albedo
+              do jreg3 = 1,nreg
+                do jreg = 1,nreg
+                  albedo_part(:,jreg3,jreg) = albedo_part(:,jreg3,jreg) &
+                       &  * v_matrix(jreg2,jreg,jlev,jcol) * total_albedo_below(:,jreg2,jreg2)
+                end do
+              end do
+#else
+              ! The following is an experimental treatment that tries
+              ! to explicitly account for the horizontal distance
+              ! traveled by radiation that passes through cloud sides
+              entrapment = albedo_part
+              albedo_part = 0.0_jprb
+              ! Scale to get the contribution to the diffuse albedo
+              do jreg3 = 1,nreg     ! TO upper region
+                do jreg = 1,nreg    ! FROM upper region
+                  transfer_scaling = 1.0_jprb - (1.0_jprb - config%overhang_factor) & 
+                       &  * cloud%overlap_param(jcol,jlev-1) &
+                       &  * min(region_fracs(jreg,jlev,jcol), region_fracs(jreg,jlev,jcol)) &
+                       &  / max(config%cloud_fraction_threshold, region_fracs(jreg,jlev,jcol))
+                  do jreg4 = 1,nreg ! VIA first lower region (jreg2 is second lower region)
+                    if (.not. (jreg4 == jreg .and. jreg4 /= jreg2)) then
+                      albedo_part(:,jreg3,jreg) = albedo_part(:,jreg3,jreg) + entrapment(:,jreg3,jreg) &
+                           &  * v_matrix(jreg4,jreg,jlev,jcol) * total_albedo_below(:,jreg2,jreg4)
+                    else
+                      albedo_part(:,jreg3,jreg) = albedo_part(:,jreg3,jreg) &
+                           &  + v_matrix(jreg4,jreg,jlev,jcol) * total_albedo_below(:,jreg2,jreg4) &
+                           &  * (transfer_scaling * entrapment(:,jreg3,jreg) &
+                           &    +((1.0_jprb-transfer_scaling) * entrapment(:,jreg3,jreg2)))
+                    end if
+                  end do
+                end do
+              end do
+#endif
+
+              ! Increment diffuse albedo
+              total_albedo(:,:,:,jlev) = total_albedo(:,:,:,jlev) + albedo_part
+
+              ! Now do the same for the direct albedo
+              entrapment = 0.0_jprb
+              do jreg = 1,nreg-1
+                ! Direct transport down and diffuse up with one random
+                ! scattering event
+                if (config%i_3d_sw_entrapment == IEntrapmentExplicit) then
+                  fractal_factor = 1.0_jprb / sqrt(max(1.0_jprb, 2.5_jprb*x_direct(:,jreg2) &
+                       &                                         * inv_effective_size))
+                  entrapment(:,jreg+1,jreg) = entrapment(:,jreg+1,jreg) &
+                       &  + transfer_rate_diffuse(jreg,jreg+1)*x_direct(:,jreg2) &
+                       &  * fractal_factor
+                  entrapment(:,jreg,jreg+1) = entrapment(:,jreg,jreg+1) &
+                       &  + transfer_rate_diffuse(jreg+1,jreg)*x_direct(:,jreg2) &
+                       &  * fractal_factor
+                else
+                  entrapment(:,jreg+1,jreg) = entrapment(:,jreg+1,jreg) &
+                       &  + transfer_rate_diffuse(jreg,jreg+1)*x_direct(:,jreg2)
+                  entrapment(:,jreg,jreg+1) = entrapment(:,jreg,jreg+1) &
+                       &  + transfer_rate_diffuse(jreg+1,jreg)*x_direct(:,jreg2)
+                end if
+                entrapment(:,jreg,jreg) = entrapment(:,jreg,jreg) &
+                     &  - entrapment(:,jreg+1,jreg)
+                entrapment(:,jreg+1,jreg+1) = entrapment(:,jreg+1,jreg+1) &
+                     &  - entrapment(:,jreg,jreg+1)
+              end do
+
+              ! If rate of exchange is excessive the expm can throw a
+              ! floating point exception, even if it tends towards a
+              ! trival limit, so we cap the maximum input to expm by
+              ! scaling down if necessary
+              do jg = 1,ng
+                max_entr = -min(entrapment(jg,1,1),entrapment(jg,2,2))
+                if (max_entr > config%max_cloud_od) then
+                  ! Scale down all inputs for this g point
+                  entrapment(jg,:,:) = entrapment(jg,:,:) * (config%max_cloud_od/max_entr)
+                end if
+              end do
+
+
+#ifdef USE_FAST_EXPM_EXCHANGE
+              if (nreg == 2) then
+                call fast_expm_exchange(ng, ng, entrapment(:,2,1), entrapment(:,1,2), &
+                     &                  albedo_part)
+              else
+                call fast_expm_exchange(ng, ng, entrapment(:,2,1), entrapment(:,1,2), &
+                     &                          entrapment(:,3,2), entrapment(:,2,3), &
+                     &                  albedo_part)
+              end if
+#else
+              albedo_part = entrapment
+              call expm(ng, ng, nreg, albedo_part, IMatrixPatternDense)
+              n_calls_expm = n_calls_expm + ng
+#endif
+
+#ifndef EXPLICIT_EDGE_ENTRAPMENT
+              do jreg3 = 1,nreg
+                do jreg = 1,nreg
+                  albedo_part(:,jreg3,jreg) = albedo_part(:,jreg3,jreg) &
+                       &  * v_matrix(jreg2,jreg,jlev,jcol) * total_albedo_below_direct(:,jreg2,jreg2)
+                end do
+              end do
+#else
+              entrapment = albedo_part
+              albedo_part = 0.0_jprb
+              do jreg3 = 1,nreg
+                do jreg = 1,nreg
+                  transfer_scaling = 1.0_jprb - (1.0_jprb - config%overhang_factor) & 
+                       &  * cloud%overlap_param(jcol,jlev-1) &
+                       &  * min(region_fracs(jreg,jlev,jcol), region_fracs(jreg,jlev-1,jcol))
+                       &  / max(config%cloud_fraction_threshold, region_fracs(jreg,jlev,jcol))
+                  do jreg4 = 1,nreg
+                    if (.not. (jreg4 == jreg .and. jreg4 /= jreg2)) then
+                     albedo_part(:,jreg3,jreg) = albedo_part(:,jreg3,jreg) + entrapment(:,jreg3,jreg) &
+                           &  * v_matrix(jreg4,jreg,jlev,jcol) * total_albedo_below_direct(:,jreg2,jreg4)
+                    else
+                      albedo_part(:,jreg3,jreg) = albedo_part(:,jreg3,jreg) &
+                           &  + v_matrix(jreg4,jreg,jlev,jcol) * total_albedo_below_direct(:,jreg2,jreg4) &
+                           &  * (transfer_scaling * entrapment(:,jreg3,jreg) &
+                           &    +((1.0_jprb-transfer_scaling) * entrapment(:,jreg3,jreg2)))
+                    end if
+                  end do
+                end do
+              end do
+
+#endif
+              ! Increment direct albedo
+              total_albedo_direct(:,:,:,jlev) = total_albedo_direct(:,:,:,jlev) + albedo_part
+
+            end do
+
+          end if
+        end if
+
+        if ((config%i_3d_sw_entrapment == IEntrapmentExplicitNonFractal &
+             &  .or. config%i_3d_sw_entrapment == IEntrapmentExplicit) &
+             &  .and. .not. (is_clear_sky_layer(jlev) .and. is_clear_sky_layer(jlev-1))) then
+          ! Horizontal migration distances are averaged when
+          ! applying overlap rules, so equation is
+          ! x_above=matmul(transpose(v_matrix),x_below)
+          
+          ! We do this into temporary arrays...
+          x_direct_above = 0.0_jprb
+          x_diffuse_above = 0.0_jprb
+          
+          nregactive = nreg
+          if (is_clear_sky_layer(jlev)) then
+            nregactive = 1
+          end if
+
+          do jreg = 1,nreg          ! Target layer (jlev-1)
+            do jreg2 = 1,nregactive ! Current layer (jlev)
+              x_direct_above(:,jreg) = x_direct_above(:,jreg) &
+                   &  + x_direct(:,jreg2) * v_matrix(jreg2,jreg,jlev,jcol)
+              x_diffuse_above(:,jreg) = x_diffuse_above(:,jreg) &
+                   &  + x_diffuse(:,jreg2) * v_matrix(jreg2,jreg,jlev,jcol)
+            end do
+          end do
+          
+          !... then copy out of the temporary arrays
+          x_direct = x_direct_above
+          x_diffuse = x_diffuse_above
+        end if
+
+      end do ! Reverse loop over levels
+
+      ! --------------------------------------------------------
+      ! Section 5: Compute fluxes
+      ! --------------------------------------------------------
+
+      ! Top-of-atmosphere fluxes into the regions of the top-most
+      ! layer, zero since we assume no diffuse downwelling
+      flux_dn_below = 0.0_jprb
+      ! Direct downwelling flux (into a plane perpendicular to the
+      ! sun) entering the top of each region in the top-most layer
+      do jreg = 1,nreg
+        direct_dn_below(:,jreg) = incoming_sw(:,jcol)*region_fracs(jreg,1,jcol)
+      end do
+      ! We're using flux_up_above as a container; actually its
+      ! interpretation at top of atmosphere here is just 'below' the
+      ! TOA interface, so using the regions of the first model layer
+      flux_up_above = mat_x_vec(ng,ng,nreg,total_albedo_direct(:,:,:,1),direct_dn_below)
+
+      if (config%do_clear) then
+        flux_dn_clear = 0.0_jprb
+        direct_dn_clear(:) = incoming_sw(:,jcol)
+        flux_up_clear = direct_dn_clear*total_albedo_clear_direct(:,1)
+      end if
+
+      ! Store the TOA broadband fluxes
+      flux%sw_up(jcol,1) = sum(sum(flux_up_above,1))
+      flux%sw_dn(jcol,1) = mu0 * sum(direct_dn_clear(:))
+      if (allocated(flux%sw_dn_direct)) then
+        flux%sw_dn_direct(jcol,1) = flux%sw_dn(jcol,1)
+      end if
+      if (config%do_clear) then
+        flux%sw_up_clear(jcol,1) = sum(flux_up_clear)
+        flux%sw_dn_clear(jcol,1) = flux%sw_dn(jcol,1)
+        if (allocated(flux%sw_dn_direct_clear)) then
+          flux%sw_dn_direct_clear(jcol,1) = flux%sw_dn_clear(jcol,1)
+        end if
+      end if
+
+      ! Save the spectral fluxes if required
+      if (config%do_save_spectral_flux) then
+        call indexed_sum(sum(flux_up_above(:,:),2), &
+             &           config%i_spec_from_reordered_g_sw, &
+             &           flux%sw_up_band(:,jcol,1))
+        call indexed_sum(sum(direct_dn_below(:,:),2), &
+             &           config%i_spec_from_reordered_g_sw, &
+             &           flux%sw_dn_band(:,jcol,1))
+        flux%sw_dn_band(:,jcol,1) = mu0 * flux%sw_dn_band(:,jcol,1)
+        if (allocated(flux%sw_dn_direct_band)) then
+          flux%sw_dn_direct_band(:,jcol,1) = flux%sw_dn_band(:,jcol,1)
+        end if
+        if (config%do_clear) then
+          flux%sw_dn_clear_band(:,jcol,1) = flux%sw_dn_band(:,jcol,1)
+          call indexed_sum(flux_up_clear, &
+               &           config%i_spec_from_reordered_g_sw, &
+               &           flux%sw_up_clear_band(:,jcol,1))
+          if (allocated(flux%sw_dn_direct_clear_band)) then
+            flux%sw_dn_direct_clear_band(:,jcol,1) &
+                 &   = flux%sw_dn_clear_band(:,jcol,1)
+          end if
+        end if
+      end if
+
+      ! Final loop back down through the atmosphere to compute fluxes
+      do jlev = 1,nlev
+
+#ifdef PRINT_ENTRAPMENT_DATA
+        if (config%i_3d_sw_entrapment == IEntrapmentExplicitNonFractal &
+             &  .or. config%i_3d_sw_entrapment == IEntrapmentExplicit) then
+          ! Save downwelling direct and diffuse fluxes at the top of
+          ! layer "jlev" in each of the regions of layer "jlev"
+          if (nreg == 2) then
+            write(102,'(i4,i4,4e14.6)') jcol, jlev, direct_dn_below(1,:), flux_dn_below(1,:)
+          else
+            write(102,'(i4,i4,6e14.6)') jcol, jlev, direct_dn_below(1,1:3), flux_dn_below(1,1:3)
+          end if
+        end if
+#endif
+
+        ! Compute the solar downwelling "source" at the base of the
+        ! layer due to scattering of the direct beam within it
+        if (config%do_clear) then
+          source_dn_clear = trans_dir_diff_clear(:,jlev)*direct_dn_clear
+        end if
+        source_dn(:,:) = mat_x_vec(ng,ng,nreg,trans_dir_diff(:,:,:,jlev),direct_dn_below, &
+             &  is_clear_sky_layer(jlev))
+
+        ! Compute direct downwelling flux in each region at base of
+        ! current layer
+        if (config%do_clear) then
+          direct_dn_clear = trans_dir_dir_clear(:,jlev)*direct_dn_clear
+        end if
+        direct_dn_above = mat_x_vec(ng,ng,nreg,trans_dir_dir(:,:,:,jlev),direct_dn_below, &
+             &  is_clear_sky_layer(jlev))
+
+        ! Integrate downwelling direct flux across spectrum and
+        ! regions, and store (the diffuse part will be added later)
+        flux%sw_dn(jcol,jlev+1) = mu0 * sum(sum(direct_dn_above,1))
+        if (allocated(flux%sw_dn_direct)) then
+          flux%sw_dn_direct(jcol,jlev+1) = flux%sw_dn(jcol,jlev+1)
+        end if
+        if (config%do_clear) then
+          flux%sw_dn_clear(jcol,jlev+1) = mu0 * sum(direct_dn_clear)
+          if (allocated(flux%sw_dn_direct_clear)) then
+            flux%sw_dn_direct_clear(jcol,jlev+1) &
+                 &  = flux%sw_dn_clear(jcol,jlev+1)
+          end if
+        end if
+
+        if (config%do_save_spectral_flux) then
+          call indexed_sum(sum(direct_dn_above,2), &
+               &           config%i_spec_from_reordered_g_sw, &
+               &           flux%sw_dn_band(:,jcol,jlev+1))
+          flux%sw_dn_band(:,jcol,jlev+1) = mu0 * flux%sw_dn_band(:,jcol,jlev+1)
+
+          if (allocated(flux%sw_dn_direct_band)) then
+            flux%sw_dn_direct_band(:,jcol,jlev+1) &
+                 &   = flux%sw_dn_band(:,jcol,jlev+1)
+          end if
+          if (config%do_clear) then
+            call indexed_sum(direct_dn_clear, &
+                 &           config%i_spec_from_reordered_g_sw, &
+                 &           flux%sw_dn_clear_band(:,jcol,jlev+1))
+            flux%sw_dn_clear_band(:,jcol,jlev+1) = mu0 &
+                 &   * flux%sw_dn_clear_band(:,jcol,jlev+1)
+            if (allocated(flux%sw_dn_direct_clear_band)) then
+              flux%sw_dn_direct_clear_band(:,jcol,jlev+1) &
+                   &  = flux%sw_dn_clear_band(:,jcol,jlev+1)
+            end if
+          end if
+        end if
+
+        if (config%do_clear) then
+          ! Scalar operations for clear-sky fluxes
+          flux_dn_clear(:) = (trans_clear(:,jlev)*flux_dn_clear(:) &
+               &  + ref_clear(:,jlev)*total_albedo_clear_direct(:,jlev+1)*direct_dn_clear &
+               &  + source_dn_clear) &
+               &  / (1.0_jprb - ref_clear(:,jlev)*total_albedo_clear(:,jlev+1))
+          flux_up_clear(:) = total_albedo_clear_direct(:,jlev+1)*direct_dn_clear &
+               &  + total_albedo_clear(:,jlev+1)*flux_dn_clear
+        end if
+
+        if (is_clear_sky_layer(jlev)) then
+          ! Scalar operations for clear-sky layer
+          flux_dn_above(:,1) = (transmittance(:,1,1,jlev)*flux_dn_below(:,1) &
+               &  + reflectance(:,1,1,jlev)*total_albedo_direct(:,1,1,jlev+1)*direct_dn_above(:,1) &
+               &  + source_dn(:,1)) &
+               &  / (1.0_jprb - reflectance(:,1,1,jlev)*total_albedo(:,1,1,jlev+1))
+          flux_dn_above(:,2:nreg) = 0.0_jprb
+          flux_up_above(:,1) = total_albedo_direct(:,1,1,jlev+1)*direct_dn_above(:,1) &
+               &  + total_albedo(:,1,1,jlev+1)*flux_dn_above(:,1)
+          flux_up_above(:,2:nreg) = 0.0_jprb
+        else
+          ! Matrix operations for cloudy layer
+          denominator = identity_minus_mat_x_mat(ng,ng,nreg,reflectance(:,:,:,jlev), &
+               &  total_albedo(:,:,:,jlev+1))
+          total_source = mat_x_vec(ng,ng,nreg,total_albedo_direct(:,:,:,jlev+1),direct_dn_above)
+
+          flux_dn_above = solve_vec(ng,ng,nreg,denominator, &
+               &  mat_x_vec(ng,ng,nreg,transmittance(:,:,:,jlev),flux_dn_below) &
+               &  + mat_x_vec(ng,ng,nreg,reflectance(:,:,:,jlev), total_source(:,:)) &
+               &  + source_dn(:,:))
+          flux_up_above = mat_x_vec(ng,ng,nreg,total_albedo(:,:,:,jlev+1), &
+               &  flux_dn_above) + total_source(:,:)
+        end if
+
+        ! Account for overlap rules in translating fluxes just above
+        ! a layer interface to the values just below
+        if (is_clear_sky_layer(jlev) .and. is_clear_sky_layer(jlev+1)) then
+          ! Regions in current layer map directly on to regions in
+          ! layer below
+          flux_dn_below = flux_dn_above
+          direct_dn_below = direct_dn_above
+        else
+          ! Apply downward overlap matrix to compute direct
+          ! downwelling flux entering the top of each region in the
+          ! layer below
+          flux_dn_below = singlemat_x_vec(ng,ng,nreg,v_matrix(:,:,jlev+1,jcol), &
+               &  flux_dn_above)
+          direct_dn_below = singlemat_x_vec(ng,ng,nreg,v_matrix(:,:,jlev+1,jcol), &
+               &  direct_dn_above)
+        end if
+
+        ! Store the broadband fluxes
+        flux%sw_up(jcol,jlev+1) = sum(sum(flux_up_above,1))
+        flux%sw_dn(jcol,jlev+1) &
+             &  = flux%sw_dn(jcol,jlev+1) + sum(sum(flux_dn_above,1))
+        if (config%do_clear) then
+          flux%sw_up_clear(jcol,jlev+1) = sum(flux_up_clear)
+          flux%sw_dn_clear(jcol,jlev+1) &
+               &  = flux%sw_dn_clear(jcol,jlev+1) + sum(flux_dn_clear)
+        end if
+
+        ! Save the spectral fluxes if required
+        if (config%do_save_spectral_flux) then
+          call indexed_sum(sum(flux_up_above,2), &
+               &           config%i_spec_from_reordered_g_sw, &
+               &           flux%sw_up_band(:,jcol,jlev+1))
+          call add_indexed_sum(sum(flux_dn_above,2), &
+               &           config%i_spec_from_reordered_g_sw, &
+               &           flux%sw_dn_band(:,jcol,jlev+1))
+          if (config%do_clear) then
+            call indexed_sum(flux_up_clear, &
+                 &           config%i_spec_from_reordered_g_sw, &
+                 &           flux%sw_up_clear_band(:,jcol,jlev+1))
+            call add_indexed_sum(flux_dn_clear, &
+                 &           config%i_spec_from_reordered_g_sw, &
+                 &           flux%sw_dn_clear_band(:,jcol,jlev+1))
+          end if
+        end if
+
+      end do ! Final loop over levels
+
+      ! Store surface spectral fluxes, if required (after the end of
+      ! the final loop over levels, the current values of these arrays
+      ! will be the surface values)
+      flux%sw_dn_diffuse_surf_g(:,jcol) = sum(flux_dn_above,2)
+      flux%sw_dn_direct_surf_g(:,jcol)  = mu0 * sum(direct_dn_above,2)
+      if (config%do_clear) then
+        flux%sw_dn_diffuse_surf_clear_g(:,jcol) = flux_dn_clear
+        flux%sw_dn_direct_surf_clear_g(:,jcol)  = mu0 * direct_dn_clear
+      end if
+
+    end do ! Loop over columns
+    if (config%iverbose >= 3) then
+      write(nulout,*)
+    end if
+
+    ! Report number of calls to each method of solving single-layer
+    ! two-stream equations
+    if (config%iverbose >= 4) then
+      write(nulout,'(a,i0)') '  Matrix-exponential calls: ', n_calls_expm
+      write(nulout,'(a,i0)') '  Meador-Weaver calls: ', n_calls_meador_weaver
+    end if
+
+    if (lhook) call dr_hook('radiation_spartacus_sw:solver_spartacus_sw',1,hook_handle)
+
+  end subroutine solver_spartacus_sw
+
+
+  ! Step the horizontal migration distances from the base of a layer
+  ! to the top, accounting for the extra distance travelled within the
+  ! layer
+  subroutine step_migrations(ng, nreg, cloud_frac, &
+       &  layer_depth, tan_diffuse_angle_3d, tan_sza, &
+       &  reflectance, transmittance, ref_dir, trans_dir_dir, &
+       &  trans_dir_diff, total_albedo_diff, total_albedo_dir, &
+       &  x_diffuse, x_direct)
+    
+    use parkind1, only : jprb
+
+    implicit none
+
+    ! Inputs
+
+    ! Number of g points and regions
+    integer, intent(in) :: ng, nreg
+    ! Cloud fraction
+    real(jprb), intent(in) :: cloud_frac
+    ! Layer depth (m), tangent of diffuse zenith angle and tangent of
+    ! solar zenith angle
+    real(jprb), intent(in) :: layer_depth, tan_diffuse_angle_3d, tan_sza
+    ! Reflectance and transmittance to diffuse downwelling radiation
+    real(jprb), intent(in), dimension(ng, nreg, nreg) :: reflectance, transmittance
+    ! Reflectance and transmittance to direct downwelling radiation
+    real(jprb), intent(in), dimension(ng, nreg, nreg) :: ref_dir, trans_dir_dir
+    ! Transmittance involving direct entering a layer from the top and
+    ! diffuse leaving from the bottom
+    real(jprb), intent(in), dimension(ng, nreg, nreg) :: trans_dir_diff
+
+    ! Total albedo of direct and diffuse radiation of the atmosphere
+    ! below the layer in question
+    real(jprb), intent(in), dimension(ng, nreg, nreg) &
+         &  :: total_albedo_diff, total_albedo_dir
+
+    ! Inputs/outputs
+
+    ! Horizontal migration distance (m) of reflected light
+    real(jprb), intent(inout), dimension(ng, nreg) :: x_diffuse, x_direct
+
+    ! Local variables
+
+    ! Top albedo, i.e. the albedo of the top of the layer assuming no
+    ! lateral transport
+    real(jprb), dimension(ng) :: top_albedo
+
+    ! Multiple-scattering amplitude enhancement
+    real(jprb), dimension(ng) :: ms_enhancement
+
+    ! Multiple-scattering distance enhancement
+    real(jprb), dimension(ng) :: x_enhancement
+
+
+    real(jprb) :: x_layer_diffuse, x_layer_direct
+    integer :: jreg, istartreg, iendreg
+
+    istartreg = 1
+    iendreg   = nreg
+
+    if (cloud_frac <= 0.0_jprb) then
+      ! Clear-sky layer: don't waste time on cloudy regions
+      iendreg = 1
+    else if (cloud_frac >= 1.0_jprb) then
+      ! Overcast layer: don't waste time on clear region
+      istartreg = 2
+    end if
+
+    ! This is the mean horizontal distance travelled by diffuse
+    ! radiation that travels from the top of a layer to the centre and
+    ! is then scattered back up and out
+    x_layer_diffuse = layer_depth * tan_diffuse_angle_3d/sqrt(2.0_jprb) 
+
+    ! This is the mean horizontal distance travelled by direct
+    ! radiation that travels from the top of a layer to the centre and
+    ! is then scattered back up and out
+    x_layer_direct  = layer_depth * sqrt(tan_sza*tan_sza &
+         &                             + tan_diffuse_angle_3d*tan_diffuse_angle_3d) * 0.5_jprb
+
+    do jreg = istartreg,iendreg
+      ! Geometric series enhancement due to multiple scattering: the
+      ! amplitude enhancement is equal to the limit of
+      ! T*[1+RA+(RA)^2+(RA)^3+...]
+      ms_enhancement = transmittance(:,jreg,jreg) &
+           &  / (1.0_jprb - reflectance(:,jreg,jreg)*total_albedo_diff(:,jreg,jreg))
+      ! ...and the distance enhancement is approximately equal to the
+      ! limit of T*[1+sqrt(2)*RA+sqrt(3)*(RA)^2+sqrt(4)*(RA)^3+...]
+      x_enhancement = (1.0_jprb - reflectance(:,jreg,jreg)*total_albedo_diff(:,jreg,jreg))**(-1.5_jprb)
+
+      ! Horizontal migration of direct downwelling radiation
+      top_albedo = max(1.0e-8_jprb, ref_dir(:,jreg,jreg) + ms_enhancement &
+           &  * (trans_dir_diff(:,jreg,jreg)*total_albedo_diff(:,jreg,jreg) &
+           &     +trans_dir_dir(:,jreg,jreg)*total_albedo_dir(:,jreg,jreg)))
+      ! The following is approximate and has been found to
+      ! occasionally go negative
+      x_direct(:,jreg) = max(0.0_jprb, x_layer_direct &
+           &  + ((trans_dir_diff(:,jreg,jreg)*total_albedo_diff(:,jreg,jreg)*x_enhancement &
+           &      +trans_dir_dir(:,jreg,jreg)*total_albedo_dir(:,jreg,jreg)*(x_enhancement-1.0_jprb)) &
+           &     *(x_diffuse(:,jreg)+x_layer_diffuse) &
+           &    +trans_dir_dir(:,jreg,jreg)*total_albedo_dir(:,jreg,jreg) &
+           &     *(x_direct(:,jreg)+x_layer_direct)) &
+           &    * transmittance(:,jreg,jreg) / top_albedo)
+
+      ! Horizontal migration of diffuse downwelling radiation
+      top_albedo = max(1.0e-8_jprb, reflectance(:,jreg,jreg) &
+           &  + ms_enhancement*transmittance(:,jreg,jreg)*total_albedo_diff(:,jreg,jreg))
+      x_diffuse(:,jreg) = x_layer_diffuse + x_enhancement*total_albedo_diff(:,jreg,jreg) &
+           &  *(transmittance(:,jreg,jreg)*transmittance(:,jreg,jreg)) &
+           &  * (x_diffuse(:,jreg) + x_layer_diffuse) / top_albedo
+
+    end do
+    if (iendreg < nreg) then
+      x_diffuse(:,iendreg+1:nreg)      = 0.0_jprb
+      x_direct(:,iendreg+1:nreg)       = 0.0_jprb
+    else if (istartreg == 2) then
+      x_diffuse(:,1)      = 0.0_jprb
+      x_direct(:,1)       = 0.0_jprb
+    end if
+
+  end subroutine step_migrations
+
+end module radiation_spartacus_sw
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_thermodynamics.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_thermodynamics.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_thermodynamics.F90	(revision 3908)
@@ -0,0 +1,330 @@
+! radiation_thermodynamics.F90 - Derived type for pressure & temperature
+!
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2017-05-11  R. Hogan  Fix startcol/endcol for get_layer_mass
+!   2019-01-14  R. Hogan  Added out_of_physical_bounds routine
+!   2019-01-14  R. Hogan  Capped h2o_sat_liq at 1
+
+module radiation_thermodynamics
+
+  use parkind1, only : jprb
+
+  implicit none
+  public
+
+  !---------------------------------------------------------------------
+  ! Derived type for storing pressure and temperature at half levels
+  type thermodynamics_type
+     real(jprb), allocatable, dimension(:,:) :: &
+          &  pressure_hl, &   ! (ncol,nlev+1) pressure (Pa)
+          &  temperature_hl   ! (ncol,nlev+1) temperature (K)
+
+     ! The following is a function of pressure and temperature: you
+     ! can calculate it according to your favourite formula, or the
+     ! calc_saturation_wrt_liquid subroutine can be used to do this
+     ! approximately
+     real(jprb), allocatable, dimension(:,:) :: &
+          &  h2o_sat_liq ! (ncol,nlev) specific humidity at liquid
+                         ! saturation (kg/kg)
+   contains
+     procedure :: allocate   => allocate_thermodynamics_arrays
+     procedure :: deallocate => deallocate_thermodynamics_arrays
+     procedure :: calc_saturation_wrt_liquid
+     procedure :: get_layer_mass
+     procedure :: get_layer_mass_column
+     procedure :: out_of_physical_bounds
+
+  end type thermodynamics_type
+
+contains
+
+
+  !---------------------------------------------------------------------
+  ! Allocate variables with specified dimensions
+  subroutine allocate_thermodynamics_arrays(this, ncol, nlev, &
+       &                                    use_h2o_sat)
+
+    use yomhook,  only : lhook, dr_hook
+
+    class(thermodynamics_type), intent(inout) :: this
+    integer, intent(in)           :: ncol  ! Number of columns
+    integer, intent(in)           :: nlev  ! Number of levels
+    logical, intent(in), optional :: use_h2o_sat ! Allocate h2o_sat_liq?
+
+    logical :: use_h2o_sat_local
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_thermodynamics:allocate',0,hook_handle)
+
+    allocate(this%pressure_hl(ncol,nlev+1))
+    allocate(this%temperature_hl(ncol,nlev+1))
+
+    use_h2o_sat_local = .false.
+    if (present(use_h2o_sat)) then
+      use_h2o_sat_local = use_h2o_sat
+    end if
+    
+    if (use_h2o_sat_local) then
+      allocate(this%h2o_sat_liq(ncol,nlev))
+    end if    
+
+    if (lhook) call dr_hook('radiation_thermodynamics:allocate',1,hook_handle)
+
+  end subroutine allocate_thermodynamics_arrays
+
+
+  !---------------------------------------------------------------------
+  ! Deallocate variables
+  subroutine deallocate_thermodynamics_arrays(this)
+
+    use yomhook,  only : lhook, dr_hook
+
+    class(thermodynamics_type), intent(inout) :: this
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_thermodynamics:deallocate',0,hook_handle)
+
+    if (allocated(this%pressure_hl)) then
+      deallocate(this%pressure_hl)
+    end if
+    if (allocated(this%temperature_hl)) then
+      deallocate(this%temperature_hl)
+    end if
+    if (allocated(this%h2o_sat_liq)) then
+      deallocate(this%h2o_sat_liq)
+    end if
+
+    if (lhook) call dr_hook('radiation_thermodynamics:deallocate',1,hook_handle)
+  
+  end subroutine deallocate_thermodynamics_arrays
+
+
+  !---------------------------------------------------------------------
+  ! Calculate approximate saturation with respect to liquid
+  subroutine calc_saturation_wrt_liquid(this,istartcol,iendcol)
+
+    use yomhook,  only : lhook, dr_hook
+
+    class(thermodynamics_type), intent(inout) :: this
+    integer, intent(in)                       :: istartcol, iendcol
+
+    ! Pressure and temperature at full levels
+    real(jprb) :: pressure, temperature
+
+    ! Vapour pressure (Pa)
+    real(jprb) :: e_sat
+
+    integer :: ncol, nlev ! Dimension sizes
+    integer :: jcol, jlev ! Loop indices for column and level
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_thermodynamics:calc_saturation_wrt_liquid',0,hook_handle)
+
+    ncol = size(this%pressure_hl,1)
+    nlev = size(this%pressure_hl,2) - 1
+
+    if (.not. allocated(this%h2o_sat_liq)) then
+      allocate(this%h2o_sat_liq(ncol,nlev))
+    end if
+
+    do jlev = 1,nlev
+       do jcol = istartcol,iendcol
+          pressure = 0.5 * (this%pressure_hl(jcol,jlev)+this%pressure_hl(jcol,jlev+1))
+          temperature = 0.5 * (this%temperature_hl(jcol,jlev)+this%temperature_hl(jcol,jlev+1))
+          e_sat = 6.11e2_jprb * exp( 17.269_jprb * (temperature-273.16_jprb) / (temperature-35.86_jprb) )
+          ! This formula can go above 1 at low pressure so needs to be
+          ! capped
+          this%h2o_sat_liq(jcol,jlev) = min(1.0_jprb, 0.622_jprb * e_sat / pressure)
+       end do
+    end do
+
+    if (lhook) call dr_hook('radiation_thermodynamics:calc_saturation_wrt_liquid',1,hook_handle)
+
+  end subroutine calc_saturation_wrt_liquid
+
+
+  !---------------------------------------------------------------------
+  ! Calculate the dry mass of each layer, neglecting humidity effects.
+  ! The first version is for all columns.
+  subroutine get_layer_mass(this,istartcol,iendcol,layer_mass)
+
+    use yomhook,              only : lhook, dr_hook
+    use radiation_constants,  only : AccelDueToGravity
+
+    class(thermodynamics_type), intent(in)  :: this
+    integer,                    intent(in)  :: istartcol, iendcol
+    real(jprb),                 intent(out) :: layer_mass(:,:)
+
+    integer    :: nlev
+    real(jprb) :: inv_g
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_thermodynamics:get_layer_mass',0,hook_handle)
+
+    nlev  = ubound(this%pressure_hl,2) - 1
+    inv_g = 1.0_jprb / AccelDueToGravity
+
+    layer_mass(istartcol:iendcol,1:nlev) &
+         &  = ( this%pressure_hl(istartcol:iendcol,2:nlev+1) &
+         &     -this%pressure_hl(istartcol:iendcol,1:nlev  )  ) &
+         &  * inv_g 
+    
+    if (lhook) call dr_hook('radiation_thermodynamics:get_layer_mass',1,hook_handle)
+
+  end subroutine get_layer_mass
+
+  !---------------------------------------------------------------------
+  ! Calculate the dry mass of each layer, neglecting humidity effects.
+  ! The second version is for one column, the one numbered "icol".
+  subroutine get_layer_mass_column(this, icol, layer_mass)
+
+    use yomhook,              only : lhook, dr_hook
+    use radiation_constants,  only : AccelDueToGravity
+
+    class(thermodynamics_type), intent(in)  :: this
+    integer,                    intent(in)  :: icol
+    real(jprb),                 intent(out) :: layer_mass(:)
+
+    integer    :: nlev
+    real(jprb) :: inv_g
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_thermodynamics:get_layer_mass_column',0,hook_handle)
+
+    nlev  = ubound(this%pressure_hl,2) - 1
+    inv_g = 1.0_jprb / AccelDueToGravity
+
+    layer_mass = ( this%pressure_hl(icol,2:nlev+1) &
+             &    -this%pressure_hl(icol,1:nlev  )  ) &
+             &   * inv_g
+    
+    if (lhook) call dr_hook('radiation_thermodynamics:get_layer_mass_column',1,hook_handle)
+
+  end subroutine get_layer_mass_column
+
+
+  !---------------------------------------------------------------------
+  ! Estimate the separation between the mid-points of model layers
+  ! given the half-level pressure and temperature.  This is not in
+  ! terms of the "thermodynamics" type as it is useful for computing
+  ! overlap decorrelation lengths and hence cloud cover outside the
+  ! radiation scheme.
+  subroutine get_layer_separation(pressure_hl, temperature_hl, layer_separation)
+
+    use yomhook,              only : lhook, dr_hook
+    use radiation_constants,  only : GasConstantDryAir, AccelDueToGravity
+
+    ! Pressure (Pa) and temperature (K) at half-levels, dimensioned
+    ! (ncol,nlev+1) where ncol is the number of columns and nlev is
+    ! the number of model levels
+    real(jprb), dimension(:,:), intent(in)  :: pressure_hl, temperature_hl
+
+    ! Layer separation in metres, dimensioned (ncol,nlev-1)
+    real(jprb), dimension(:,:), intent(out) :: layer_separation
+
+    ! Ratio of gas constant for dry air to acceleration due to gravity
+    real(jprb), parameter :: R_over_g = GasConstantDryAir / AccelDueToGravity
+
+    ! Loop indices and array bounds
+    integer    :: jlev
+    integer    :: i1, i2, nlev
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_thermodynamics:get_layer_separation',0,hook_handle)
+
+    i1   = lbound(pressure_hl,1)
+    i2   = ubound(pressure_hl,1)
+    nlev =   size(pressure_hl,2)-1
+
+    if (pressure_hl(i1,2) > pressure_hl(i1,1)) then
+      ! Pressure is increasing with index (order of layers is
+      ! top-of-atmosphere to surface). In case pressure_hl(:,1)=0, we
+      ! don't take the logarithm of the first pressure in each column.
+      layer_separation(i1:i2,1) = R_over_g * temperature_hl(i1:i2,2) &
+           &                    * log(pressure_hl(i1:i2,3)/pressure_hl(i1:i2,2))
+      
+      ! For other layers we take the separation between midpoints to
+      ! be half the separation between the half-levels at the edge of
+      ! the two adjacent layers
+      do jlev = 2,nlev-1
+        layer_separation(i1:i2,jlev) = (0.5_jprb * R_over_g) * temperature_hl(i1:i2,jlev+1) &
+             &                    * log(pressure_hl(i1:i2,jlev+2)/pressure_hl(i1:i2,jlev))
+
+      end do
+
+    else
+      ! Pressure is decreasing with index (order of layers is surface
+      ! to top-of-atmosphere).  In case pressure_hl(:,nlev+1)=0, we
+      ! don't take the logarithm of the last pressure in each column.
+
+      do jlev = 1,nlev-2
+        layer_separation(i1:i2,jlev) = (0.5_jprb * R_over_g) * temperature_hl(i1:i2,jlev+1) &
+             &                    * log(pressure_hl(i1:i2,jlev)/pressure_hl(i1:i2,jlev+2))
+
+      end do
+      layer_separation(i1:i2,nlev-1) = R_over_g * temperature_hl(i1:i2,nlev) &
+           &                    * log(pressure_hl(i1:i2,nlev-1)/pressure_hl(i1:i2,nlev))
+
+    end if
+
+    if (lhook) call dr_hook('radiation_thermodynamics:get_layer_separation',1,hook_handle)    
+
+  end subroutine get_layer_separation
+
+
+  !---------------------------------------------------------------------
+  ! Return .true. if variables are out of a physically sensible range,
+  ! optionally only considering columns between istartcol and iendcol
+  function out_of_physical_bounds(this, istartcol, iendcol, do_fix) result(is_bad)
+
+    use yomhook,          only : lhook, dr_hook
+    use radiation_config, only : out_of_bounds_2d
+
+    class(thermodynamics_type), intent(inout) :: this
+    integer,           optional,intent(in) :: istartcol, iendcol
+    logical,           optional,intent(in) :: do_fix
+    logical                                :: is_bad
+
+    logical    :: do_fix_local
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_thermodynamics:out_of_physical_bounds',0,hook_handle)
+
+    if (present(do_fix)) then
+      do_fix_local = do_fix
+    else
+      do_fix_local = .false.
+    end if
+
+    ! Dangerous to cap pressure_hl as then the pressure difference across a layer could be zero
+    is_bad =    out_of_bounds_2d(this%pressure_hl, 'pressure_hl', 0.0_jprb, 110000.0_jprb, &
+         &                       .false., i1=istartcol, i2=iendcol) &
+         & .or. out_of_bounds_2d(this%temperature_hl, 'temperature_hl', 100.0_jprb,  400.0_jprb, &
+         &                       do_fix_local, i1=istartcol, i2=iendcol) &
+         & .or. out_of_bounds_2d(this%h2o_sat_liq, 'h2o_sat_liq', 0.0_jprb, 1.0_jprb, &
+         &                       do_fix_local, i1=istartcol, i2=iendcol)
+
+    if (lhook) call dr_hook('radiation_thermodynamics:out_of_physical_bounds',1,hook_handle)
+
+  end function out_of_physical_bounds
+  
+end module radiation_thermodynamics
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_tripleclouds_lw.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_tripleclouds_lw.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_tripleclouds_lw.F90	(revision 3908)
@@ -0,0 +1,536 @@
+! radiation_tripleclouds_lw.F90 - Longwave "Tripleclouds" solver
+!
+! (C) Copyright 2016- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2017-04-28  R. Hogan  Receive emission/albedo rather than planck/emissivity
+!   2017-04-22  R. Hogan  Store surface fluxes at all g-points
+!   2017-10-23  R. Hogan  Renamed single-character variables
+!   2018-10-08  R. Hogan  Call calc_region_properties
+
+module radiation_tripleclouds_lw
+
+  public
+
+contains
+  ! Small routine for scaling cloud optical depth in the cloudy
+  ! regions
+#include "radiation_optical_depth_scaling.h"
+
+  ! This module contains just one subroutine, the longwave
+  ! "Tripleclouds" solver in which cloud inhomogeneity is treated by
+  ! dividing each model level into three regions, one clear and two
+  ! cloudy (with differing optical depth). This approach was described
+  ! by Shonk and Hogan (2008).
+
+  subroutine solver_tripleclouds_lw(nlev,istartcol,iendcol, &
+       &  config, cloud, & 
+       &  od, ssa, g, od_cloud, ssa_cloud, g_cloud, planck_hl, &
+       &  emission, albedo, &
+       &  flux)
+
+    use parkind1, only           : jprb
+    use yomhook,  only           : lhook, dr_hook
+
+!    use radiation_io, only             : nulout
+    use radiation_config, only         : config_type, IPdfShapeGamma
+    use radiation_cloud, only          : cloud_type
+    use radiation_regions, only        : calc_region_properties
+    use radiation_overlap, only        : calc_overlap_matrices
+    use radiation_flux, only           : flux_type, &
+         &                               indexed_sum, add_indexed_sum
+    use radiation_matrix, only         : singlemat_x_vec
+    use radiation_two_stream, only     : calc_two_stream_gammas_lw, &
+         &                               calc_reflectance_transmittance_lw, &
+         &                               calc_no_scattering_transmittance_lw
+    use radiation_lw_derivatives, only : calc_lw_derivatives_region
+
+    implicit none
+
+    ! Inputs
+    integer, intent(in) :: nlev               ! number of model levels
+    integer, intent(in) :: istartcol, iendcol ! range of columns to process
+    type(config_type),        intent(in) :: config
+    type(cloud_type),         intent(in) :: cloud
+
+    ! Gas and aerosol optical depth of each layer at each longwave
+    ! g-point
+    real(jprb), intent(in), dimension(config%n_g_lw,nlev,istartcol:iendcol) :: od
+
+    ! Gas and aerosol single-scattering albedo and asymmetry factor,
+    ! only if longwave scattering by aerosols is to be represented
+    real(jprb), intent(in), &
+         &  dimension(config%n_g_lw_if_scattering,nlev,istartcol:iendcol) :: ssa, g
+
+    ! Cloud and precipitation optical depth of each layer in each
+    ! longwave band
+    real(jprb), intent(in) :: od_cloud(config%n_bands_lw,nlev,istartcol:iendcol)
+
+    ! Cloud and precipitation single-scattering albedo and asymmetry
+    ! factor, only if longwave scattering by clouds is to be
+    ! represented
+    real(jprb), intent(in), dimension(config%n_bands_lw_if_scattering, &
+         &                            nlev,istartcol:iendcol) :: ssa_cloud, g_cloud
+
+    ! Planck function (emitted flux from a black body) at half levels
+    ! and at the surface at each longwave g-point
+    real(jprb), intent(in), dimension(config%n_g_lw,nlev+1,istartcol:iendcol) :: planck_hl
+
+    ! Emission (Planck*emissivity) and albedo (1-emissivity) at the
+    ! surface at each longwave g-point
+    real(jprb), intent(in), dimension(config%n_g_lw, istartcol:iendcol) :: emission, albedo
+
+    ! Optical depth, single scattering albedo and asymmetry factor in
+    ! each g-point including gas, aerosol and clouds
+    real(jprb), dimension(config%n_g_lw) :: od_total, ssa_total, g_total
+
+    ! Modified optical depth after Tripleclouds scaling to represent
+    ! cloud inhomogeneity
+    real(jprb), dimension(config%n_g_lw) :: od_cloud_new
+
+    ! Output
+    type(flux_type), intent(inout):: flux
+
+    ! Local constants
+    integer, parameter :: nregions = 3
+
+    ! In a clear-sky layer this will be 1, otherwise equal to nregions
+    integer :: nreg
+
+    ! Local variables
+    
+    ! The area fractions of each region
+    real(jprb) :: region_fracs(1:nregions,nlev,istartcol:iendcol)
+
+    ! The scaling used for the optical depth in the cloudy regions
+    real(jprb) :: od_scaling(2:nregions,nlev,istartcol:iendcol)
+
+    ! Directional overlap matrices defined at all layer interfaces
+    ! including top-of-atmosphere and the surface
+    real(jprb), dimension(nregions,nregions,nlev+1, &
+         &                istartcol:iendcol) :: u_matrix, v_matrix
+
+    ! Two-stream variables
+    real(jprb), dimension(config%n_g_lw) :: gamma1, gamma2
+
+    ! Diffuse reflection and transmission matrices of each layer
+    real(jprb), dimension(config%n_g_lw, nregions, nlev) :: reflectance, transmittance
+
+    ! Emission by a layer into the upwelling or downwelling diffuse
+    ! streams
+    real(jprb), dimension(config%n_g_lw, nregions, nlev) &
+         &  :: Sup, Sdn
+
+    ! ...clear-sky equivalent
+    real(jprb), dimension(config%n_g_lw, nlev) &
+         &  :: Sup_clear, Sdn_clear
+
+    ! Total albedo of the atmosphere/surface just above a layer
+    ! interface with respect to downwelling diffuse radiation at that
+    ! interface, where level index = 1 corresponds to the
+    ! top-of-atmosphere
+    real(jprb), dimension(config%n_g_lw, nregions, nlev+1) :: total_albedo
+
+    ! Upwelling radiation just above a layer interface due to emission
+    ! below that interface, where level index = 1 corresponds to the
+    ! top-of-atmosphere
+    real(jprb), dimension(config%n_g_lw, nregions, nlev+1) :: total_source
+
+    ! ...equivalent values for clear-skies
+    real(jprb), dimension(config%n_g_lw, nlev+1) :: total_albedo_clear, total_source_clear
+
+    ! Total albedo and source of the atmosphere just below a layer interface
+    real(jprb), dimension(config%n_g_lw, nregions) &
+         &  :: total_albedo_below, total_source_below
+
+    ! Downwelling flux below and above an interface between
+    ! layers into a plane perpendicular to the direction of the sun
+    real(jprb), dimension(config%n_g_lw, nregions) &
+         &  :: flux_dn, flux_dn_below, flux_up
+
+    ! ...clear-sky equivalent (no distinction between "above/below")
+    real(jprb), dimension(config%n_g_lw) &
+         &  :: flux_dn_clear, flux_up_clear
+
+    ! Clear-sky equivalent, but actually its reciprocal to replace
+    ! some divisions by multiplications
+    real(jprb), dimension(config%n_g_lw, nregions) :: inv_denom
+
+    ! Identify clear-sky layers, with pseudo layers for outer space
+    ! and below the ground, both treated as single-region clear skies
+    logical :: is_clear_sky_layer(0:nlev+1)
+
+    integer :: jcol, jlev, jg, jreg, jreg2, ng
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_tripleclouds_lw:solver_tripleclouds_lw',0,hook_handle)
+
+    ! --------------------------------------------------------
+    ! Section 1: Prepare general variables and arrays
+    ! --------------------------------------------------------
+    ! Copy array dimensions to local variables for convenience
+    ng   = config%n_g_lw
+
+    ! Compute the wavelength-independent region fractions and
+    ! optical-depth scalings
+    call calc_region_properties(nlev,nregions,istartcol,iendcol, &
+         &  config%i_cloud_pdf_shape == IPdfShapeGamma, &
+         &  cloud%fraction, cloud%fractional_std, region_fracs, &
+         &  od_scaling, config%cloud_fraction_threshold)
+
+    ! Compute wavelength-independent overlap matrices u_matrix and v_matrix
+    call calc_overlap_matrices(nlev,nregions,istartcol,iendcol, &
+         &  region_fracs, cloud%overlap_param, &
+         &  u_matrix, v_matrix, &
+         &  decorrelation_scaling=config%cloud_inhom_decorr_scaling, &
+         &  cloud_fraction_threshold=config%cloud_fraction_threshold, &
+         &  use_beta_overlap=config%use_beta_overlap, &
+         &  cloud_cover=flux%cloud_cover_lw)
+
+    ! Main loop over columns
+    do jcol = istartcol, iendcol
+      ! --------------------------------------------------------
+      ! Section 2: Prepare column-specific variables and arrays
+      ! --------------------------------------------------------
+
+      ! Define which layers contain cloud; assume that
+      ! cloud%crop_cloud_fraction has already been called
+      is_clear_sky_layer = .true.
+      do jlev = 1,nlev
+        if (cloud%fraction(jcol,jlev) > 0.0_jprb) then
+          is_clear_sky_layer(jlev) = .false.
+        end if
+      end do
+
+      ! --------------------------------------------------------
+      ! Section 3: Loop over layers to compute reflectance and transmittance
+      ! --------------------------------------------------------
+      ! In this section the reflectance, transmittance and sources
+      ! are computed for each layer
+      do jlev = 1,nlev ! Start at top-of-atmosphere
+
+        ! Array-wise assignments
+        gamma1 = 0.0_jprb
+        gamma2 = 0.0_jprb
+
+        nreg = nregions
+        if (is_clear_sky_layer(jlev)) then
+          nreg = 1
+          reflectance(:,2:,jlev)   = 0.0_jprb
+          transmittance(:,2:,jlev)   = 0.0_jprb
+          Sup(:,2:,jlev) = 0.0_jprb
+          Sdn(:,2:,jlev) = 0.0_jprb
+        end if
+        do jreg = 1,nreg
+          if (jreg == 1) then
+            ! Clear-sky calculation
+            if (.not. config%do_lw_aerosol_scattering) then
+              call calc_no_scattering_transmittance_lw(ng, od(:,jlev,jcol), &
+                   &  planck_hl(:,jlev,jcol), planck_hl(:,jlev+1, jcol), &
+                   &  transmittance(:,1,jlev), Sup(:,1,jlev), Sdn(:,1,jlev))
+              reflectance(:,1,jlev) = 0.0_jprb
+            else
+              call calc_two_stream_gammas_lw(ng, &
+                   &  ssa(:,jlev,jcol), g(:,jlev,jcol), gamma1, gamma2)
+              call calc_reflectance_transmittance_lw(ng, &
+                   &  od(:,jlev,jcol), gamma1, gamma2, &
+                   &  planck_hl(:,jlev,jcol), planck_hl(:,jlev+1,jcol), &
+                   &  reflectance(:,1,jlev), transmittance(:,1,jlev), &
+                   &  Sup(:,1,jlev), Sdn(:,1,jlev))
+            end if
+          else
+            ! Cloudy sky
+            ! Add scaled cloud optical depth to clear-sky value
+            od_cloud_new = od_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
+                 &       * od_scaling(jreg,jlev,jcol)
+            od_total = od(:,jlev,jcol) + od_cloud_new
+
+            if (config%do_lw_cloud_scattering) then
+              ssa_total = 0.0_jprb
+              g_total   = 0.0_jprb              
+              if (config%do_lw_aerosol_scattering) then
+                where (od_total > 0.0_jprb)
+                  ssa_total = (ssa(:,jlev,jcol)*od(:,jlev,jcol) &
+                       &     + ssa_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
+                       &     *  od_cloud_new) & 
+                       &     / od_total
+                end where
+                where (ssa_total > 0.0_jprb .and. od_total > 0.0_jprb)
+                  g_total = (g(:,jlev,jcol)*ssa(:,jlev,jcol)*od(:,jlev,jcol) &
+                       &     +   g_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
+                       &     * ssa_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
+                       &     *  od_cloud_new) &
+                       &     / (ssa_total*od_total)
+                end where
+              else
+                where (od_total > 0.0_jprb)
+                  ssa_total = ssa_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
+                       &     * od_cloud_new / od_total
+                end where
+                where (ssa_total > 0.0_jprb .and. od_total > 0.0_jprb)
+                  g_total = g_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
+                       &     * ssa_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
+                       &     *  od_cloud_new / (ssa_total*od_total)
+                end where
+              end if
+              call calc_two_stream_gammas_lw(ng, &
+                   &  ssa_total, g_total, gamma1, gamma2)
+              call calc_reflectance_transmittance_lw(ng, &
+                   &  od_total, gamma1, gamma2, &
+                   &  planck_hl(:,jlev,jcol), planck_hl(:,jlev+1,jcol), &
+                   &  reflectance(:,jreg,jlev), transmittance(:,jreg,jlev), &
+                   &  Sup(:,jreg,jlev), Sdn(:,jreg,jlev))
+            else
+              ! No-scattering case: use simpler functions for
+              ! transmission and emission
+              call calc_no_scattering_transmittance_lw(ng, od_total, &
+                   &  planck_hl(:,jlev,jcol), planck_hl(:,jlev+1, jcol), &
+                   &  transmittance(:,jreg,jlev), Sup(:,jreg,jlev), Sdn(:,jreg,jlev))
+              reflectance(:,jreg,jlev) = 0.0_jprb
+            end if
+          end if
+        end do
+
+        ! Copy over the clear-sky emission
+        Sup_clear(:,jlev) = Sup(:,1,jlev)
+        Sdn_clear(:,jlev) = Sdn(:,1,jlev)
+        if (.not. is_clear_sky_layer(jlev)) then
+          ! Emission is scaled by the size of each region
+          do jreg = 1,nregions
+            Sup(:,jreg,jlev) = region_fracs(jreg,jlev,jcol) * Sup(:,jreg,jlev)
+            Sdn(:,jreg,jlev) = region_fracs(jreg,jlev,jcol) * Sdn(:,jreg,jlev)
+          end do
+        end if
+
+      end do ! Loop over levels
+
+      ! --------------------------------------------------------
+      ! Section 4: Compute total sources albedos
+      ! --------------------------------------------------------
+
+      total_albedo(:,:,:) = 0.0_jprb
+      total_source(:,:,:) = 0.0_jprb
+
+      ! Calculate the upwelling radiation emitted by the surface, and
+      ! copy the surface albedo into total_albedo 
+      do jreg = 1,nregions
+        do jg = 1,ng
+          ! region_fracs(jreg,nlev,jcol) is the fraction of each region in the
+          ! lowest model level
+          total_source(jg,jreg,nlev+1) = region_fracs(jreg,nlev,jcol)*emission(jg,jcol)
+          total_albedo(jg,jreg,nlev+1) = albedo(jg,jcol)
+        end do
+      end do
+      ! Equivalent surface values for computing clear-sky fluxes 
+      if (config%do_clear) then
+        do jg = 1,ng
+          total_source_clear(jg,nlev+1) = emission(jg,jcol)
+        end do
+        ! In the case of surface albedo there is no dependence on
+        ! cloud fraction so we can copy the all-sky value
+        total_albedo_clear(1:ng,nlev+1) = total_albedo(1:ng,1,nlev+1)
+      end if
+
+      ! Work up from the surface computing the total albedo of the
+      ! atmosphere and the total upwelling due to emission below each
+      ! level below using the adding method
+      do jlev = nlev,1,-1
+
+        total_albedo_below        = 0.0_jprb
+
+        if (config%do_clear) then
+          ! For clear-skies there is no need to consider "above" and
+          ! "below" quantities since with no cloud overlap to worry
+          ! about, these are the same
+          inv_denom(:,1) = 1.0_jprb &
+               &  / (1.0_jprb - total_albedo_clear(:,jlev+1)*reflectance(:,1,jlev))
+          total_albedo_clear(:,jlev) = reflectance(:,1,jlev) &
+               &  + transmittance(:,1,jlev)*transmittance(:,1,jlev)*total_albedo_clear(:,jlev+1) &
+               &  * inv_denom(:,1)
+          total_source_clear(:,jlev) = Sup_clear(:,jlev) &
+               &  + transmittance(:,1,jlev)*(total_source_clear(:,jlev+1) &
+               &  + total_albedo_clear(:,jlev+1)*Sdn_clear(:,jlev)) &
+               &  * inv_denom(:,1)
+        end if
+
+        if (is_clear_sky_layer(jlev)) then
+          inv_denom(:,1) = 1.0_jprb &
+               &  / (1.0_jprb - total_albedo(:,1,jlev+1)*reflectance(:,1,jlev))
+          total_albedo_below = 0.0_jprb
+          total_albedo_below(:,1) = reflectance(:,1,jlev) &
+               &  + transmittance(:,1,jlev)*transmittance(:,1,jlev)*total_albedo(:,1,jlev+1) &
+               &  * inv_denom(:,1)
+          total_source_below = 0.0_jprb
+          total_source_below(:,1) = Sup(:,1,jlev) &
+               &  + transmittance(:,1,jlev)*(total_source(:,1,jlev+1) &
+               &  + total_albedo(:,1,jlev+1)*Sdn(:,1,jlev)) &
+               &  * inv_denom(:,1)
+        else
+          inv_denom = 1.0_jprb / (1.0_jprb - total_albedo(:,:,jlev+1)*reflectance(:,:,jlev))
+          total_albedo_below = reflectance(:,:,jlev) &
+               &  + transmittance(:,:,jlev)*transmittance(:,:,jlev)*total_albedo(:,:,jlev+1) &
+               &  * inv_denom
+          total_source_below = Sup(:,:,jlev) &
+               &  + transmittance(:,:,jlev)*(total_source(:,:,jlev+1) &
+               &  + total_albedo(:,:,jlev+1)*Sdn(:,:,jlev)) &
+               &  * inv_denom
+        end if
+
+        ! Account for cloud overlap when converting albedo below a
+        ! layer interface to the equivalent values just above
+        if (is_clear_sky_layer(jlev) .and. is_clear_sky_layer(jlev-1)) then
+          total_albedo(:,:,jlev) = total_albedo_below(:,:)
+          total_source(:,:,jlev) = total_source_below(:,:)
+        else
+          total_source(:,:,jlev) = singlemat_x_vec(ng,ng,nregions,&
+               &  u_matrix(:,:,jlev,jcol), total_source_below)
+          ! Use overlap matrix and exclude "anomalous" horizontal
+          ! transport described by Shonk & Hogan (2008).  Therefore,
+          ! the operation we perform is essentially diag(total_albedo)
+          ! = matmul(transpose(v_matrix), diag(total_albedo_below)).
+          do jreg = 1,nregions
+            do jreg2 = 1,nregions
+              total_albedo(:,jreg,jlev) &
+                   &  = total_albedo(:,jreg,jlev) &
+                   &  + total_albedo_below(:,jreg2) &
+                   &  * v_matrix(jreg2,jreg,jlev,jcol)
+
+            end do
+          end do
+
+        end if
+        
+      end do ! Reverse loop over levels
+
+      ! --------------------------------------------------------
+      ! Section 5: Compute fluxes
+      ! --------------------------------------------------------
+
+      ! Top-of-atmosphere fluxes into the regions of the top-most
+      ! layer, zero since we assume no diffuse downwelling
+      flux_dn = 0.0_jprb
+
+      if (config%do_clear) then
+        flux_dn_clear = 0.0_jprb
+      end if
+
+      ! Store the TOA broadband fluxes
+      flux%lw_up(jcol,1) = sum(total_source(:,:,1))
+      flux%lw_dn(jcol,1) = 0.0_jprb
+      if (config%do_clear) then
+        flux%lw_up_clear(jcol,1) = sum(total_source_clear(:,1))
+        flux%lw_dn_clear(jcol,1) = 0.0_jprb
+      end if
+
+      ! Save the spectral fluxes if required
+      if (config%do_save_spectral_flux) then
+        call indexed_sum(sum(total_source(:,:,1),2), &
+             &           config%i_spec_from_reordered_g_lw, &
+             &           flux%lw_up_band(:,jcol,1))
+        flux%lw_dn_band(:,jcol,1) = 0.0_jprb
+        if (config%do_clear) then
+          call indexed_sum(total_source_clear(:,1), &
+               &           config%i_spec_from_reordered_g_lw, &
+               &           flux%lw_up_clear_band(:,jcol,1))
+          flux%lw_dn_clear_band(:,jcol,1) = 0.0_jprb
+        end if
+      end if
+
+      ! Final loop back down through the atmosphere to compute fluxes
+      do jlev = 1,nlev
+        if (config%do_clear) then
+          flux_dn_clear = (transmittance(:,1,jlev)*flux_dn_clear &
+               &  + reflectance(:,1,jlev)*total_source_clear(:,jlev+1) + Sdn_clear(:,jlev) ) &
+               &  / (1.0_jprb - reflectance(:,1,jlev)*total_albedo_clear(:,jlev+1))
+          flux_up_clear = total_source_clear(:,jlev+1) &
+               &        + flux_dn_clear*total_albedo_clear(:,jlev+1)
+        end if
+
+        if (is_clear_sky_layer(jlev)) then
+          flux_dn(:,1) = (transmittance(:,1,jlev)*flux_dn(:,1) &
+               &       + reflectance(:,1,jlev)*total_source(:,1,jlev+1) + Sdn(:,1,jlev) ) &
+               &  / (1.0_jprb - reflectance(:,1,jlev)*total_albedo(:,1,jlev+1))
+          flux_dn(:,2:)  = 0.0_jprb
+          flux_up(:,1) = total_source(:,1,jlev+1) + flux_dn(:,1)*total_albedo(:,1,jlev+1)
+          flux_up(:,2:)  = 0.0_jprb
+        else
+          flux_dn = (transmittance(:,:,jlev)*flux_dn &
+               &     + reflectance(:,:,jlev)*total_source(:,:,jlev+1) + Sdn(:,:,jlev) ) &
+               &  / (1.0_jprb - reflectance(:,:,jlev)*total_albedo(:,:,jlev+1))
+          flux_up = total_source(:,:,jlev+1) + flux_dn*total_albedo(:,:,jlev+1)
+        end if
+
+        if (.not. (is_clear_sky_layer(jlev) &
+             &    .and. is_clear_sky_layer(jlev+1))) then
+          ! Account for overlap rules in translating fluxes just above
+          ! a layer interface to the values just below
+          flux_dn_below = singlemat_x_vec(ng,ng,nregions, &
+               &  v_matrix(:,:,jlev+1,jcol), flux_dn)
+          flux_dn = flux_dn_below
+        end if ! Otherwise the fluxes in each region are the same so
+               ! nothing to do
+
+        ! Store the broadband fluxes
+        flux%lw_up(jcol,jlev+1) = sum(sum(flux_up,1))
+        flux%lw_dn(jcol,jlev+1) = sum(sum(flux_dn,1))
+        if (config%do_clear) then
+          flux%lw_up_clear(jcol,jlev+1) = sum(flux_up_clear)
+          flux%lw_dn_clear(jcol,jlev+1) = sum(flux_dn_clear)
+        end if
+
+        ! Save the spectral fluxes if required
+        if (config%do_save_spectral_flux) then
+          call indexed_sum(sum(flux_up,2), &
+               &           config%i_spec_from_reordered_g_lw, &
+               &           flux%lw_up_band(:,jcol,jlev+1))
+          call indexed_sum(sum(flux_dn,2), &
+               &           config%i_spec_from_reordered_g_lw, &
+               &           flux%lw_dn_band(:,jcol,jlev+1))
+          if (config%do_clear) then
+            call indexed_sum(flux_up_clear, &
+                 &           config%i_spec_from_reordered_g_lw, &
+                 &           flux%lw_up_clear_band(:,jcol,jlev+1))
+            call indexed_sum(flux_dn_clear, &
+                 &           config%i_spec_from_reordered_g_lw, &
+                 &           flux%lw_dn_clear_band(:,jcol,jlev+1))
+          end if
+        end if
+
+      end do ! Final loop over levels
+      
+      ! Store surface spectral downwelling fluxes, which at this point
+      ! are at the surface
+      flux%lw_dn_surf_g(:,jcol) = sum(flux_dn,2)
+      if (config%do_clear) then
+        flux%lw_dn_surf_clear_g(:,jcol) = flux_dn_clear
+      end if
+
+      ! Compute the longwave derivatives needed by Hogan and Bozzo
+      ! (2015) approximate radiation update scheme
+      if (config%do_lw_derivatives) then
+        ! Note that at this point flux_up contains the spectral
+        ! fluxes into the regions of the lowest layer; we sum over
+        ! regions first to provide a simple spectral flux upwelling
+        ! from the surface
+        call calc_lw_derivatives_region(ng, nlev, nregions, jcol, transmittance, &
+             &  u_matrix(:,:,:,jcol), sum(flux_up,2), flux%lw_derivatives)
+      end if
+
+    end do ! Loop over columns
+
+    if (lhook) call dr_hook('radiation_tripleclouds_lw:solver_tripleclouds_lw',1,hook_handle)
+
+  end subroutine solver_tripleclouds_lw
+
+end module radiation_tripleclouds_lw
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_tripleclouds_sw.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_tripleclouds_sw.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_tripleclouds_sw.F90	(revision 3908)
@@ -0,0 +1,608 @@
+! radiation_tripleclouds_sw.F90 - Shortwave "Tripleclouds" solver
+!
+! (C) Copyright 2016- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2017-04-11  R. Hogan  Receive albedos at g-points
+!   2017-04-22  R. Hogan  Store surface fluxes at all g-points
+!   2017-10-23  R. Hogan  Renamed single-character variables
+!   2018-10-08  R. Hogan  Call calc_region_properties
+!   2019-01-02  R. Hogan  Fixed problem of do_save_spectral_flux .and. .not. do_sw_direct
+
+module radiation_tripleclouds_sw
+
+  public
+
+contains
+  ! Provides elemental function "delta_eddington"
+#include "radiation_delta_eddington.h"
+
+  ! Small routine for scaling cloud optical depth in the cloudy
+  ! regions
+#include "radiation_optical_depth_scaling.h"
+
+  ! This module contains just one subroutine, the shortwave
+  ! "Tripleclouds" solver in which cloud inhomogeneity is treated by
+  ! dividing each model level into three regions, one clear and two
+  ! cloudy (with differing optical depth). This approach was described
+  ! by Shonk and Hogan (2008).
+
+  subroutine solver_tripleclouds_sw(nlev,istartcol,iendcol, &
+       &  config, single_level, cloud, & 
+       &  od, ssa, g, od_cloud, ssa_cloud, g_cloud, &
+       &  albedo_direct, albedo_diffuse, incoming_sw, &
+       &  flux)
+
+    use parkind1, only           : jprb
+    use yomhook,  only           : lhook, dr_hook
+
+!    use radiation_io, only             : nulout
+    use radiation_config, only         : config_type, IPdfShapeGamma
+    use radiation_single_level, only   : single_level_type
+    use radiation_cloud, only          : cloud_type
+    use radiation_regions, only        : calc_region_properties
+    use radiation_overlap, only        : calc_overlap_matrices
+    use radiation_flux, only           : flux_type, &
+         &                               indexed_sum, add_indexed_sum
+    use radiation_matrix, only         : singlemat_x_vec
+    use radiation_two_stream, only     : calc_two_stream_gammas_sw, &
+         &                       calc_reflectance_transmittance_sw
+
+    implicit none
+
+    ! Inputs
+    integer, intent(in) :: nlev               ! number of model levels
+    integer, intent(in) :: istartcol, iendcol ! range of columns to process
+    type(config_type),        intent(in) :: config
+    type(single_level_type),  intent(in) :: single_level
+    type(cloud_type),         intent(in) :: cloud
+
+    ! Gas and aerosol optical depth, single-scattering albedo and
+    ! asymmetry factor at each shortwave g-point
+!    real(jprb), intent(in), dimension(istartcol:iendcol,nlev,config%n_g_sw) :: &
+    real(jprb), intent(in), dimension(config%n_g_sw,nlev,istartcol:iendcol) :: &
+         &  od, ssa, g
+
+    ! Cloud and precipitation optical depth, single-scattering albedo and
+    ! asymmetry factor in each shortwave band
+    real(jprb), intent(in), dimension(config%n_bands_sw,nlev,istartcol:iendcol) :: &
+         &  od_cloud, ssa_cloud, g_cloud
+
+    ! Optical depth, single scattering albedo and asymmetry factor in
+    ! each g-point including gas, aerosol and clouds
+    real(jprb), dimension(config%n_g_sw) :: od_total, ssa_total, g_total
+
+    ! Direct and diffuse surface albedos, and the incoming shortwave
+    ! flux into a plane perpendicular to the incoming radiation at
+    ! top-of-atmosphere in each of the shortwave g points
+    real(jprb), intent(in), dimension(config%n_g_sw,istartcol:iendcol) :: &
+         &  albedo_direct, albedo_diffuse, incoming_sw
+
+    ! Output
+    type(flux_type), intent(inout):: flux
+
+    ! Local constants
+    integer, parameter :: nregions = 3
+
+    ! In a clear-sky layer this will be 1, otherwise equal to nregions
+    integer :: nreg
+
+    ! Local variables
+    
+    ! The area fractions of each region
+    real(jprb) :: region_fracs(1:nregions,nlev,istartcol:iendcol)
+
+    ! The scaling used for the optical depth in the cloudy regions
+    real(jprb) :: od_scaling(2:nregions,nlev,istartcol:iendcol)
+
+    ! Directional overlap matrices defined at all layer interfaces
+    ! including top-of-atmosphere and the surface
+    real(jprb), dimension(nregions,nregions,nlev+1, &
+         &                istartcol:iendcol) :: u_matrix, v_matrix
+
+    ! Two-stream variables
+    real(jprb), dimension(config%n_g_sw) :: gamma1, gamma2, gamma3
+
+    ! Diffuse reflection and transmission matrices of each layer
+    real(jprb), dimension(config%n_g_sw, nregions, nlev) &
+         &  :: reflectance, transmittance
+
+    ! Terms translating the direct flux entering the layer from above
+    ! to the reflected radiation exiting upwards (ref_dir) and the
+    ! scattered radiation exiting downwards (trans_dir_diff), along with the
+    ! direct unscattered transmission matrix (trans_dir_dir).
+    real(jprb), dimension(config%n_g_sw, nregions, nlev) &
+         &  :: ref_dir, trans_dir_diff, trans_dir_dir
+
+    ! Total albedo of the atmosphere/surface just above a layer
+    ! interface with respect to downwelling diffuse and direct
+    ! (respectively) radiation at that interface, where level index =
+    ! 1 corresponds to the top-of-atmosphere
+    real(jprb), dimension(config%n_g_sw, nregions, nlev+1) &
+         &  :: total_albedo, total_albedo_direct
+
+    ! ...equivalent values for clear-skies
+    real(jprb), dimension(config%n_g_sw, nlev+1) &
+         &  :: total_albedo_clear, total_albedo_clear_direct
+
+    ! Total albedo of the atmosphere just below a layer interface
+    real(jprb), dimension(config%n_g_sw, nregions) &
+         &  :: total_albedo_below, total_albedo_below_direct
+
+    ! Direct downwelling flux below and above an interface between
+    ! layers into a plane perpendicular to the direction of the sun
+    real(jprb), dimension(config%n_g_sw, nregions) &
+         &  :: direct_dn, direct_dn_below
+    ! Diffuse equivalents
+    real(jprb), dimension(config%n_g_sw, nregions) &
+         &  :: flux_dn, flux_dn_below, flux_up
+
+    ! ...clear-sky equivalent (no distinction between "above/below")
+    real(jprb), dimension(config%n_g_sw) &
+         &  :: direct_dn_clear, flux_dn_clear, flux_up_clear
+
+    ! Clear-sky equivalent, but actually its reciprocal to replace
+    ! some divisions by multiplications
+    real(jprb), dimension(config%n_g_sw, nregions) :: inv_denom
+
+    ! Identify clear-sky layers, with pseudo layers for outer space
+    ! and below the ground, both treated as single-region clear skies
+    logical :: is_clear_sky_layer(0:nlev+1)
+
+    ! Scattering optical depth of gas+aerosol and of cloud
+    real(jprb) :: scat_od, scat_od_cloud
+
+    real(jprb) :: mu0
+
+    integer :: jcol, jlev, jg, jreg, iband, jreg2, ng
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_tripleclouds_sw:solver_tripleclouds_sw',0,hook_handle)
+
+    ! --------------------------------------------------------
+    ! Section 1: Prepare general variables and arrays
+    ! --------------------------------------------------------
+    ! Copy array dimensions to local variables for convenience
+    ng   = config%n_g_sw
+
+    ! Compute the wavelength-independent region fractions and
+    ! optical-depth scalings
+    call calc_region_properties(nlev,nregions,istartcol,iendcol, &
+         &  config%i_cloud_pdf_shape == IPdfShapeGamma, &
+         &  cloud%fraction, cloud%fractional_std, region_fracs, &
+         &  od_scaling, config%cloud_fraction_threshold)
+
+    ! Compute wavelength-independent overlap matrices u_matrix and
+    ! v_matrix
+    call calc_overlap_matrices(nlev,nregions,istartcol,iendcol, &
+         &  region_fracs, cloud%overlap_param, &
+         &  u_matrix, v_matrix, &
+         &  decorrelation_scaling=config%cloud_inhom_decorr_scaling, &
+         &  cloud_fraction_threshold=config%cloud_fraction_threshold, &
+         &  use_beta_overlap=config%use_beta_overlap, &
+         &  cloud_cover=flux%cloud_cover_sw)
+
+    ! Main loop over columns
+    do jcol = istartcol, iendcol
+      ! --------------------------------------------------------
+      ! Section 2: Prepare column-specific variables and arrays
+      ! --------------------------------------------------------
+
+      ! Copy local cosine of the solar zenith angle
+      mu0 = single_level%cos_sza(jcol)
+
+      ! Skip profile if sun is too low in the sky
+      if (mu0 < 1.0e-10_jprb) then
+        flux%sw_dn(jcol,:) = 0.0_jprb
+        flux%sw_up(jcol,:) = 0.0_jprb
+        if (allocated(flux%sw_dn_direct)) then
+          flux%sw_dn_direct(jcol,:) = 0.0_jprb
+        end if
+        if (config%do_clear) then
+          flux%sw_dn_clear(jcol,:) = 0.0_jprb
+          flux%sw_up_clear(jcol,:) = 0.0_jprb
+          if (allocated(flux%sw_dn_direct_clear)) then
+            flux%sw_dn_direct_clear(jcol,:) = 0.0_jprb
+          end if
+        end if
+
+        if (config%do_save_spectral_flux) then
+          flux%sw_dn_band(:,jcol,:) = 0.0_jprb
+          flux%sw_up_band(:,jcol,:) = 0.0_jprb
+          if (allocated(flux%sw_dn_direct_band)) then
+            flux%sw_dn_direct_band(:,jcol,:) = 0.0_jprb
+          end if
+          if (config%do_clear) then
+            flux%sw_dn_clear_band(:,jcol,:) = 0.0_jprb
+            flux%sw_up_clear_band(:,jcol,:) = 0.0_jprb
+            if (allocated(flux%sw_dn_direct_clear_band)) then
+              flux%sw_dn_direct_clear_band(:,jcol,:) = 0.0_jprb
+            end if
+          end if
+        end if
+
+        flux%sw_dn_diffuse_surf_g(:,jcol) = 0.0_jprb
+        flux%sw_dn_direct_surf_g(:,jcol)  = 0.0_jprb
+        if (config%do_clear) then
+          flux%sw_dn_diffuse_surf_clear_g(:,jcol) = 0.0_jprb
+          flux%sw_dn_direct_surf_clear_g(:,jcol)  = 0.0_jprb
+        end if
+
+        cycle
+      end if ! sun is below the horizon
+
+      ! At this point mu0 >= 1.0e-10
+
+      ! Define which layers contain cloud; assume that
+      ! cloud%crop_cloud_fraction has already been called
+      is_clear_sky_layer = .true.
+      do jlev = 1,nlev
+        if (cloud%fraction(jcol,jlev) > 0.0_jprb) then
+          is_clear_sky_layer(jlev) = .false.
+        end if
+      end do
+
+      ! --------------------------------------------------------
+      ! Section 3: Loop over layers to compute reflectance and transmittance
+      ! --------------------------------------------------------
+      ! In this section the reflectance, transmittance and sources
+      ! are computed for each layer
+      do jlev = 1,nlev ! Start at top-of-atmosphere
+
+        ! Array-wise assignments
+        gamma1 = 0.0_jprb
+        gamma2 = 0.0_jprb
+        gamma3 = 0.0_jprb
+
+        nreg = nregions
+        if (is_clear_sky_layer(jlev)) then
+          nreg = 1
+        end if
+        do jreg = 1,nreg
+          if (jreg == 1) then
+            od_total  =  od(:,jlev,jcol)
+            ssa_total = ssa(:,jlev,jcol)
+            g_total   =   g(:,jlev,jcol)
+          else
+            do jg = 1,ng
+              ! Mapping from g-point to band
+              iband = config%i_band_from_reordered_g_sw(jg)
+              scat_od = od(jg,jlev,jcol)*ssa(jg,jlev,jcol)
+              scat_od_cloud = od_cloud(iband,jlev,jcol) &
+                   &  * ssa_cloud(iband,jlev,jcol) * od_scaling(jreg,jlev,jcol)
+              ! Add scaled cloud optical depth to clear-sky value
+              od_total(jg) = od(jg,jlev,jcol) &
+                   &  + od_cloud(iband,jlev,jcol)*od_scaling(jreg,jlev,jcol)
+              ! Compute single-scattering albedo and asymmetry
+              ! factor of gas-cloud combination
+              ssa_total(jg) = (scat_od+scat_od_cloud) &
+                   &  / od_total(jg)
+              g_total(jg) = (scat_od*g(jg,jlev,jcol) &
+                   &         + scat_od_cloud * g_cloud(iband,jlev,jcol)) &
+                   &      / (scat_od + scat_od_cloud)
+            end do
+          end if
+
+          if (config%do_sw_delta_scaling_with_gases) then
+            ! Apply delta-Eddington scaling to the aerosol-gas(-cloud)
+            ! mixture
+            call delta_eddington(od_total, ssa_total, g_total)
+          end if
+          call calc_two_stream_gammas_sw(ng, &
+               &  mu0, ssa_total, g_total, &
+               &  gamma1, gamma2, gamma3)
+          call calc_reflectance_transmittance_sw(ng, &
+               &  mu0, od_total, ssa_total, &
+               &  gamma1, gamma2, gamma3, &
+               &  reflectance(:,jreg,jlev), transmittance(:,jreg,jlev), &
+               &  ref_dir(:,jreg,jlev), trans_dir_diff(:,jreg,jlev), &
+               &  trans_dir_dir(:,jreg,jlev) )
+        end do
+      end do
+
+      ! --------------------------------------------------------
+      ! Section 4: Compute total albedos
+      ! --------------------------------------------------------
+
+      total_albedo(:,:,:) = 0.0_jprb
+      total_albedo_direct(:,:,:) = 0.0_jprb
+
+      ! Copy surface albedo in clear-sky region
+      do jg = 1,ng
+        total_albedo(jg,1,nlev+1) = albedo_diffuse(jg,jcol)
+      end do
+
+      ! If direct albedo is available, use it; otherwise copy from
+      ! diffuse albedo
+      do jg = 1,ng
+        total_albedo_direct(jg,1,nlev+1) &
+             &  = mu0 * albedo_direct(jg,jcol)
+      end do
+
+      ! If there is cloud in the lowest layer then we need the albedos
+      ! underneath
+      if (.not. is_clear_sky_layer(nlev)) then
+        do jreg = 2,nregions
+          total_albedo(:,jreg,nlev+1)        = total_albedo(:,1,nlev+1)
+          total_albedo_direct(:,jreg,nlev+1) = total_albedo_direct(:,1,nlev+1)
+        end do
+      end if
+
+      if (config%do_clear) then
+        total_albedo_clear(:,nlev+1)        = total_albedo(:,1,nlev+1)
+        total_albedo_clear_direct(:,nlev+1) = total_albedo_direct(:,1,nlev+1)
+      end if
+
+      ! Work up from the surface computing the total albedo of the
+      ! atmosphere below that point using the adding method
+      do jlev = nlev,1,-1
+
+        total_albedo_below        = 0.0_jprb
+        total_albedo_below_direct = 0.0_jprb
+
+        if (config%do_clear) then
+          ! For clear-skies there is no need to consider "above" and
+          ! "below" quantities since with no cloud overlap to worry
+          ! about, these are the same
+          inv_denom(:,1) = 1.0_jprb &
+               &  / (1.0_jprb - total_albedo_clear(:,jlev+1)*reflectance(:,1,jlev))
+          total_albedo_clear(:,jlev) = reflectance(:,1,jlev) &
+               &  + transmittance(:,1,jlev) * transmittance(:,1,jlev) &
+               &  * total_albedo_clear(:,jlev+1) * inv_denom(:,1)
+          total_albedo_clear_direct(:,jlev) = ref_dir(:,1,jlev) &
+               &  + (trans_dir_dir(:,1,jlev)*total_albedo_clear_direct(:,jlev+1) &
+               &     +trans_dir_diff(:,1,jlev)*total_albedo_clear(:,jlev+1)) &
+               &  * transmittance(:,1,jlev) * inv_denom(:,1)
+        end if
+
+        if (is_clear_sky_layer(jlev)) then
+          inv_denom(:,1) = 1.0_jprb &
+               &  / (1.0_jprb - total_albedo(:,1,jlev+1)*reflectance(:,1,jlev))
+          total_albedo_below(:,1) = reflectance(:,1,jlev) &
+               &  + transmittance(:,1,jlev)  * transmittance(:,1,jlev) &
+               &  * total_albedo(:,1,jlev+1) * inv_denom(:,1)
+          total_albedo_below_direct(:,1) = ref_dir(:,1,jlev) &
+               &  + (trans_dir_dir(:,1,jlev)*total_albedo_direct(:,1,jlev+1) &
+               &     +trans_dir_diff(:,1,jlev)*total_albedo(:,1,jlev+1)) &
+               &  * transmittance(:,1,jlev) * inv_denom(:,1)
+        else
+          inv_denom = 1.0_jprb / (1.0_jprb - total_albedo(:,:,jlev+1)*reflectance(:,:,jlev))
+          total_albedo_below = reflectance(:,:,jlev) &
+               &  + transmittance(:,:,jlev)  * transmittance(:,:,jlev) &
+               &  * total_albedo(:,:,jlev+1) * inv_denom
+          total_albedo_below_direct = ref_dir(:,:,jlev) &
+               &  + (trans_dir_dir(:,:,jlev)*total_albedo_direct(:,:,jlev+1) &
+               &     +trans_dir_diff(:,:,jlev)*total_albedo(:,:,jlev+1)) &
+               &  * transmittance(:,:,jlev) * inv_denom
+        end if
+
+        ! Account for cloud overlap when converting albedo below a
+        ! layer interface to the equivalent values just above
+        if (is_clear_sky_layer(jlev) .and. is_clear_sky_layer(jlev-1)) then
+          total_albedo(:,:,jlev)        = total_albedo_below(:,:)
+          total_albedo_direct(:,:,jlev) = total_albedo_below_direct(:,:)
+        else
+          ! Use overlap matrix and exclude "anomalous" horizontal
+          ! transport described by Shonk & Hogan (2008).  Therefore,
+          ! the operation we perform is essentially diag(total_albedo)
+          ! = matmul(transpose(v_matrix)), diag(total_albedo_below)).
+          do jreg = 1,nregions
+            do jreg2 = 1,nregions
+              total_albedo(:,jreg,jlev) &
+                   &  = total_albedo(:,jreg,jlev) &
+                   &  + total_albedo_below(:,jreg2) &
+                   &  * v_matrix(jreg2,jreg,jlev,jcol)
+              total_albedo_direct(:,jreg,jlev) &
+                   &  = total_albedo_direct(:,jreg,jlev) &
+                   &  + total_albedo_below_direct(:,jreg2) &
+                   &  * v_matrix(jreg2,jreg,jlev,jcol)
+            end do
+          end do
+
+        end if
+
+      end do ! Reverse loop over levels
+
+      ! --------------------------------------------------------
+      ! Section 5: Compute fluxes
+      ! --------------------------------------------------------
+
+      ! Top-of-atmosphere fluxes into the regions of the top-most
+      ! layer, zero since we assume no diffuse downwelling
+      flux_dn = 0.0_jprb
+      ! Direct downwelling flux (into a plane perpendicular to the
+      ! sun) entering the top of each region in the top-most layer
+      do jreg = 1,nregions
+        direct_dn(:,jreg) = incoming_sw(:,jcol)*region_fracs(jreg,1,jcol)
+      end do
+      flux_up = direct_dn*total_albedo_direct(:,:,1)
+
+      if (config%do_clear) then
+        flux_dn_clear = 0.0_jprb
+        direct_dn_clear(:) = incoming_sw(:,jcol)
+        flux_up_clear = direct_dn_clear*total_albedo_clear_direct(:,1)
+      end if
+
+      ! Store the TOA broadband fluxes
+      flux%sw_up(jcol,1) = sum(sum(flux_up,1))
+      flux%sw_dn(jcol,1) = mu0 * sum(sum(direct_dn,1))
+      if (allocated(flux%sw_dn_direct)) then
+        flux%sw_dn_direct(jcol,1) = flux%sw_dn(jcol,1)
+      end if
+      if (config%do_clear) then
+        flux%sw_up_clear(jcol,1) = sum(flux_up_clear)
+        flux%sw_dn_clear(jcol,1) = mu0 * sum(direct_dn_clear)
+        if (allocated(flux%sw_dn_direct_clear)) then
+          flux%sw_dn_direct_clear(jcol,1) = flux%sw_dn_clear(jcol,1)
+        end if
+      end if
+
+      ! Save the spectral fluxes if required; some redundancy here as
+      ! the TOA downwelling flux is the same in clear and cloudy skies
+      if (config%do_save_spectral_flux) then
+        call indexed_sum(sum(flux_up,2), &
+             &           config%i_spec_from_reordered_g_sw, &
+             &           flux%sw_up_band(:,jcol,1))
+        call indexed_sum(sum(direct_dn,2), &
+             &           config%i_spec_from_reordered_g_sw, &
+             &           flux%sw_dn_band(:,jcol,1))
+        flux%sw_dn_band(:,jcol,1) = &
+             &  mu0 * flux%sw_dn_band(:,jcol,1)
+        if (allocated(flux%sw_dn_direct_band)) then
+          flux%sw_dn_direct_band(:,jcol,1) = flux%sw_dn_band(:,jcol,1)
+        end if
+        call add_indexed_sum(sum(flux_dn,2), &
+             &           config%i_spec_from_reordered_g_sw, &
+             &           flux%sw_dn_band(:,jcol,1))
+        if (config%do_clear) then
+          call indexed_sum(flux_up_clear, &
+               &           config%i_spec_from_reordered_g_sw, &
+               &           flux%sw_up_clear_band(:,jcol,1))
+          call indexed_sum(direct_dn_clear, &
+               &           config%i_spec_from_reordered_g_sw, &
+               &           flux%sw_dn_clear_band(:,jcol,1))
+          flux%sw_dn_clear_band(:,jcol,1) &
+               &  = mu0 * flux%sw_dn_clear_band(:,jcol,1)
+          if (allocated(flux%sw_dn_direct_clear_band)) then
+            flux%sw_dn_direct_clear_band(:,jcol,1) &
+                 &  = flux%sw_dn_clear_band(:,jcol,1)
+          end if
+          call add_indexed_sum(flux_dn_clear, &
+               &           config%i_spec_from_reordered_g_sw, &
+               &           flux%sw_dn_clear_band(:,jcol,1))
+        end if
+      end if
+
+      ! Final loop back down through the atmosphere to compute fluxes
+      do jlev = 1,nlev
+        if (config%do_clear) then
+          flux_dn_clear = (transmittance(:,1,jlev)*flux_dn_clear + direct_dn_clear &
+               &  * (trans_dir_dir(:,1,jlev)*total_albedo_clear_direct(:,jlev+1)*reflectance(:,1,jlev) &
+               &     + trans_dir_diff(:,1,jlev) )) &
+               &  / (1.0_jprb - reflectance(:,1,jlev)*total_albedo_clear(:,jlev+1))
+          direct_dn_clear = trans_dir_dir(:,1,jlev)*direct_dn_clear
+          flux_up_clear = direct_dn_clear*total_albedo_clear_direct(:,jlev+1) &
+               &        +   flux_dn_clear*total_albedo_clear(:,jlev+1)
+        end if
+
+        if (is_clear_sky_layer(jlev)) then
+          flux_dn(:,1) = (transmittance(:,1,jlev)*flux_dn(:,1) + direct_dn(:,1) &
+               &  * (trans_dir_dir(:,1,jlev)*total_albedo_direct(:,1,jlev+1)*reflectance(:,1,jlev) &
+               &     + trans_dir_diff(:,1,jlev) )) &
+               &  / (1.0_jprb - reflectance(:,1,jlev)*total_albedo(:,1,jlev+1))
+          direct_dn(:,1) = trans_dir_dir(:,1,jlev)*direct_dn(:,1)
+          flux_up(:,1) = direct_dn(:,1)*total_albedo_direct(:,1,jlev+1) &
+               &  +        flux_dn(:,1)*total_albedo(:,1,jlev+1)
+          flux_dn(:,2:)  = 0.0_jprb
+          flux_up(:,2:)  = 0.0_jprb
+          direct_dn(:,2:)= 0.0_jprb
+        else
+          flux_dn = (transmittance(:,:,jlev)*flux_dn + direct_dn &
+               &  * (trans_dir_dir(:,:,jlev)*total_albedo_direct(:,:,jlev+1)*reflectance(:,:,jlev) &
+               &     + trans_dir_diff(:,:,jlev) )) &
+               &  / (1.0_jprb - reflectance(:,:,jlev)*total_albedo(:,:,jlev+1))
+          direct_dn = trans_dir_dir(:,:,jlev)*direct_dn
+          flux_up = direct_dn*total_albedo_direct(:,:,jlev+1) &
+               &  +   flux_dn*total_albedo(:,:,jlev+1)
+        end if
+
+        if (.not. (is_clear_sky_layer(jlev) &
+             &    .and. is_clear_sky_layer(jlev+1))) then
+          ! Account for overlap rules in translating fluxes just above
+          ! a layer interface to the values just below
+          flux_dn_below = singlemat_x_vec(ng,ng,nregions, &
+               &  v_matrix(:,:,jlev+1,jcol), flux_dn)
+          direct_dn_below = singlemat_x_vec(ng,ng,nregions, &
+               &  v_matrix(:,:,jlev+1,jcol), direct_dn)
+          flux_dn = flux_dn_below
+          direct_dn = direct_dn_below
+        end if ! Otherwise the fluxes in each region are the same so
+               ! nothing to do
+
+        ! Store the broadband fluxes
+        flux%sw_up(jcol,jlev+1) = sum(sum(flux_up,1))
+        if (allocated(flux%sw_dn_direct)) then
+          flux%sw_dn_direct(jcol,jlev+1) = mu0 * sum(sum(direct_dn,1))
+          flux%sw_dn(jcol,jlev+1) &
+               &  = flux%sw_dn_direct(jcol,jlev+1) + sum(sum(flux_dn,1))
+        else
+          flux%sw_dn(jcol,jlev+1) = mu0 * sum(sum(direct_dn,1)) + sum(sum(flux_dn,1))   
+        end if
+        if (config%do_clear) then
+          flux%sw_up_clear(jcol,jlev+1) = sum(flux_up_clear)
+          if (allocated(flux%sw_dn_direct_clear)) then
+            flux%sw_dn_direct_clear(jcol,jlev+1) = mu0 * sum(direct_dn_clear)
+            flux%sw_dn_clear(jcol,jlev+1) &
+                 &  = flux%sw_dn_direct_clear(jcol,jlev+1) + sum(flux_dn_clear)
+          else
+            flux%sw_dn_clear(jcol,jlev+1) = mu0 * sum(direct_dn_clear) &
+                 &  + sum(flux_dn_clear)
+          end if
+        end if
+
+        ! Save the spectral fluxes if required
+        if (config%do_save_spectral_flux) then
+          call indexed_sum(sum(flux_up,2), &
+               &           config%i_spec_from_reordered_g_sw, &
+               &           flux%sw_up_band(:,jcol,jlev+1))
+          call indexed_sum(sum(direct_dn,2), &
+               &           config%i_spec_from_reordered_g_sw, &
+               &           flux%sw_dn_band(:,jcol,jlev+1))
+          flux%sw_dn_band(:,jcol,jlev+1) = &
+               &  mu0 * flux%sw_dn_band(:,jcol,jlev+1)
+          if (allocated(flux%sw_dn_direct_band)) then
+            flux%sw_dn_direct_band(:,jcol,jlev+1) &
+                 &  = flux%sw_dn_band(:,jcol,jlev+1)
+          end if
+          call add_indexed_sum(sum(flux_dn,2), &
+               &           config%i_spec_from_reordered_g_sw, &
+               &           flux%sw_dn_band(:,jcol,jlev+1))
+          if (config%do_clear) then
+            call indexed_sum(flux_up_clear, &
+                 &           config%i_spec_from_reordered_g_sw, &
+                 &           flux%sw_up_clear_band(:,jcol,jlev+1))
+            call indexed_sum(direct_dn_clear, &
+                 &           config%i_spec_from_reordered_g_sw, &
+                 &           flux%sw_dn_clear_band(:,jcol,jlev+1))
+            flux%sw_dn_clear_band(:,jcol,jlev+1) = &
+                 &  mu0 * flux%sw_dn_clear_band(:,jcol,jlev+1)
+            if (allocated(flux%sw_dn_direct_clear_band)) then
+              flux%sw_dn_direct_clear_band(:,jcol,jlev+1) &
+                   &  = flux%sw_dn_clear_band(:,jcol,jlev+1)
+            end if
+            call add_indexed_sum(flux_dn_clear, &
+                 &           config%i_spec_from_reordered_g_sw, &
+                 &           flux%sw_dn_clear_band(:,jcol,jlev+1))
+          end if
+        end if
+
+      end do ! Final loop over levels
+      
+      ! Store surface spectral fluxes, if required (after the end of
+      ! the final loop over levels, the current values of these arrays
+      ! will be the surface values)
+      flux%sw_dn_diffuse_surf_g(:,jcol) = sum(flux_dn,2)
+      flux%sw_dn_direct_surf_g(:,jcol)  = mu0 * sum(direct_dn,2)
+      if (config%do_clear) then
+        flux%sw_dn_diffuse_surf_clear_g(:,jcol) = flux_dn_clear
+        flux%sw_dn_direct_surf_clear_g(:,jcol)  = mu0 * direct_dn_clear
+      end if
+
+    end do ! Loop over columns
+
+    if (lhook) call dr_hook('radiation_tripleclouds_sw:solver_tripleclouds_sw',1,hook_handle)
+
+  end subroutine solver_tripleclouds_sw
+
+end module radiation_tripleclouds_sw
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_two_stream.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_two_stream.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_two_stream.F90	(revision 3908)
@@ -0,0 +1,729 @@
+! radiation_two_stream.F90 - Compute two-stream coefficients
+!
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+! Modifications
+!   2017-05-04  P Dueben/R Hogan  Use JPRD where double precision essential
+!   2017-07-12  R Hogan  Optimized LW coeffs in low optical depth case
+!   2017-07-26  R Hogan  Added calc_frac_scattered_diffuse_sw routine
+!   2017-10-23  R Hogan  Renamed single-character variables
+
+module radiation_two_stream
+
+  use parkind1, only : jprb, jprd
+
+  implicit none
+  public
+
+  ! Elsasser's factor: the effective factor by which the zenith
+  ! optical depth needs to be multiplied to account for longwave
+  ! transmission at all angles through the atmosphere.  Alternatively
+  ! think of acos(1/lw_diffusivity) to be the effective zenith angle
+  ! of longwave radiation.
+  real(jprd), parameter :: LwDiffusivity = 1.66_jprd
+
+  ! Shortwave diffusivity factor assumes hemispheric isotropy, assumed
+  ! by Zdunkowski's scheme and most others; note that for efficiency
+  ! this parameter is not used in the calculation of the gamma values,
+  ! but is used in the SPARTACUS solver.
+  real(jprb), parameter :: SwDiffusivity = 2.00_jprb
+
+  ! The routines in this module can be called millions of times, so
+  !calling Dr Hook for each one may be a significant overhead.
+  !Uncomment the following to turn Dr Hook on.
+!#define DO_DR_HOOK_TWO_STREAM
+
+contains
+
+#ifdef FAST_EXPONENTIAL
+  !---------------------------------------------------------------------
+  ! Fast exponential for negative arguments: a Pade approximant that
+  ! doesn't go negative for negative arguments, applied to arg/8, and
+  ! the result is then squared three times
+  elemental function exp_fast(arg) result(ex)
+    real(jprd) :: arg, ex
+    ex = 1.0_jprd / (1.0_jprd + arg*(-0.125_jprd &
+         + arg*(0.0078125_jprd - 0.000325520833333333_jprd * arg)))
+    ex = ex*ex
+    ex = ex*ex
+    ex = ex*ex
+  end function exp_fast
+#else
+#define exp_fast exp
+#endif
+
+  !---------------------------------------------------------------------
+  ! Calculate the two-stream coefficients gamma1 and gamma2 for the
+  ! longwave
+  subroutine calc_two_stream_gammas_lw(ng, ssa, g, &
+       &                               gamma1, gamma2)
+
+#ifdef DO_DR_HOOK_TWO_STREAM
+    use yomhook, only : lhook, dr_hook
+#endif
+
+    integer, intent(in) :: ng
+    ! Sngle scattering albedo and asymmetry factor:
+    real(jprb), intent(in),  dimension(:) :: ssa, g
+    real(jprb), intent(out), dimension(:) :: gamma1, gamma2
+
+    real(jprb) :: factor
+
+    integer    :: jg
+
+#ifdef DO_DR_HOOK_TWO_STREAM
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_two_stream:calc_two_stream_gammas_lw',0,hook_handle)
+#endif
+
+    do jg = 1, ng
+      ! Fu et al. (1997), Eq 2.9 and 2.10:
+      !      gamma1(jg) = LwDiffusivity * (1.0_jprb - 0.5_jprb*ssa(jg) &
+      !           &                    * (1.0_jprb + g(jg)))
+      !      gamma2(jg) = LwDiffusivity * 0.5_jprb * ssa(jg) &
+      !           &                    * (1.0_jprb - g(jg))
+      ! Reduce number of multiplications
+      factor = (LwDiffusivity * 0.5_jprb) * ssa(jg)
+      gamma1(jg) = LwDiffusivity - factor*(1.0_jprb + g(jg))
+      gamma2(jg) = factor * (1.0_jprb - g(jg))
+    end do
+
+#ifdef DO_DR_HOOK_TWO_STREAM
+    if (lhook) call dr_hook('radiation_two_stream:calc_two_stream_gammas_lw',1,hook_handle)
+#endif
+
+  end subroutine calc_two_stream_gammas_lw
+
+
+  !---------------------------------------------------------------------
+  ! Calculate the two-stream coefficients gamma1-gamma4 in the
+  ! shortwave
+  subroutine calc_two_stream_gammas_sw(ng, mu0, ssa, g, &
+       &                               gamma1, gamma2, gamma3)
+
+#ifdef DO_DR_HOOK_TWO_STREAM
+    use yomhook, only : lhook, dr_hook
+#endif
+
+    integer, intent(in) :: ng
+    ! Cosine of solar zenith angle, single scattering albedo and
+    ! asymmetry factor:
+    real(jprb), intent(in)                :: mu0
+    real(jprb), intent(in),  dimension(:) :: ssa, g
+    real(jprb), intent(out), dimension(:) :: gamma1, gamma2, gamma3
+
+    real(jprb) :: factor
+
+    integer    :: jg
+
+#ifdef DO_DR_HOOK_TWO_STREAM
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_two_stream:calc_two_stream_gammas_sw',0,hook_handle)
+#endif
+
+    ! Zdunkowski "PIFM" (Zdunkowski et al., 1980; Contributions to
+    ! Atmospheric Physics 53, 147-66)
+    do jg = 1, ng
+      !      gamma1(jg) = 2.0_jprb  - ssa(jg) * (1.25_jprb + 0.75_jprb*g(jg))
+      !      gamma2(jg) = 0.75_jprb *(ssa(jg) * (1.0_jprb - g(jg)))
+      !      gamma3(jg) = 0.5_jprb  - (0.75_jprb*mu0)*g(jg)
+      ! Optimized version:
+      factor = 0.75_jprb*g(jg)
+      gamma1(jg) = 2.0_jprb  - ssa(jg) * (1.25_jprb + factor)
+      gamma2(jg) = ssa(jg) * (0.75_jprb - factor)
+      gamma3(jg) = 0.5_jprb  - mu0*factor
+    end do
+
+#ifdef DO_DR_HOOK_TWO_STREAM
+    if (lhook) call dr_hook('radiation_two_stream:calc_two_stream_gammas_sw',1,hook_handle)
+#endif
+
+  end subroutine calc_two_stream_gammas_sw
+
+
+  !---------------------------------------------------------------------
+  ! Compute the longwave reflectance and transmittance to diffuse
+  ! radiation using the Meador & Weaver formulas, as well as the
+  ! upward flux at the top and the downward flux at the base of the
+  ! layer due to emission from within the layer assuming a linear
+  ! variation of Planck function within the layer.
+  subroutine calc_reflectance_transmittance_lw(ng, &
+       &    od, gamma1, gamma2, planck_top, planck_bot, &
+       &    reflectance, transmittance, source_up, source_dn)
+
+#ifdef DO_DR_HOOK_TWO_STREAM
+    use yomhook, only : lhook, dr_hook
+#endif
+
+    integer, intent(in) :: ng
+
+    ! Optical depth and single scattering albedo
+    real(jprb), intent(in), dimension(ng) :: od
+
+    ! The two transfer coefficients from the two-stream
+    ! differentiatial equations (computed by
+    ! calc_two_stream_gammas_lw)
+    real(jprb), intent(in), dimension(ng) :: gamma1, gamma2
+
+    ! The Planck terms (functions of temperature) at the top and
+    ! bottom of the layer
+    real(jprb), intent(in), dimension(ng) :: planck_top, planck_bot
+
+    ! The diffuse reflectance and transmittance, i.e. the fraction of
+    ! diffuse radiation incident on a layer from either top or bottom
+    ! that is reflected back or transmitted through
+    real(jprb), intent(out), dimension(ng) :: reflectance, transmittance
+
+    ! The upward emission at the top of the layer and the downward
+    ! emission at its base, due to emission from within the layer
+    real(jprb), intent(out), dimension(ng) :: source_up, source_dn
+
+    real(jprd) :: k_exponent, reftrans_factor
+    real(jprd) :: exponential  ! = exp(-k_exponent*od)
+    real(jprd) :: exponential2 ! = exp(-2*k_exponent*od)
+
+    real(jprd) :: coeff, coeff_up_top, coeff_up_bot, coeff_dn_top, coeff_dn_bot
+
+    integer :: jg
+
+#ifdef DO_DR_HOOK_TWO_STREAM
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_two_stream:calc_reflectance_transmittance_lw',0,hook_handle)
+#endif
+
+    do jg = 1, ng
+      if (od(jg) > 1.0e-3_jprd) then
+        k_exponent = sqrt(max((gamma1(jg) - gamma2(jg)) * (gamma1(jg) + gamma2(jg)), &
+             1.E-12_jprd)) ! Eq 18 of Meador & Weaver (1980)
+        exponential = exp_fast(-k_exponent*od(jg))
+        exponential2 = exponential*exponential
+        reftrans_factor = 1.0 / (k_exponent + gamma1(jg) + (k_exponent - gamma1(jg))*exponential2)
+        ! Meador & Weaver (1980) Eq. 25
+        reflectance(jg) = gamma2(jg) * (1.0_jprd - exponential2) * reftrans_factor
+        ! Meador & Weaver (1980) Eq. 26
+        transmittance(jg) = 2.0_jprd * k_exponent * exponential * reftrans_factor
+      
+        ! Compute upward and downward emission assuming the Planck
+        ! function to vary linearly with optical depth within the layer
+        ! (e.g. Wiscombe , JQSRT 1976).
+
+        ! Stackhouse and Stephens (JAS 1991) Eqs 5 & 12
+        coeff = (planck_bot(jg)-planck_top(jg)) / (od(jg)*(gamma1(jg)+gamma2(jg)))
+        coeff_up_top  =  coeff + planck_top(jg)
+        coeff_up_bot  =  coeff + planck_bot(jg)
+        coeff_dn_top  = -coeff + planck_top(jg)
+        coeff_dn_bot  = -coeff + planck_bot(jg)
+        source_up(jg) =  coeff_up_top - reflectance(jg) * coeff_dn_top - transmittance(jg) * coeff_up_bot
+        source_dn(jg) =  coeff_dn_bot - reflectance(jg) * coeff_up_bot - transmittance(jg) * coeff_dn_top
+      else
+        k_exponent = sqrt(max((gamma1(jg) - gamma2(jg)) * (gamma1(jg) + gamma2(jg)), &
+             1.E-12_jprd)) ! Eq 18 of Meador & Weaver (1980)
+        reflectance(jg) = gamma2(jg) * od(jg)
+        transmittance(jg) = (1.0_jprb - k_exponent*od(jg)) / (1.0_jprb + od(jg)*(gamma1(jg)-k_exponent))
+        source_up(jg) = (1.0_jprb - reflectance(jg) - transmittance(jg)) &
+             &       * 0.5 * (planck_top(jg) + planck_bot(jg))
+        source_dn(jg) = source_up(jg)
+      end if
+    end do
+    
+#ifdef DO_DR_HOOK_TWO_STREAM
+    if (lhook) call dr_hook('radiation_two_stream:calc_reflectance_transmittance_lw',1,hook_handle)
+#endif
+  
+  end subroutine calc_reflectance_transmittance_lw
+  
+
+
+  !---------------------------------------------------------------------
+  ! As calc_reflectance_transmittance_lw but for an isothermal layer
+  subroutine calc_reflectance_transmittance_isothermal_lw(ng, &
+       &    od, gamma1, gamma2, planck, &
+       &    reflectance, transmittance, source)
+
+#ifdef DO_DR_HOOK_TWO_STREAM
+    use yomhook, only : lhook, dr_hook
+#endif
+
+    integer, intent(in) :: ng
+
+    ! Optical depth and single scattering albedo
+    real(jprb), intent(in), dimension(ng) :: od
+
+    ! The two transfer coefficients from the two-stream
+    ! differentiatial equations (computed by
+    ! calc_two_stream_gammas_lw)
+    real(jprb), intent(in), dimension(ng) :: gamma1, gamma2
+
+    ! The Planck terms (functions of temperature) constant through the
+    ! layer
+    real(jprb), intent(in), dimension(ng) :: planck
+
+    ! The diffuse reflectance and transmittance, i.e. the fraction of
+    ! diffuse radiation incident on a layer from either top or bottom
+    ! that is reflected back or transmitted through
+    real(jprb), intent(out), dimension(ng) :: reflectance, transmittance
+
+    ! The upward emission at the top of the layer and the downward
+    ! emission at its base, due to emission from within the layer
+    real(jprb), intent(out), dimension(ng) :: source
+
+    real(jprd) :: k_exponent, reftrans_factor
+    real(jprd) :: exponential  ! = exp(-k_exponent*od)
+    real(jprd) :: exponential2 ! = exp(-2*k_exponent*od)
+
+    integer :: jg
+
+#ifdef DO_DR_HOOK_TWO_STREAM
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_two_stream:calc_reflectance_transmittance_isothermal_lw',0,hook_handle)
+#endif
+
+    do jg = 1, ng
+      k_exponent = sqrt(max((gamma1(jg) - gamma2(jg)) * (gamma1(jg) + gamma2(jg)), &
+           1.E-12_jprd)) ! Eq 18 of Meador & Weaver (1980)
+      exponential = exp_fast(-k_exponent*od(jg))
+      exponential2 = exponential*exponential
+      reftrans_factor = 1.0 / (k_exponent + gamma1(jg) + (k_exponent - gamma1(jg))*exponential2)
+      ! Meador & Weaver (1980) Eq. 25
+      reflectance(jg) = gamma2(jg) * (1.0_jprd - exponential2) * reftrans_factor
+      ! Meador & Weaver (1980) Eq. 26
+      transmittance(jg) = 2.0_jprd * k_exponent * exponential * reftrans_factor
+      
+      ! Emissivity of layer is one minus reflectance minus
+      ! transmittance, multiply by Planck function to get emitted
+      ! ousrce
+      source(jg) = planck(jg) * (1.0_jprd - reflectance(jg) - transmittance(jg))
+    end do
+    
+#ifdef DO_DR_HOOK_TWO_STREAM
+    if (lhook) call dr_hook('radiation_two_stream:calc_reflectance_transmittance_isothermal_lw',1,hook_handle)
+#endif
+  
+  end subroutine calc_reflectance_transmittance_isothermal_lw
+  
+
+
+  !---------------------------------------------------------------------
+  ! Compute the longwave transmittance to diffuse radiation in the
+  ! no-scattering case, as well as the upward flux at the top and the
+  ! downward flux at the base of the layer due to emission from within
+  ! the layer assuming a linear variation of Planck function within
+  ! the layer.
+  subroutine calc_no_scattering_transmittance_lw(ng, &
+       &    od, planck_top, planck_bot, transmittance, source_up, source_dn)
+
+#ifdef DO_DR_HOOK_TWO_STREAM
+    use yomhook, only : lhook, dr_hook
+#endif
+
+    integer, intent(in) :: ng
+
+    ! Optical depth and single scattering albedo
+    real(jprb), intent(in), dimension(ng) :: od
+
+    ! The Planck terms (functions of temperature) at the top and
+    ! bottom of the layer
+    real(jprb), intent(in), dimension(ng) :: planck_top, planck_bot
+
+    ! The diffuse transmittance, i.e. the fraction of diffuse
+    ! radiation incident on a layer from either top or bottom that is
+    ! reflected back or transmitted through
+    real(jprb), intent(out), dimension(ng) :: transmittance
+
+    ! The upward emission at the top of the layer and the downward
+    ! emission at its base, due to emission from within the layer
+    real(jprb), intent(out), dimension(ng) :: source_up, source_dn
+
+    real(jprd) :: coeff, coeff_up_top, coeff_up_bot, coeff_dn_top, coeff_dn_bot !, planck_mean
+
+    integer :: jg
+
+#ifdef DO_DR_HOOK_TWO_STREAM
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_two_stream:calc_no_scattering_transmittance_lw',0,hook_handle)
+#endif
+
+    do jg = 1, ng
+      ! Compute upward and downward emission assuming the Planck
+      ! function to vary linearly with optical depth within the layer
+      ! (e.g. Wiscombe , JQSRT 1976).
+      if (od(jg) > 1.0e-3) then
+        ! Simplified from calc_reflectance_transmittance_lw above
+        coeff = LwDiffusivity*od(jg)
+        transmittance(jg) = exp_fast(-coeff)
+        coeff = (planck_bot(jg)-planck_top(jg)) / coeff
+        coeff_up_top  =  coeff + planck_top(jg)
+        coeff_up_bot  =  coeff + planck_bot(jg)
+        coeff_dn_top  = -coeff + planck_top(jg)
+        coeff_dn_bot  = -coeff + planck_bot(jg)
+        source_up(jg) =  coeff_up_top - transmittance(jg) * coeff_up_bot
+        source_dn(jg) =  coeff_dn_bot - transmittance(jg) * coeff_dn_top
+      else
+        ! Linear limit at low optical depth
+        coeff = LwDiffusivity*od(jg)
+        transmittance(jg) = 1.0_jprb - coeff
+        source_up(jg) = coeff * 0.5_jprb * (planck_top(jg)+planck_bot(jg))
+        source_dn(jg) = source_up(jg)
+      end if
+    end do
+
+    ! Method in the older IFS radiation scheme
+    !    do j = 1, n
+    !      coeff = od(jg) / (3.59712_jprd + od(jg))
+    !      planck_mean = 0.5_jprd * (planck_top(jg) + planck_bot(jg))
+    !      
+    !      source_up(jg) = (1.0_jprd-transmittance(jg)) * (planck_mean + (planck_top(jg)    - planck_mean) * coeff)
+    !      source_dn(jg) = (1.0_jprd-transmittance(jg)) * (planck_mean + (planck_bot(jg) - planck_mean) * coeff)
+    !    end do
+
+#ifdef DO_DR_HOOK_TWO_STREAM
+    if (lhook) call dr_hook('radiation_two_stream:calc_no_scattering_transmittance_lw',1,hook_handle)
+#endif
+
+  end subroutine calc_no_scattering_transmittance_lw
+   
+   
+  !---------------------------------------------------------------------
+  ! Compute the shortwave reflectance and transmittance to diffuse
+  ! radiation using the Meador & Weaver formulas, as well as the
+  ! "direct" reflection and transmission, which really means the rate
+  ! of transfer of direct solar radiation (into a plane perpendicular
+  ! to the direct beam) into diffuse upward and downward streams at
+  ! the top and bottom of the layer, respectively.  Finally,
+  ! trans_dir_dir is the transmittance of the atmosphere to direct
+  ! radiation with no scattering.
+  subroutine calc_reflectance_transmittance_sw(ng, mu0, od, ssa, &
+       &      gamma1, gamma2, gamma3, ref_diff, trans_diff, &
+       &      ref_dir, trans_dir_diff, trans_dir_dir)
+    
+#ifdef DO_DR_HOOK_TWO_STREAM
+    use yomhook, only : lhook, dr_hook
+#endif
+
+    integer, intent(in) :: ng
+
+    ! Cosine of solar zenith angle
+    real(jprb), intent(in) :: mu0
+
+    ! Optical depth and single scattering albedo
+    real(jprb), intent(in), dimension(ng) :: od, ssa
+
+    ! The three transfer coefficients from the two-stream
+    ! differentiatial equations (computed by calc_two_stream_gammas)
+    real(jprb), intent(in), dimension(ng) :: gamma1, gamma2, gamma3
+
+    ! The direct reflectance and transmittance, i.e. the fraction of
+    ! incoming direct solar radiation incident at the top of a layer
+    ! that is either reflected back (ref_dir) or scattered but
+    ! transmitted through the layer to the base (trans_dir_diff)
+    real(jprb), intent(out), dimension(ng) :: ref_dir, trans_dir_diff
+
+    ! The diffuse reflectance and transmittance, i.e. the fraction of
+    ! diffuse radiation incident on a layer from either top or bottom
+    ! that is reflected back or transmitted through
+    real(jprb), intent(out), dimension(ng) :: ref_diff, trans_diff
+
+    ! Transmittance of the direct been with no scattering
+    real(jprb), intent(out), dimension(ng) :: trans_dir_dir
+
+    real(jprd) :: gamma4, alpha1, alpha2, k_exponent, reftrans_factor
+    real(jprd) :: exponential0 ! = exp(-od/mu0)
+    real(jprd) :: exponential  ! = exp(-k_exponent*od)
+    real(jprd) :: exponential2 ! = exp(-2*k_exponent*od)
+    real(jprd) :: k_mu0, k_gamma3, k_gamma4
+    real(jprd) :: k_2_exponential, od_over_mu0
+    integer    :: jg
+
+#ifdef DO_DR_HOOK_TWO_STREAM
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_two_stream:calc_reflectance_transmittance_sw',0,hook_handle)
+#endif
+
+    do jg = 1, ng
+      od_over_mu0 = max(od(jg) / mu0, 0.0_jprd)
+      ! In the IFS this appears to be faster without testing the value
+      ! of od_over_mu0:
+      if (.true.) then
+!      if (od_over_mu0 > 1.0e-6_jprd) then
+        gamma4 = 1.0_jprd - gamma3(jg)
+        alpha1 = gamma1(jg)*gamma4     + gamma2(jg)*gamma3(jg) ! Eq. 16
+        alpha2 = gamma1(jg)*gamma3(jg) + gamma2(jg)*gamma4    ! Eq. 17
+        
+        ! Note that if the minimum value is reduced (e.g. to 1.0e-24)
+        ! then noise starts to appear as a function of solar zenith
+        ! angle
+        k_exponent = sqrt(max((gamma1(jg) - gamma2(jg)) * (gamma1(jg) + gamma2(jg)), &
+             &       1.0e-12_jprd)) ! Eq 18
+        k_mu0 = k_exponent*mu0
+        k_gamma3 = k_exponent*gamma3(jg)
+        k_gamma4 = k_exponent*gamma4
+        ! Check for mu0 <= 0!
+        exponential0 = exp_fast(-od_over_mu0)
+        trans_dir_dir(jg) = exponential0
+        exponential = exp_fast(-k_exponent*od(jg))
+        
+        exponential2 = exponential*exponential
+        k_2_exponential = 2.0_jprd * k_exponent * exponential
+        
+        if (k_mu0 == 1.0_jprd) then
+          k_mu0 = 1.0_jprd - 10.0_jprd*epsilon(1.0_jprd)
+        end if
+        
+        reftrans_factor = 1.0_jprd / (k_exponent + gamma1(jg) + (k_exponent - gamma1(jg))*exponential2)
+        
+        ! Meador & Weaver (1980) Eq. 25
+        ref_diff(jg) = gamma2(jg) * (1.0_jprd - exponential2) * reftrans_factor
+        
+        ! Meador & Weaver (1980) Eq. 26
+        trans_diff(jg) = k_2_exponential * reftrans_factor
+        
+        ! Here we need mu0 even though it wasn't in Meador and Weaver
+        ! because we are assuming the incoming direct flux is defined
+        ! to be the flux into a plane perpendicular to the direction of
+        ! the sun, not into a horizontal plane
+        reftrans_factor = mu0 * ssa(jg) * reftrans_factor / (1.0_jprd - k_mu0*k_mu0)
+        
+        ! Meador & Weaver (1980) Eq. 14, multiplying top & bottom by
+        ! exp(-k_exponent*od) in case of very high optical depths
+        ref_dir(jg) = reftrans_factor &
+             &  * ( (1.0_jprd - k_mu0) * (alpha2 + k_gamma3) &
+             &     -(1.0_jprd + k_mu0) * (alpha2 - k_gamma3)*exponential2 &
+             &     -k_2_exponential*(gamma3(jg) - alpha2*mu0)*exponential0)
+        
+        ! Meador & Weaver (1980) Eq. 15, multiplying top & bottom by
+        ! exp(-k_exponent*od), minus the 1*exp(-od/mu0) term representing direct
+        ! unscattered transmittance.  
+        trans_dir_diff(jg) = reftrans_factor * ( k_2_exponential*(gamma4 + alpha1*mu0) &
+            & - exponential0 &
+            & * ( (1.0_jprd + k_mu0) * (alpha1 + k_gamma4) &
+            &    -(1.0_jprd - k_mu0) * (alpha1 - k_gamma4) * exponential2) )
+
+      else
+        ! Low optical-depth limit; see equations 19, 20 and 27 from
+        ! Meador & Weaver (1980)
+        trans_diff(jg)     = 1.0_jprb - gamma1(jg) * od(jg)
+        ref_diff(jg)       = gamma2(jg) * od(jg)
+        trans_dir_diff(jg) = (1.0_jprb - gamma3(jg)) * ssa(jg) * od(jg)
+        ref_dir(jg)        = gamma3(jg) * ssa(jg) * od(jg)
+        trans_dir_dir(jg)  = 1.0_jprd - od_over_mu0
+      end if
+    end do
+    
+#ifdef DO_DR_HOOK_TWO_STREAM
+    if (lhook) call dr_hook('radiation_two_stream:calc_reflectance_transmittance_sw',1,hook_handle)
+#endif
+ 
+  end subroutine calc_reflectance_transmittance_sw
+  
+  !---------------------------------------------------------------------
+  ! As above but with height as a vertical coordinate rather than
+  ! optical depth
+  subroutine calc_reflectance_transmittance_z_sw(ng, mu0, depth, &
+       &      gamma0, gamma1, gamma2, gamma3, gamma4, &
+       &      ref_diff, trans_diff, ref_dir, trans_dir_diff, trans_dir_dir)
+    
+#ifdef DO_DR_HOOK_TWO_STREAM
+    use yomhook, only : lhook, dr_hook
+#endif
+
+    integer, intent(in) :: ng
+
+    ! Cosine of solar zenith angle
+    real(jprb), intent(in) :: mu0
+
+    ! Layer depth
+    real(jprb), intent(in) :: depth
+
+    ! The four transfer coefficients from the two-stream
+    ! differentiatial equations
+    real(jprb), intent(in), dimension(ng) :: gamma1, gamma2, gamma3, gamma4
+
+    ! An additional coefficient for direct unscattered flux "Fdir"
+    ! such that dFdir/dz = -gamma0*Fdir
+    real(jprb), intent(in), dimension(ng) :: gamma0
+
+    ! The direct reflectance and transmittance, i.e. the fraction of
+    ! incoming direct solar radiation incident at the top of a layer
+    ! that is either reflected back (ref_dir) or scattered but
+    ! transmitted through the layer to the base (trans_dir_diff)
+    real(jprb), intent(out), dimension(ng) :: ref_dir, trans_dir_diff
+
+    ! The diffuse reflectance and transmittance, i.e. the fraction of
+    ! diffuse radiation incident on a layer from either top or bottom
+    ! that is reflected back or transmitted through
+    real(jprb), intent(out), dimension(ng) :: ref_diff, trans_diff
+
+    ! Transmittance of the direct been with no scattering
+    real(jprb), intent(out), dimension(ng) :: trans_dir_dir
+
+    real(jprd) :: alpha1, alpha2, k_exponent, reftrans_factor
+    real(jprd) :: exponential0 ! = exp(-od/mu0)
+    real(jprd) :: exponential  ! = exp(-k_exponent*od)
+    real(jprd) :: exponential2 ! = exp(-2*k_exponent*od)
+    real(jprd) :: k_mu0, k_gamma3, k_gamma4
+    real(jprd) :: k_2_exponential, od_over_mu0
+    integer    :: jg
+
+#ifdef DO_DR_HOOK_TWO_STREAM
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_two_stream:calc_reflectance_transmittance_z_sw',0,hook_handle)
+#endif
+
+    do jg = 1, ng
+      od_over_mu0 = max(gamma0(jg) * depth, 0.0_jprd)
+      ! In the IFS this appears to be faster without testing the value
+      ! of od_over_mu0:
+      if (.true.) then
+!      if (od_over_mu0 > 1.0e-6_jprd) then
+        alpha1 = gamma1(jg)*gamma4(jg) + gamma2(jg)*gamma3(jg) ! Eq. 16
+        alpha2 = gamma1(jg)*gamma3(jg) + gamma2(jg)*gamma4(jg) ! Eq. 17
+        
+        ! Note that if the minimum value is reduced (e.g. to 1.0e-24)
+        ! then noise starts to appear as a function of solar zenith
+        ! angle
+        k_exponent = sqrt(max((gamma1(jg) - gamma2(jg)) * (gamma1(jg) + gamma2(jg)), &
+             &       1.0e-12_jprd)) ! Eq 18
+        k_mu0 = k_exponent*mu0
+        k_gamma3 = k_exponent*gamma3(jg)
+        k_gamma4 = k_exponent*gamma4(jg)
+        ! Check for mu0 <= 0!
+        exponential0 = exp_fast(-od_over_mu0)
+        trans_dir_dir(jg) = exponential0
+        exponential = exp_fast(-k_exponent*depth)
+        
+        exponential2 = exponential*exponential
+        k_2_exponential = 2.0_jprd * k_exponent * exponential
+        
+        if (k_mu0 == 1.0_jprd) then
+          k_mu0 = 1.0_jprd - 10.0_jprd*epsilon(1.0_jprd)
+        end if
+        
+        reftrans_factor = 1.0_jprd / (k_exponent + gamma1(jg) + (k_exponent - gamma1(jg))*exponential2)
+        
+        ! Meador & Weaver (1980) Eq. 25
+        ref_diff(jg) = gamma2(jg) * (1.0_jprd - exponential2) * reftrans_factor
+        
+        ! Meador & Weaver (1980) Eq. 26
+        trans_diff(jg) = k_2_exponential * reftrans_factor
+        
+        ! Here we need mu0 even though it wasn't in Meador and Weaver
+        ! because we are assuming the incoming direct flux is defined
+        ! to be the flux into a plane perpendicular to the direction of
+        ! the sun, not into a horizontal plane
+        reftrans_factor = mu0 * reftrans_factor / (1.0_jprd - k_mu0*k_mu0)
+        
+        ! Meador & Weaver (1980) Eq. 14, multiplying top & bottom by
+        ! exp(-k_exponent*od) in case of very high optical depths
+        ref_dir(jg) = reftrans_factor &
+             &  * ( (1.0_jprd - k_mu0) * (alpha2 + k_gamma3) &
+             &     -(1.0_jprd + k_mu0) * (alpha2 - k_gamma3)*exponential2 &
+             &     -k_2_exponential*(gamma3(jg) - alpha2*mu0)*exponential0)
+        
+        ! Meador & Weaver (1980) Eq. 15, multiplying top & bottom by
+        ! exp(-k_exponent*od), minus the 1*exp(-od/mu0) term representing direct
+        ! unscattered transmittance.  
+        trans_dir_diff(jg) = reftrans_factor * ( k_2_exponential*(gamma4(jg) + alpha1*mu0) &
+            & - exponential0 &
+            & * ( (1.0_jprd + k_mu0) * (alpha1 + k_gamma4) &
+            &    -(1.0_jprd - k_mu0) * (alpha1 - k_gamma4) * exponential2) )
+
+      else
+        ! Low optical-depth limit; see equations 19, 20 and 27 from
+        ! Meador & Weaver (1980)
+        trans_diff(jg)     = 1.0_jprb - gamma1(jg) * depth
+        ref_diff(jg)       = gamma2(jg) * depth
+        trans_dir_diff(jg) = (1.0_jprb - gamma3(jg)) * depth
+        ref_dir(jg)        = gamma3(jg) * depth
+        trans_dir_dir(jg)  = 1.0_jprd - od_over_mu0
+      end if
+    end do
+    
+#ifdef DO_DR_HOOK_TWO_STREAM
+    if (lhook) call dr_hook('radiation_two_stream:calc_reflectance_transmittance_z_sw',1,hook_handle)
+#endif
+ 
+  end subroutine calc_reflectance_transmittance_z_sw
+  
+
+  !---------------------------------------------------------------------
+  ! Compute the fraction of shortwave transmitted diffuse radiation
+  ! that is scattered during its transmission, used to compute
+  ! entrapment in SPARTACUS
+  subroutine calc_frac_scattered_diffuse_sw(ng, od, &
+       &      gamma1, gamma2, frac_scat_diffuse)
+    
+#ifdef DO_DR_HOOK_TWO_STREAM
+    use yomhook, only : lhook, dr_hook
+#endif
+
+    integer, intent(in) :: ng
+
+    ! Optical depth
+    real(jprb), intent(in), dimension(ng) :: od
+
+    ! The first two transfer coefficients from the two-stream
+    ! differentiatial equations (computed by calc_two_stream_gammas)
+    real(jprb), intent(in), dimension(ng) :: gamma1, gamma2
+
+    ! The fraction of shortwave transmitted diffuse radiation that is
+    ! scattered during its transmission
+    real(jprb), intent(out), dimension(ng) :: frac_scat_diffuse
+
+    real(jprd) :: k_exponent, reftrans_factor
+    real(jprd) :: exponential  ! = exp(-k_exponent*od)
+    real(jprd) :: exponential2 ! = exp(-2*k_exponent*od)
+    real(jprd) :: k_2_exponential
+    integer    :: jg
+
+#ifdef DO_DR_HOOK_TWO_STREAM
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_two_stream:calc_frac_scattered_diffuse_sw',0,hook_handle)
+#endif
+
+    do jg = 1, ng
+      ! Note that if the minimum value is reduced (e.g. to 1.0e-24)
+      ! then noise starts to appear as a function of solar zenith
+      ! angle
+      k_exponent = sqrt(max((gamma1(jg) - gamma2(jg)) * (gamma1(jg) + gamma2(jg)), &
+           &       1.0e-12_jprd)) ! Eq 18
+      exponential = exp_fast(-k_exponent*od(jg))
+      exponential2 = exponential*exponential
+      k_2_exponential = 2.0_jprd * k_exponent * exponential
+        
+      reftrans_factor = 1.0_jprd / (k_exponent + gamma1(jg) + (k_exponent - gamma1(jg))*exponential2)
+        
+      ! Meador & Weaver (1980) Eq. 26.
+      ! Until 1.1.8, used LwDiffusivity instead of 2.0, although the
+      ! effect is very small
+      !      frac_scat_diffuse(jg) = 1.0_jprb - min(1.0_jprb,exp_fast(-LwDiffusivity*od(jg)) &
+      !           &  / max(1.0e-8_jprb, k_2_exponential * reftrans_factor))
+      frac_scat_diffuse(jg) = 1.0_jprb &
+           &  - min(1.0_jprb,exp_fast(-2.0_jprb*od(jg)) &
+           &  / max(1.0e-8_jprb, k_2_exponential * reftrans_factor))
+    end do
+    
+#ifdef DO_DR_HOOK_TWO_STREAM
+    if (lhook) call dr_hook('radiation_two_stream:calc_frac_scattered_diffuse_sw',1,hook_handle)
+#endif
+ 
+  end subroutine calc_frac_scattered_diffuse_sw
+
+end module radiation_two_stream
Index: LMDZ6/trunk/libf/phylmd/ecrad/radsurf_3d_vegetation.F90.or
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radsurf_3d_vegetation.F90.or	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radsurf_3d_vegetation.F90.or	(revision 3908)
@@ -0,0 +1,73 @@
+! radsurf_3d_vegetation.f90 - Compute radiative transfer in 3D vegetation canopy
+!
+! (C) Copyright 2018- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+
+module radsurf_3d_vegetation
+
+contains
+  subroutine calc_boundary_conditions_sw(config, n_albedo_bands, tile_fraction, &
+       &  canopy_depth, vegetation_optical_depth, vegetation_albedo, &
+       &  ground_albedo_diffuse, ground_albedo_direct, &
+       &  ref_dif, tra_dif, ref_dir, tra_dir_dif, tra_dir_dir, &
+       &  albedo_diffuse_reg, albedo_direct_reg, &
+       &  albedo_diffuse_out, albedo_direct_out, &
+       &  ext_air, ssa_air, g_air)
+
+    use parkind, only : jprb
+    use radiation_config, only : config_type
+
+    implicit none
+
+    ! Number of regions
+    integer, parameter :: nreg = 2
+
+    type(config_type), intent(in) :: config
+
+    integer,           intent(in) :: n_albedo_bands
+
+    ! Fraction of gridbox occupied by this tile
+    real(kind=jprb),   intent(in) :: tile_fraction
+
+    ! Depth of vegetation canopy in metres
+    real(kind=jprb),   intent(in) :: canopy_depth
+
+    ! Optical properties of vegetation
+    real(kind=jprb),   intent(in) :: vegetation_optical_depth
+    real(kind=jprb),   intent(in) :: vegetation_albedo(:)  ! Spectral interval
+
+    ! Optical properties of the ground (function of spectral interval)
+    real(kind=jprb),   intent(in) :: ground_albedo_diffuse(:)
+    real(kind=jprb),   intent(in) :: ground_albedo_direct(:)
+
+    ! Geometric properties
+    real(kind=jprb),   intent(in) :: vegetation_fraction
+    real(kind=jprb),   intent(in) :: vegetation_normalized_perimeter ! m-1
+
+
+    ! Intermediate properties to store
+    real(kind=jprb),   intent(in), dimension(n_albedo_bands,nreg,nreg) :: ref_dif, tra_dif, tra_dir_dif, tra_dir_dir
+
+    ! Outputs
+    real(kind=jprb),   intent(inout) :: albedo_diffuse_out, albedo_direct_out
+
+
+
+  end subroutine calc_boundary_conditions_sw
+
+  subroutine calc_boundary_conditions_lw
+
+  end subroutine calc_boundary_conditions_lw
+
+
+end module radsurf_3d_vegetation
Index: LMDZ6/trunk/libf/phylmd/ecrad/radsurf_flux.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radsurf_flux.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radsurf_flux.F90	(revision 3908)
@@ -0,0 +1,120 @@
+! radsurf_flux.f90 - Derived type to store fluxes into facets of the surface
+!
+! (C) Copyright 2017- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+
+module radsurf_flux
+
+  use parkind1, only : jprb
+
+  implicit none
+
+  public
+
+  !---------------------------------------------------------------------
+  ! This derived type contains the output from the surface radiation
+  ! calculation.  
+  type surface_flux_type
+     ! If there are tiles then the broadband fluxes are reported at
+     ! each facet of the surface, with dimension (ncol,nfacet)
+     real(jprb), allocatable, dimension(:,:) :: &
+          &  lw_dn_facet, lw_up_facet, &
+          &  sw_dn_facet, sw_dn_direct_facet, sw_up_facet
+     ! Likewise the absorption by a vegetation canopy or the air in a
+     ! street canopy is dimensioned (ncol,ntile)
+     real(jprb), allocatable, dimension(:,:) :: &
+          &  lw_abs_canopy, sw_abs_canopy
+     ! If there are tiles and
+     ! config%do_surface_sw_spectral_flux==.true. then the
+     ! facet/canopy quantities in the shortwave are output per band,
+     ! dimensioned (nband,ncol,nfacet) or (nband,ncol,ntile)
+     real(jprb), allocatable, dimension(:,:,:) :: &
+          &  sw_dn_facet_band, sw_dn_direct_facet_band, sw_up_facet_band
+     real(jprb), allocatable, dimension(:,:,:) :: &
+          &  sw_abs_canopy_band
+
+   contains
+     procedure :: allocate => allocate_surface_flux_type
+     procedure :: deallocate => deallocate_surface_flux_type
+
+  end type surface_flux_type
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Allocate arrays for surface fluxes at facets. The arrays are
+  ! dimensioned for columns between istartcol and iendcol
+  subroutine allocate_surface_flux_type(this, config, istartcol, iendcol, i_tile_representation)
+
+    use yomhook,            only : lhook, dr_hook
+!    use radiation_io,       only : nulerr, radiation_abort
+    use radiation_config,   only : config_type
+    use radsurf_properties, only : NTileFacets
+
+    integer, intent(in)                     :: istartcol, iendcol
+    class(surface_flux_type), intent(inout) :: this
+    type(config_type), intent(in)           :: config
+    integer, intent(in)                     :: i_tile_representation(:)
+
+    ! Surface description
+    integer :: ntile, nfacet
+
+    real(jprb)                      :: hook_handle
+
+    if (lhook) call dr_hook('radsurf_flux:allocate',0,hook_handle)
+
+    nfacet    = sum(NTileFacets (i_tile_representation))
+    ntile     = size(i_tile_representation)
+
+    if (config%do_lw) then
+      allocate(this%lw_dn_facet(istartcol:iendcol,nfacet))
+      allocate(this%lw_up_facet(istartcol:iendcol,nfacet))
+      allocate(this%lw_abs_canopy(istartcol:iendcol,ntile))
+    end if
+    if (config%do_sw) then
+      allocate(this%sw_dn_facet(istartcol:iendcol,nfacet))
+      allocate(this%sw_dn_direct_facet(istartcol:iendcol,nfacet))
+      allocate(this%sw_up_facet(istartcol:iendcol,nfacet))
+      allocate(this%sw_abs_canopy(istartcol:iendcol,ntile))
+    end if
+
+    if (lhook) call dr_hook('radsurf_flux:allocate',1,hook_handle)
+
+  end subroutine allocate_surface_flux_type
+
+
+  subroutine deallocate_surface_flux_type(this)
+
+    use yomhook,          only : lhook, dr_hook
+
+    class(surface_flux_type), intent(inout) :: this
+    real(jprb)                              :: hook_handle
+
+    if (lhook) call dr_hook('radsurf_flux:deallocate',0,hook_handle)
+
+    if (allocated(this%lw_dn_facet)) then
+      deallocate(this%lw_dn_facet)
+      deallocate(this%lw_up_facet)
+      deallocate(this%lw_abs_canopy)
+    end if
+    if (allocated(this%sw_dn_facet)) then
+      deallocate(this%sw_dn_facet)
+      deallocate(this%sw_dn_direct_facet)
+      deallocate(this%sw_up_facet)
+      deallocate(this%sw_abs_canopy)
+    end if
+
+    if (lhook) call dr_hook('radsurf_flux:deallocate',1,hook_handle)
+
+  end subroutine deallocate_surface_flux_type
+
+end module radsurf_flux
Index: LMDZ6/trunk/libf/phylmd/ecrad/radsurf_homogeneous_vegetation.F90.or
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radsurf_homogeneous_vegetation.F90.or	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radsurf_homogeneous_vegetation.F90.or	(revision 3908)
@@ -0,0 +1,38 @@
+! radsurf_homogeneous_vegetation.f90 - Compute radiative transfer in homogeneous vegetation canopy
+!
+! (C) Copyright 2018- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+
+module radsurf_homogeneous_vegetation
+
+contains
+  subroutine calc_boundary_conditions_sw(config, tile_fraction, &
+       &  canopy_depth, vegetation_optical_depth, vegetation_albedo, &
+       &  ground_albedo_diffuse, ground_albedo_direct, &
+       &  ref_dif, tra_dif, ref_dir, tra_dir_dif, tra_dir_dir, &
+       &  albedo_diffuse_reg, albedo_direct_reg, &
+       &  albedo_diffuse_out, albedo_direct_out, &
+       &  ext_air, ssa_air, g_air)
+
+    use parkind, only :jprb
+
+    implicit none
+
+  end subroutine calc_boundary_conditions_sw
+
+  subroutine calc_boundary_conditions_lw
+
+  end subroutine calc_boundary_conditions_lw
+
+
+end module radsurf_homogeneous_vegetation
Index: LMDZ6/trunk/libf/phylmd/ecrad/radsurf_intermediate.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radsurf_intermediate.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radsurf_intermediate.F90	(revision 3908)
@@ -0,0 +1,1316 @@
+! radsurf_intermediate.f90 - Derived type for intermediate radiative properties of surface
+!
+! (C) Copyright 2017- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+
+module radsurf_intermediate
+
+  use parkind1, only : jpim, jprb
+
+  implicit none
+
+  public
+
+  !---------------------------------------------------------------------
+  ! Derived type storing a description of radiative properties at the
+  ! level of individual facets
+  type surface_intermediate_type
+
+    ! Surface "facet" properties, dimensioned (ng, nfacet, istartcol:iendcol)
+
+    ! Longwave blackbody emission (W m-2) and emissivity from facets
+    real(kind=jprb), allocatable, dimension(:,:,:) :: planck_facet
+    real(kind=jprb), allocatable, dimension(:,:,:) :: lw_emissivity
+    ! Shortwave direct and diffuse albedo
+    real(kind=jprb), allocatable, dimension(:,:,:) :: sw_albedo_direct
+    real(kind=jprb), allocatable, dimension(:,:,:) :: sw_albedo_diffuse
+
+    ! Longwave blackbody emission (W m-2) from regions (volumes
+    ! e.g. vegetation and urban canopies)
+    real(kind=jprb), allocatable, dimension(:,:,:) :: planck_region
+  
+    ! Volumetric "region" properties of the canopy, e.g. vegetation or
+    ! the space between buildings, dimensioned
+    ! (ng,nregion,istartcol:iendcol)
+
+    ! Shortwave reflectance and transmittance to diffuse radiation
+    real(kind=jprb), allocatable, dimension(:,:,:) :: sw_ref_dif
+    real(kind=jprb), allocatable, dimension(:,:,:) :: sw_tra_dif
+    ! Shortwave reflectance and transmittance to direct radiation,
+    ! where the transmittance has separate direct-to-diffuse
+    ! transmittance (including scattering) and direct-to-direct
+    ! transmittance (without scattering)
+    real(kind=jprb), allocatable, dimension(:,:,:) :: sw_ref_dir
+    real(kind=jprb), allocatable, dimension(:,:,:) :: sw_tra_dir_dif
+    real(kind=jprb), allocatable, dimension(:,:,:) :: sw_tra_dir_dir
+    ! Fraction of direct radiation at canyon top that is absorbed by
+    ! the wall and the atmosphere
+    real(kind=jprb), allocatable, dimension(:,:,:) :: sw_wall_abs_dir
+    real(kind=jprb), allocatable, dimension(:,:,:) :: sw_air_abs_dir
+    ! Ratio of diffuse absorption in a street canyon by the wall
+    ! (rather than the air or vegetation in the canyon)
+    real(kind=jprb), allocatable, dimension(:,:,:) :: sw_wall_abs_frac_dif
+    real(kind=jprb), allocatable, dimension(:,:,:) :: lw_wall_abs_frac
+    ! Shortwave direct and diffuse albedo at the top of a region
+    real(kind=jprb), allocatable, dimension(:,:,:) :: sw_albedo_direct_reg
+    real(kind=jprb), allocatable, dimension(:,:,:) :: sw_albedo_diffuse_reg
+    ! Longwave reflectance, transmittance and source (note that source
+    ! is the same up and down because the canopy temperature is
+    ! assumed constant with height)
+    real(kind=jprb), allocatable, dimension(:,:,:) :: lw_reflectance
+    real(kind=jprb), allocatable, dimension(:,:,:) :: lw_transmittance
+    real(kind=jprb), allocatable, dimension(:,:,:) :: lw_source
+    ! Longwave emission and emissivity passed to the atmosphere scheme
+    ! from the top of a region
+    real(kind=jprb), allocatable, dimension(:,:,:) :: lw_emissivity_region
+    real(kind=jprb), allocatable, dimension(:,:,:) :: lw_emission_region
+    ! Total emission from wall and the air in an urban canopy, needed
+    ! at the final partitioning stage to determine net fluxes into
+    ! wall and air
+    real(kind=jprb), allocatable, dimension(:,:,:) :: lw_total_wall_emission
+    real(kind=jprb), allocatable, dimension(:,:,:) :: lw_total_canopy_emission
+
+    ! Number of bands in which calculations are to be performed (can
+    ! match either the spectral resolution of the atmosphere or that
+    ! of the surface data)
+    integer :: nswbands, nlwbands
+
+    ! Do we represent gas radiative transfer in street/vegetation
+    ! canopies?
+    !logical :: do_canopy_gases_sw = .false.
+    !logical :: do_canopy_gases_lw = .false.
+
+    ! Do we use the full spectrum?
+    !logical :: use_full_spectrum_sw = .false.
+    !logical :: use_full_spectrum_lw = .true.
+
+  contains
+
+    procedure :: allocate    => allocate_surface_intermediate
+    procedure :: deallocate  => deallocate_surface_intermediate
+    procedure :: calc_boundary_conditions_sw
+    procedure :: calc_boundary_conditions_lw
+    procedure :: calc_boundary_conditions
+    procedure :: partition_fluxes
+
+  end type surface_intermediate_type
+
+contains
+
+  !---------------------------------------------------------------------
+  subroutine allocate_surface_intermediate(this, istartcol, iendcol, &
+       &                                   config, surface)
+    
+    use radiation_config,   only : config_type
+    use radsurf_properties, only : surface_type
+
+    class(surface_intermediate_type), intent(inout) :: this
+    integer(kind=jpim),               intent(in)    :: istartcol, iendcol
+    type(config_type),                intent(in)    :: config
+    type(surface_type),               intent(in)    :: surface
+
+    call this%deallocate
+
+    !this%use_full_spectrum_sw = config%use_canopy_full_spectrum_sw
+    !this%use_full_spectrum_lw = config%use_canopy_full_spectrum_lw
+    ! Assume that canopy gases will only be used if we do surface
+    ! calculations at the full spectral resolution
+    !this%do_canopy_gases_sw   = config%do_canopy_gases_sw
+    !this%do_canopy_gases_lw   = config%do_canopy_gases_lw
+
+    if (config%use_canopy_full_spectrum_sw) then
+      ! Calculations will be performed at the same spectral resolution
+      ! as in the atmosphere
+      this%nswbands = config%n_g_sw
+    else
+      ! Calculations will be performed at the same spectral resolution
+      ! as the input surface-property data
+      this%nswbands = surface%nalbedobands
+    end if
+
+    if (config%use_canopy_full_spectrum_lw) then
+      ! Calculations will be performed at the same spectral resolution
+      ! as in the atmosphere
+      this%nlwbands = config%n_g_lw
+    else
+      ! Calculations will be performed at the same spectral resolution
+      ! as the input surface-property data
+      this%nlwbands = surface%nemissbands
+    end if
+
+    if (config%do_lw) then
+      allocate(this%planck_facet     (this%nlwbands,surface%nfacet,istartcol:iendcol))
+      allocate(this%lw_emissivity    (this%nlwbands,surface%nfacet,istartcol:iendcol))
+    end if
+    if (config%do_sw) then
+      allocate(this%sw_albedo_direct (this%nswbands,surface%nfacet,istartcol:iendcol))
+      allocate(this%sw_albedo_diffuse(this%nswbands,surface%nfacet,istartcol:iendcol))
+    end if
+
+    if (surface%nregion > 0) then
+      if (config%do_lw) then
+        allocate(this%planck_region   (this%nlwbands,surface%nregion,istartcol:iendcol))
+        allocate(this%lw_reflectance  (this%nlwbands,surface%nregion,istartcol:iendcol))
+        allocate(this%lw_transmittance(this%nlwbands,surface%nregion,istartcol:iendcol))
+        allocate(this%lw_source       (this%nlwbands,surface%nregion,istartcol:iendcol))
+        allocate(this%lw_emission_region(this%nlwbands,surface%nregion,istartcol:iendcol))
+        allocate(this%lw_emissivity_region(this%nlwbands,surface%nregion,istartcol:iendcol))
+        allocate(this%lw_wall_abs_frac(this%nlwbands,surface%nregion,istartcol:iendcol))
+        allocate(this%lw_total_wall_emission(this%nlwbands,surface%nregion,istartcol:iendcol))
+        allocate(this%lw_total_canopy_emission(this%nlwbands,surface%nregion,istartcol:iendcol))
+      end if
+      if (config%do_sw) then
+        allocate(this%sw_ref_dif    (this%nswbands,surface%nregion,istartcol:iendcol))
+        allocate(this%sw_tra_dif    (this%nswbands,surface%nregion,istartcol:iendcol))
+        allocate(this%sw_ref_dir    (this%nswbands,surface%nregion,istartcol:iendcol))
+        allocate(this%sw_tra_dir_dif(this%nswbands,surface%nregion,istartcol:iendcol))
+        allocate(this%sw_tra_dir_dir(this%nswbands,surface%nregion,istartcol:iendcol))
+        allocate(this%sw_wall_abs_dir(this%nswbands,surface%nregion,istartcol:iendcol))
+        allocate(this%sw_air_abs_dir(this%nswbands,surface%nregion,istartcol:iendcol))
+        allocate(this%sw_wall_abs_frac_dif(this%nswbands,surface%nregion,istartcol:iendcol))
+        allocate(this%sw_albedo_diffuse_reg(this%nswbands,surface%nregion,istartcol:iendcol))
+        allocate(this%sw_albedo_direct_reg(this%nswbands,surface%nregion,istartcol:iendcol))
+      end if
+    end if
+
+  end subroutine allocate_surface_intermediate
+
+  !---------------------------------------------------------------------
+  subroutine deallocate_surface_intermediate(this)
+
+    class(surface_intermediate_type), intent(inout) :: this
+
+    if (allocated(this%planck_facet)) then
+      deallocate(this%planck_facet)
+    end if
+    if (allocated(this%planck_region)) then
+      deallocate(this%planck_region)
+    end if
+    if (allocated(this%lw_emissivity)) then
+      deallocate(this%lw_emissivity)
+    end if
+    if (allocated(this%sw_albedo_direct)) then
+      deallocate(this%sw_albedo_direct)
+    end if
+    if (allocated(this%sw_albedo_diffuse)) then
+      deallocate(this%sw_albedo_diffuse)
+    end if
+
+    if (allocated(this%lw_reflectance)) then
+      deallocate(this%lw_reflectance)
+    end if
+    if (allocated(this%lw_transmittance)) then
+      deallocate(this%lw_transmittance)
+    end if
+    if (allocated(this%lw_source)) then
+      deallocate(this%lw_source)
+    end if
+    if (allocated(this%lw_emissivity_region)) then
+      deallocate(this%lw_emissivity_region)
+    end if
+    if (allocated(this%lw_emission_region)) then
+      deallocate(this%lw_emission_region)
+    end if
+    if (allocated(this%lw_wall_abs_frac)) then
+      deallocate(this%lw_wall_abs_frac)
+    end if
+    if (allocated(this%lw_total_wall_emission)) then
+      deallocate(this%lw_total_wall_emission)
+    end if
+    if (allocated(this%lw_total_canopy_emission)) then
+      deallocate(this%lw_total_canopy_emission)
+    end if
+
+    if (allocated(this%sw_ref_dif)) then
+      deallocate(this%sw_ref_dif)
+    end if
+    if (allocated(this%sw_tra_dif)) then
+      deallocate(this%sw_tra_dif)
+    end if
+    if (allocated(this%sw_ref_dir)) then
+      deallocate(this%sw_ref_dir)
+    end if
+    if (allocated(this%sw_tra_dir_dif)) then
+      deallocate(this%sw_tra_dir_dif)
+    end if
+    if (allocated(this%sw_tra_dir_dir)) then
+      deallocate(this%sw_tra_dir_dir)
+    end if
+    if (allocated(this%sw_wall_abs_frac_dif)) then
+      deallocate(this%sw_wall_abs_frac_dif)
+    end if
+    if (allocated(this%sw_wall_abs_dir)) then
+      deallocate(this%sw_wall_abs_dir)
+    end if
+    if (allocated(this%sw_air_abs_dir)) then
+      deallocate(this%sw_air_abs_dir)
+    end if
+    if (allocated(this%sw_albedo_direct_reg)) then
+      deallocate(this%sw_albedo_direct_reg)
+    end if
+    if (allocated(this%sw_albedo_diffuse_reg)) then
+      deallocate(this%sw_albedo_diffuse_reg)
+    end if
+
+  end subroutine deallocate_surface_intermediate
+
+
+
+  !---------------------------------------------------------------------
+  ! Use the detailed physical properties of the surface in "surface",
+  ! and optionally the atmospheric optical properties of the lowest
+  ! atmospheric level, to work out the shortwave direct/diffuse albedo
+  ! that is presented to the rest of the radiation scheme, and stored
+  ! in "single_level". Also, store the necessary information so that
+  ! after the atmospheric radiation scheme has been run, the net
+  ! fluxes at each.
+  subroutine calc_boundary_conditions_sw(this, istartcol, iendcol, &   ! in
+       &  config, surface, &                    ! in
+       &  single_level, &                                 ! out
+       &  ext_sw_air, ssa_sw_air, g_sw_air)               ! in, optional
+
+    use yomhook,                only : lhook, dr_hook
+
+    use radiation_io,           only : nulerr, radiation_abort
+    use radiation_config,       only : config_type
+    use radiation_single_level, only : single_level_type
+    use radsurf_properties,     only : surface_type, ITileFlat,ITileVegetation,ITileUrban3D
+    use radiation_two_stream,   only : calc_two_stream_gammas_sw, &
+         &                             calc_reflectance_transmittance_sw, &
+         &                             calc_reflectance_transmittance_z_sw 
+
+    use radiation_constants,    only: Pi, GasConstantDryAir, AccelDueToGravity
+
+    class(surface_intermediate_type), intent(inout) :: this
+    integer(kind=jpim),               intent(in)    :: istartcol, iendcol
+    type(config_type),                intent(in)    :: config
+    type(surface_type),               intent(in)    :: surface
+    type(single_level_type),          intent(inout) :: single_level
+
+    ! Input properties of the air in the lowest model level:
+    ! extinction coefficient (m-1), single-scattering albedo and
+    ! asymmetry factor
+    real(kind=jprb), intent(in), dimension(config%n_g_sw,istartcol:iendcol), optional &
+         &  :: ext_sw_air, ssa_sw_air, g_sw_air
+
+    ! Shortwave region properties
+    real(kind=jprb), dimension(this%nswbands) :: od_sw_region, ssa_sw_region, g_sw_region
+    ! Extinction coefficient better for urban areas
+    real(kind=jprb), dimension(this%nswbands) :: ext_sw_region
+    ! Optical depth of air
+    real(kind=jprb), dimension(this%nswbands) :: od_sw_air
+
+    real(kind=jprb)    :: tile_fraction, cos_sza
+
+    ! Exchange coefficients (m-1) for direct and diffuse radiation
+    ! into building walls
+    real(kind=jprb)    :: fdiff, fdir
+
+    ! One minus the building fraction
+    real(kind=jprb)    :: canyon_fraction
+
+    ! Tangent of solar zenith angle
+    real(kind=jprb)    :: tan_sza
+
+    ! Two-stream coefficients
+    real(jprb), dimension(this%nswbands) :: gamma1_sw, gamma2_sw
+    real(jprb), dimension(this%nswbands) :: gamma0_sw, gamma3_sw, gamma4_sw
+
+    real(jprb), dimension(this%nswbands) :: inv_denominator_sw
+
+    integer(kind=jpim) :: jcol,jtile,iregion
+
+    ! Mapping from albedo bands to reordered shortwave g points
+    integer(kind=jpim) :: i_albedo_from_g(config%n_g_sw)
+
+    ! Indices to different facets
+    integer(kind=jpim) :: iground, iwall, iroof
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radsurf_intermediate:calc_boundary_conditions_sw',0,hook_handle)
+
+    if (present(ext_sw_air)) then
+      if (.not. present(ssa_sw_air) .or. .not. present(g_sw_air)) then
+        write(nulerr,'(a)') '*** Error: if ext_sw_air is provided then ssa_sw_air and g_sw_air must also be provided'
+        call radiation_abort()
+      end if
+    end if
+
+    if (size(single_level%sw_albedo,2) /= this%nswbands) then
+      write(nulerr,'(a,i0,a,i0)') '*** Error: single-level albedo has ', &
+           &  size(single_level%sw_albedo,2), ' bands, needs ', this%nswbands
+      call radiation_abort()
+    end if
+
+    if (config%use_canopy_full_spectrum_sw) then
+      ! Put shortwave albedo on g-point grid and permute
+      i_albedo_from_g = config%i_albedo_from_band_sw(config%i_band_from_reordered_g_sw)
+      do jcol = istartcol,iendcol
+        this%sw_albedo_diffuse(:,:,jcol) = surface%sw_albedo(jcol,i_albedo_from_g,:)
+        if (allocated(surface%sw_albedo_direct)) then
+          this%sw_albedo_direct(:,:,jcol) = surface%sw_albedo_direct(jcol,i_albedo_from_g,:)
+        else
+          this%sw_albedo_direct = this%sw_albedo_diffuse
+        end if
+      end do
+    else
+      do jcol = istartcol,iendcol
+        ! No change to spectral resolution: simply permute 
+        this%sw_albedo_diffuse(:,:,jcol) = surface%sw_albedo(jcol,:,:)
+        if (allocated(surface%sw_albedo_direct)) then
+          this%sw_albedo_direct(:,:,jcol) = surface%sw_albedo_direct(jcol,:,:)
+        else
+          this%sw_albedo_direct = this%sw_albedo_diffuse
+        end if
+      end do
+    end if
+
+    if (surface%is_simple) then
+      ! We have a "traditional" representation: one flat tile
+      single_level%sw_albedo_direct(istartcol:iendcol,:) &
+           &  = transpose(this%sw_albedo_direct(:,1,istartcol:iendcol))
+      single_level%sw_albedo       (istartcol:iendcol,:) &
+           &  = transpose(this%sw_albedo_diffuse(:,1,istartcol:iendcol))
+    else
+      ! More complex description of surface
+
+      ! Firstly initialize outputs to zero
+      single_level%sw_albedo_direct(istartcol:iendcol,:) = 0.0_jprb
+      single_level%sw_albedo       (istartcol:iendcol,:) = 0.0_jprb
+
+      ! Loop over column and tile
+      do jcol = istartcol,iendcol
+        cos_sza = single_level%cos_sza(jcol)
+
+        do jtile = 1,surface%ntile
+          tile_fraction = surface%tile_fraction(jcol,jtile)
+
+          if (tile_fraction > 0.0_jprb) then
+
+            select case (surface%i_representation(jtile))
+            case (ITileFlat)
+              ! SIMPLE FLAT TILE
+
+              ! Add the contribution from this simple flat tile to the
+              ! accumulated values for the column
+              iground = surface%i_ground_facet(jcol,jtile)
+              single_level%sw_albedo_direct(jcol,:) = single_level%sw_albedo_direct(jcol,:) &
+                   &  + tile_fraction * this%sw_albedo_direct(:,iground,jcol)
+              single_level%sw_albedo(jcol,:) = single_level%sw_albedo(jcol,:) &
+                   &  + tile_fraction * this%sw_albedo_diffuse(:,iground,jcol)
+
+            case (ITileVegetation)
+              ! HORIZONTALLY HOMOGENEOUS VEGETATION CANOPY WITH
+              ! SELLERS-LIKE FORMULATION
+
+              iground = surface%i_ground_facet(jcol,jtile)
+              iregion = surface%i_region_1(jcol,jtile)
+
+              ! Shortwave calculation
+              if (present(ext_sw_air)) then
+                od_sw_air = surface%canopy_depth(jcol,jtile)*ext_sw_air(:,jcol)
+                od_sw_region = od_sw_air + surface%vegetation_optical_depth(jcol,jtile)
+                ssa_sw_region= (ssa_sw_air(:,jcol)*od_sw_air &
+                     &          + surface%vegetation_optical_depth(jcol,jtile) &
+                     &            * surface%vegetation_sw_albedo(jcol,:,jtile)) &
+                     &       / od_sw_region
+                ! Assume asymmetry factor of vegetation is zero
+                g_sw_region = g_sw_air(:,jcol)*ssa_sw_air(:,jcol)*od_sw_air &
+                     &  / (ssa_sw_region*od_sw_region)
+              else
+                od_sw_region = surface%vegetation_optical_depth(jcol,jtile)
+                ssa_sw_region= surface%vegetation_sw_albedo(jcol,:,jtile)
+                g_sw_region  = 0.0_jprb
+              end if
+              call calc_two_stream_gammas_sw(this%nswbands, &
+                   &  cos_sza, ssa_sw_region, g_sw_region, &
+                   &  gamma1_sw, gamma2_sw, gamma3_sw)
+              call calc_reflectance_transmittance_sw(this%nswbands, &
+                   &  cos_sza, od_sw_region, ssa_sw_region, &
+                   &  gamma1_sw, gamma2_sw, gamma3_sw, &
+                   &  this%sw_ref_dif(:,iregion,jcol), this%sw_tra_dif(:,iregion,jcol), &
+                   &  this%sw_ref_dir(:,iregion,jcol), this%sw_tra_dir_dif(:,iregion,jcol), &
+                   &  this%sw_tra_dir_dir(:,iregion,jcol))
+
+              ! Shortwave adding method for a single layer
+              inv_denominator_sw(:) = 1.0_jprb &
+                   &  / (1.0_jprb - this%sw_albedo_diffuse(:,iground,jcol) & 
+                   &               *this%sw_ref_dif(:,iregion,jcol))
+              this%sw_albedo_diffuse_reg(:,iregion,jcol) = this%sw_ref_dif(:,iregion,jcol) &
+                   &  + this%sw_tra_dif(:,iregion,jcol)**2 &
+                   &  * this%sw_albedo_diffuse(:,iground,jcol) * inv_denominator_sw(:)
+              this%sw_albedo_direct_reg(:,iregion,jcol) = this%sw_ref_dir(:,iregion,jcol) &
+                   &     + (this%sw_tra_dir_dir(:,iregion,jcol)*this%sw_albedo_direct (:,iground,jcol) &
+                   &       +this%sw_tra_dir_dif(:,iregion,jcol)*this%sw_albedo_diffuse(:,iground,jcol)) &
+                   &     * this%sw_tra_dif(:,iregion,jcol) * inv_denominator_sw(:)
+              single_level%sw_albedo(jcol,:) = single_level%sw_albedo(jcol,:) &
+                   &  + tile_fraction * this%sw_albedo_diffuse_reg(:,iregion,jcol)
+              single_level%sw_albedo_direct(jcol,:) = single_level%sw_albedo_direct(jcol,:) &
+                   &  + tile_fraction * this%sw_albedo_direct_reg(:,iregion,jcol)
+
+            case (ITileUrban3D)
+              ! URBAN CANOPY WITH NO VEGETATION, TREATED USING
+              ! SPARTACUS METHODOLOGY
+
+              iground  = surface%i_ground_facet(jcol,jtile)
+              iwall    = surface%i_wall_facet(jcol,jtile)
+              iroof    = surface%i_roof_facet(jcol,jtile)
+              iregion = surface%i_region_1(jcol,jtile)
+
+              canyon_fraction = 1.0_jprb - surface%building_fraction(jcol,jtile)
+
+              fdiff = 0.5_jprb * surface%building_normalized_perimeter(jcol,jtile) / canyon_fraction
+
+              tan_sza = sqrt(1.0_jprb / (cos_sza*cos_sza) - 1.0_jprb)
+              fdir  = surface%building_normalized_perimeter(jcol,jtile) * tan_sza / (Pi * canyon_fraction)
+
+              if (present(ext_sw_air)) then
+                ext_sw_region = ext_sw_air(:,jcol)
+                ssa_sw_region = ssa_sw_air(:,jcol)
+                g_sw_region   = g_sw_air(:,jcol)
+              else
+                ext_sw_region = 0.0_jprb
+                ssa_sw_region = 0.0_jprb
+                g_sw_region   = 0.0_jprb
+              end if
+
+              ! Get gammas for atmosphere only
+              call calc_two_stream_gammas_sw(this%nswbands, &
+                   &  cos_sza, ssa_sw_region, g_sw_region, &
+                   &  gamma1_sw, gamma2_sw, gamma3_sw)
+
+              ! At this point gamma1_sw-gamma2_sw is the rate of
+              ! absorption per unit optical depth of the air in the
+              ! canyon
+              this%sw_wall_abs_frac_dif(:,iregion,jcol) &
+                   &  = fdiff * (1.0_jprb - this%sw_albedo_diffuse(:,iwall,jcol))
+              this%sw_wall_abs_frac_dif(:,iregion,jcol) = this%sw_wall_abs_frac_dif(:,iregion,jcol) &
+                   &  / max(1.0e-8_jprb,ext_sw_region*(gamma1_sw-gamma2_sw) &
+                   &                    + this%sw_wall_abs_frac_dif(:,iregion,jcol))
+
+              gamma4_sw = 1.0_jprb - gamma3_sw
+              gamma0_sw = ext_sw_region / cos_sza + fdir
+              gamma1_sw = ext_sw_region * gamma1_sw &
+                   &    + fdiff * (1.0_jprb - 0.5_jprb*this%sw_albedo_diffuse(:,iwall,jcol))
+              gamma2_sw = ext_sw_region * gamma2_sw &
+                   &    + fdiff * 0.5_jprb*this%sw_albedo_diffuse(:,iwall,jcol)
+              gamma3_sw = ext_sw_region * ssa_sw_region * gamma3_sw &
+                   &    + 0.5_jprb * fdir * this%sw_albedo_direct(:,iwall,jcol)
+              gamma4_sw = ext_sw_region * ssa_sw_region * gamma4_sw &
+                   &    + 0.5_jprb * fdir * this%sw_albedo_direct(:,iwall,jcol)
+
+              call calc_reflectance_transmittance_z_sw(this%nswbands, &
+                   &  cos_sza, surface%canopy_depth(jcol,jtile), gamma0_sw, &
+                   &  gamma1_sw, gamma2_sw, gamma3_sw, gamma3_sw, &
+                   &  this%sw_ref_dif(:,iregion,jcol), this%sw_tra_dif(:,iregion,jcol), &
+                   &  this%sw_ref_dir(:,iregion,jcol), this%sw_tra_dir_dif(:,iregion,jcol), &
+                   &  this%sw_tra_dir_dir(:,iregion,jcol))
+
+              ! Compute fraction of direct at canyon top that is absorbed by wall and air
+              this%sw_wall_abs_dir(:,iregion,jcol) &
+                   &  = (1.0_jprb - this%sw_tra_dir_dir(:,iregion,jcol)) &
+                   &  * fdir * (1.0_jprb - this%sw_albedo_direct(:,iwall,jcol)) * cos_sza &
+                   &  /  max(1.0e-8_jprb, fdir*cos_sza + ext_sw_region)
+              this%sw_air_abs_dir(:,iregion,jcol)&
+                   &  = (1.0_jprb - this%sw_tra_dir_dir(:,iregion,jcol)) &
+                   &  * ext_sw_region * (1.0_jprb - ssa_sw_region) &
+                   &  /  max(1.0e-8_jprb, fdir*cos_sza + ext_sw_region)
+
+              ! Add roof component
+              single_level%sw_albedo(jcol,:) = single_level%sw_albedo(jcol,:) &
+                   &  + tile_fraction * surface%building_fraction(jcol,jtile) &
+                   &  * this%sw_albedo_diffuse(:,iroof,jcol)
+              single_level%sw_albedo_direct(jcol,:) = single_level%sw_albedo_direct(jcol,:) &
+                   &  + tile_fraction * surface%building_fraction(jcol,jtile) &
+                   &  * this%sw_albedo_direct(:,iroof,jcol)
+
+              ! Add canyon component using shortwave adding method for a single layer
+              inv_denominator_sw(:) = 1.0_jprb &
+                   &  / (1.0_jprb - this%sw_albedo_diffuse(:,iground,jcol) & 
+                   &               *this%sw_ref_dif(:,iregion,jcol))
+              this%sw_albedo_diffuse_reg(:,iregion,jcol) = this%sw_ref_dif(:,iregion,jcol) &
+                   &  + this%sw_tra_dif(:,iregion,jcol)**2 &
+                   &  * this%sw_albedo_diffuse(:,iground,jcol) * inv_denominator_sw(:)
+              this%sw_albedo_direct_reg(:,iregion,jcol) = this%sw_ref_dir(:,iregion,jcol) &
+                   &     + (this%sw_tra_dir_dir(:,iregion,jcol)*this%sw_albedo_direct (:,iground,jcol) &
+                   &       +this%sw_tra_dir_dif(:,iregion,jcol)*this%sw_albedo_diffuse(:,iground,jcol)) &
+                   &     * this%sw_tra_dif(:,iregion,jcol) * inv_denominator_sw(:)
+              single_level%sw_albedo(jcol,:) = single_level%sw_albedo(jcol,:) &
+                   &  + tile_fraction * canyon_fraction * this%sw_albedo_diffuse_reg(:,iregion,jcol)
+              single_level%sw_albedo_direct(jcol,:) = single_level%sw_albedo_direct(jcol,:) &
+                   &  + tile_fraction * canyon_fraction * this%sw_albedo_direct_reg(:,iregion,jcol)
+
+            end select
+          end if
+        end do
+      end do
+    end if
+
+    if (lhook) call dr_hook('radsurf_intermediate:calc_boundary_conditions_sw',1,hook_handle)
+
+  end subroutine calc_boundary_conditions_sw
+
+
+  !---------------------------------------------------------------------
+  ! As calc_boundary_conditions_sw, but for the longwave.
+  subroutine calc_boundary_conditions_lw(this, istartcol, iendcol, &   ! in
+       &  config, surface, &                    ! in
+       &  single_level, &                                 ! out
+       &  ext_lw_air, ssa_lw_air, g_lw_air)               ! in, optional
+
+    use yomhook,                only : lhook, dr_hook
+
+    use radiation_io,           only : nulerr, radiation_abort
+    use radiation_config,       only : config_type
+    use radiation_single_level, only : single_level_type
+    use radsurf_properties,     only : surface_type, ITileFlat,ITileVegetation,ITileUrban3D
+    use radiation_two_stream,   only : calc_two_stream_gammas_lw, &
+         &                             calc_reflectance_transmittance_isothermal_lw, &
+         &                             LwDiffusivity
+    use radiation_ifs_rrtm,     only : planck_function
+    use radiation_constants,    only: Pi, GasConstantDryAir, AccelDueToGravity, StefanBoltzmann
+
+    class(surface_intermediate_type), intent(inout) :: this
+    integer(kind=jpim),               intent(in)    :: istartcol, iendcol
+    type(config_type),                intent(in)    :: config
+    type(surface_type),               intent(in)    :: surface
+    type(single_level_type),          intent(inout) :: single_level
+
+    ! Input properties of the air in the lowest model level:
+    ! extinction coefficient (m-1), single-scattering albedo and
+    ! asymmetry factor
+    real(kind=jprb), intent(in), dimension(config%n_g_lw,istartcol:iendcol), optional &
+         &  :: ext_lw_air, ssa_lw_air, g_lw_air
+
+    ! Longwave region properties
+    real(kind=jprb), dimension(this%nlwbands) :: od_lw_region, ssa_lw_region, g_lw_region
+
+    ! Optical depth of air
+    real(kind=jprb), dimension(this%nlwbands) :: od_lw_air
+
+    ! Effective Planck function of urban canopy as a weighted average
+    ! of wall and air emission
+    real(kind=jprb), dimension(this%nlwbands) :: planck_canopy
+
+    ! Vegetation emissivity using local spectral representation
+    real(kind=jprb), dimension(this%nlwbands) :: vegetation_lw_emissivity
+
+    real(kind=jprb)    :: tile_fraction
+
+    ! Exchange coefficient (m-1) for diffuse radiation into building
+    ! walls, multiplied by canyon depth (m) to get a dimensionless
+    ! analogue for optical depth
+    real(kind=jprb)    :: od_lw_wall
+
+    ! One minus the building fraction
+    real(kind=jprb)    :: canyon_fraction
+
+    ! Two-stream coefficients
+    real(jprb), dimension(this%nlwbands) :: gamma1_lw, gamma2_lw
+
+    real(jprb), dimension(this%nlwbands) :: inv_denominator_lw
+
+    integer(kind=jpim) :: jcol,jtile,jfacet,iregion
+
+    ! Indices to different facets
+    integer(kind=jpim) :: iground, iwall, iroof
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radsurf_intermediate:calc_boundary_conditions_lw',0,hook_handle)
+
+    if (present(ssa_lw_air)) then
+      if (.not. present(g_lw_air)) then
+        write(nulerr,'(a)') '*** Error: if ssa_lw_air is provided then g_lw_air must also be provided'
+        call radiation_abort()
+      end if
+    end if
+
+    if (size(single_level%lw_emissivity,2) /= this%nlwbands) then
+      write(nulerr,'(a,i0,a,i0)') '*** Error: single-level emissivity has ', &
+           &  size(single_level%lw_emissivity,2), ' bands, needs ', this%nlwbands
+      call radiation_abort()
+    end if
+
+    ! FIX: This section ought to check what tiles are present in each column
+    if (config%use_canopy_full_spectrum_lw) then
+      ! Put longwave emissivity on g-point grid and permute      
+      do jcol = istartcol,iendcol
+        this%lw_emissivity(:,:,jcol) = surface%lw_emissivity(jcol,config%i_emiss_from_band_lw( &
+             &                           config%i_band_from_reordered_g_lw),:)
+      end do
+      ! Compute Planck function at each facet
+      do jfacet = 1,surface%nfacet
+        do jcol = istartcol,iendcol
+          ! FIX this function assumes contiguous data for planck_facet
+          ! so copies into a temporary
+          call planck_function(config, &
+               &  surface%skin_temperature(jcol,jfacet), &
+               &  this%planck_facet(:,jfacet,jcol))
+        end do
+      end do
+      do jtile = 1,surface%ntile
+        do jcol = istartcol,iendcol
+          iregion = surface%i_region_1(jcol,jtile)
+          if (iregion > 0) then
+            call planck_function(config, &
+                 &  surface%canopy_temperature(jcol,jtile), &
+                 &  this%planck_region(:,iregion,jcol:jcol))
+          end if
+        end do
+      end do
+    else
+      if (surface%nemissbands /= 1) then
+        write(nulerr,'(a)') '*** Error: insufficient information to compute Planck function in emissivity bands'
+        call radiation_abort()
+      end if
+      do jcol = istartcol,iendcol
+        ! No change to spectral resolution: simply permute
+        this%lw_emissivity(:,:,jcol) = surface%lw_emissivity(jcol,:,:)
+      end do
+      ! Broadband calculation: Stefan-Boltzmann law
+      do jfacet = 1,surface%nfacet
+        this%planck_facet(1,jfacet,istartcol:iendcol) &
+             &  = StefanBoltzmann*surface%skin_temperature(istartcol:iendcol,jfacet)**4
+      end do
+      do jtile = 1,surface%ntile
+        do jcol = istartcol,iendcol
+          iregion = surface%i_region_1(jcol,jtile)
+          if (iregion > 0) then
+            this%planck_region(1,iregion,jcol) &
+                 &  = StefanBoltzmann*surface%canopy_temperature(jcol,jtile)
+          end if
+        end do
+      end do
+    end if
+
+    if (surface%is_simple) then
+      ! We have a "traditional" representation: one flat tile
+      single_level%lw_emissivity(istartcol:iendcol,:) &
+           &  = transpose(this%lw_emissivity(:,1,istartcol:iendcol))
+      single_level%lw_emission(istartcol:iendcol,:) &
+           &  = transpose(this%planck_facet(:,1,istartcol:iendcol) &
+           &              * this%lw_emissivity(:,1,istartcol:iendcol))
+
+    else
+      ! More complex description of surface
+
+      ! Firstly initialize outputs to zero
+      single_level%lw_emissivity(istartcol:iendcol,:) = 0.0_jprb
+      single_level%lw_emission  (istartcol:iendcol,:) = 0.0_jprb
+
+      ! Loop over column and tile
+      do jcol = istartcol,iendcol
+
+        do jtile = 1,surface%ntile
+          tile_fraction = surface%tile_fraction(jcol,jtile)
+
+          if (tile_fraction > 0.0_jprb) then
+
+            select case (surface%i_representation(jtile))
+            case (ITileFlat)
+              ! SIMPLE FLAT TILE
+
+              ! Add the contribution from this simple flat tile to the
+              ! accumulated values for the column
+              iground = surface%i_ground_facet(jcol,jtile)
+              single_level%lw_emissivity(jcol,:) = single_level%lw_emissivity(jcol,:) &
+                   &  + tile_fraction*this%lw_emissivity(:,iground,jcol)
+              single_level%lw_emission(jcol,:) = single_level%lw_emission(jcol,:) + tile_fraction &
+                   &  * (this%planck_facet(:,iground,jcol)*this%lw_emissivity(:,iground,jcol))
+
+            case (ITileVegetation)
+              ! HORIZONTALLY HOMOGENEOUS VEGETATION CANOPY
+
+              iground  = surface%i_ground_facet(jcol,jtile)
+              iregion = surface%i_region_1(jcol,jtile)
+
+              ! Convert vegetation emissivity to local spectral representation
+              if (config%use_canopy_full_spectrum_lw) then
+                vegetation_lw_emissivity = surface%vegetation_lw_emissivity(jcol, &
+                     &  config%i_emiss_from_band_lw(config%i_band_from_reordered_g_lw), &
+                     &  jtile)
+              else
+                vegetation_lw_emissivity = surface%vegetation_lw_emissivity(jcol,:,jtile)
+              end if
+
+              if (present(ext_lw_air)) then
+                od_lw_air = surface%canopy_depth(jcol,jtile)*ext_lw_air(:,jcol)
+                od_lw_region = od_lw_air + surface%vegetation_optical_depth(jcol,jtile)
+                if (present(ssa_lw_air)) then
+                  ssa_lw_region= (ssa_lw_air(:,jcol)*od_lw_air &
+                       &          + surface%vegetation_optical_depth(jcol,jtile) &
+                       &            * (1.0_jprb-vegetation_lw_emissivity)) &
+                       &       / od_lw_region
+                  ! Assume asymmetry factor of vegetation is zero
+                  g_lw_region = g_lw_air(:,jcol)*ssa_lw_air(:,jcol)*od_lw_air &
+                       &  / (ssa_lw_region * od_lw_region)
+                else
+                  ! No longwave scattering properties for air
+                  ssa_lw_region= surface%vegetation_optical_depth(jcol,jtile) &
+                       &            * (1.0_jprb-vegetation_lw_emissivity) &
+                       &       / od_lw_region
+                  ! Assume asymmetry factor of vegetation is zero
+                  g_lw_region = 0.0_jprb
+
+                end if
+              else
+                ! No gases
+                od_lw_region = surface%vegetation_optical_depth(jcol,jtile)
+                ssa_lw_region= 1.0_jprb-vegetation_lw_emissivity
+                g_lw_region  = 0.0_jprb
+              end if
+
+              call calc_two_stream_gammas_lw(this%nlwbands, &
+                   &  ssa_lw_region, g_lw_region, &
+                   &  gamma1_lw, gamma2_lw)
+              call calc_reflectance_transmittance_isothermal_lw(this%nlwbands, &
+                   &  od_lw_region, gamma1_lw, gamma2_lw, this%planck_region(:,iregion,jcol), &
+                   &  this%lw_reflectance(:,iregion,jcol), this%lw_transmittance(:,iregion,jcol), &
+                   &  this%lw_source(:,iregion,jcol))
+              
+              ! Longwave adding method for a single layer
+              inv_denominator_lw(:) = 1.0_jprb &
+                   &  / (1.0_jprb - (1.0_jprb - this%lw_emissivity(:,iground,jcol)) &
+                   &               *this%lw_reflectance(:,iregion,jcol))
+              single_level%lw_emissivity(jcol,:) = single_level%lw_emissivity(jcol,:) &
+                   &  + tile_fraction * (1.0_jprb - (this%lw_reflectance(:,iregion,jcol) &
+                   &  + this%lw_transmittance(:,iregion,jcol)**2 &
+                   &  * (1.0_jprb - this%lw_emissivity(:,iground,jcol)) * inv_denominator_lw(:)))
+              single_level%lw_emission(jcol,:) = single_level%lw_emission(jcol,:) + tile_fraction &
+                   &  * (this%lw_source(:,iregion,jcol) * (1.0_jprb + inv_denominator_lw(:) &
+                   &       * (1.0_jprb - this%lw_emissivity(:,iground,jcol)) &
+                   &       * this%lw_transmittance(:,iregion,jcol)) &
+                   &     +this%planck_facet(:,iground,jcol)*this%lw_emissivity(:,iground,jcol) &
+                   &     *this%lw_transmittance(:,iregion,jcol)*inv_denominator_lw(:))
+
+            case (ITileUrban3D)
+              ! URBAN CANOPY WITH NO VEGETATION, TREATED USING
+              ! SPARTACUS METHODOLOGY
+
+              iground  = surface%i_ground_facet(jcol,jtile)
+              iwall    = surface%i_wall_facet(jcol,jtile)
+              iroof    = surface%i_roof_facet(jcol,jtile)
+              iregion  = surface%i_region_1(jcol,jtile)
+
+              canyon_fraction = 1.0_jprb - surface%building_fraction(jcol,jtile)
+
+              ! fdiff woould be 0.5 * building_normalized_perimeter /
+              ! canyon_fraction, but to get equivalent zenith optical
+              ! depth we multiply by the building height and divide by
+              ! the longwave diffusivity angle
+!              od_lw_wall = 0.5_jprb * surface%building_normalized_perimeter(jcol,jtile) &
+!                   &     * surface%canopy_depth(jcol,jtile) / (LwDiffusivity * canyon_fraction)
+
+              ! Or first compute H/W
+              od_lw_wall = 0.5_jprb * surface%building_normalized_perimeter(jcol,jtile) &
+                   &     * surface%canopy_depth(jcol,jtile) / canyon_fraction
+              ! And then use the Harman et al. (2004) formula for
+              ! street-to-sky transmittance T=sqrt[(H/W)^2+1]-H/W, to
+              ! compute equivalent optical depth knowing that the
+              ! two-stream scheme treatment will be T=exp(-D*od)
+              od_lw_wall = -log(sqrt(od_lw_wall*od_lw_wall + 1) - od_lw_wall) / LwDiffusivity
+
+              if (present(ext_lw_air)) then
+                od_lw_air     = ext_lw_air(:,jcol)*surface%canopy_depth(jcol,jtile) !*10.0_jprb
+                od_lw_region  = od_lw_air + od_lw_wall
+                if (present(ssa_lw_air)) then
+                  ssa_lw_region = (od_lw_air * ssa_lw_air(:,jcol) &
+                       &    + od_lw_wall * (1.0_jprb - this%lw_emissivity(:,iwall,jcol))) &
+                       &               / max(od_lw_region,1.0e-6_jprb)
+                  ! We assume that any scattering off the walls is
+                  ! equally likely to be up or down, so the effective
+                  ! asymmetry factor is zero
+                  g_lw_region = (od_lw_air * ssa_lw_air(:,jcol)*g_lw_air(:,jcol)) &
+                       &      / max(od_lw_region*ssa_lw_region,1.0e-6_jprb)
+                  ! Effective Planck function of the canopy is the
+                  ! weighted average of wall and air emission
+                  this%lw_total_wall_emission(:,iregion,jcol) = LwDiffusivity &
+                       &  * od_lw_wall*this%lw_emissivity(:,iwall,jcol)*this%planck_facet(:,iwall,jcol)
+                  this%lw_total_canopy_emission(:,iregion,jcol) = LwDiffusivity &
+                       &  * od_lw_air*(1.0_jprb-ssa_lw_air(:,jcol))*this%planck_region(:,iregion,jcol)
+                  planck_canopy = (this%lw_total_wall_emission(:,iregion,jcol) &
+                       &           +this%lw_total_canopy_emission(:,iregion,jcol)) &
+                       &        / max(od_lw_region*(1.0_jprb-ssa_lw_region)*LwDiffusivity,1.0e-6_jprb)
+                else
+                  ssa_lw_region = od_lw_wall * (1.0_jprb - this%lw_emissivity(:,iwall,jcol)) &
+                       &        / max(od_lw_region,1.0e-6_jprb)
+                  ! We assume that any scattering off the walls is
+                  ! equally likely to be up or down, so the effective
+                  ! asymmetry factor is zero
+                  g_lw_region = 0.0_jprb
+                  ! Effective Planck function of the canopy is the
+                  ! weighted average of wall and air emission
+                  this%lw_total_wall_emission(:,iregion,jcol) = LwDiffusivity &
+                       &  * od_lw_wall*this%lw_emissivity(:,iwall,jcol)*this%planck_facet(:,iwall,jcol)
+                  this%lw_total_canopy_emission(:,iregion,jcol) = LwDiffusivity &
+                       &  * od_lw_air*this%planck_region(:,iregion,jcol)
+                  planck_canopy = (this%lw_total_wall_emission(:,iregion,jcol) &
+                       &           +this%lw_total_canopy_emission(:,iregion,jcol)) &
+                       &        / max(od_lw_region*(1.0_jprb-ssa_lw_region)*LwDiffusivity,1.0e-6_jprb)
+                end if
+
+                ! Compute fraction of canyon absorption by the wall 
+                this%lw_wall_abs_frac(:,iregion,jcol) = od_lw_wall * this%lw_emissivity(:,iwall,jcol) &
+                     &    / max(od_lw_region*(1.0_jprb-ssa_lw_region),1.0e-6_jprb)
+
+
+              else
+                od_lw_region  = od_lw_wall
+                ssa_lw_region = 1.0_jprb - this%lw_emissivity(:,iwall,jcol);
+                g_lw_region   = 0.0_jprb
+
+                ! All absorption and emission is by the wall
+                this%lw_wall_abs_frac(:,iregion,jcol) = 1.0_jprb
+                this%lw_total_wall_emission(:,iregion,jcol) = LwDiffusivity &
+                     &  * od_lw_wall*this%lw_emissivity(:,iwall,jcol)*this%planck_facet(:,iwall,jcol)
+                this%lw_total_canopy_emission(:,iregion,jcol) = 0.0_jprb
+                planck_canopy = this%planck_facet(:,iwall,jcol)
+              end if
+
+              call calc_two_stream_gammas_lw(this%nlwbands, &
+                   &  ssa_lw_region, g_lw_region, &
+                   &  gamma1_lw, gamma2_lw)
+              call calc_reflectance_transmittance_isothermal_lw(this%nlwbands, &
+                   &  od_lw_region, gamma1_lw, gamma2_lw, planck_canopy, &
+                   &  this%lw_reflectance(:,iregion,jcol), this%lw_transmittance(:,iregion,jcol), &
+                   &  this%lw_source(:,iregion,jcol))
+
+              ! Add roof component
+              single_level%lw_emissivity(jcol,:) = single_level%lw_emissivity(jcol,:) &
+                   &  + tile_fraction * surface%building_fraction(jcol,jtile) &
+                   &  * this%lw_emissivity(:,iroof,jcol)
+              single_level%lw_emission(jcol,:) = single_level%lw_emission(jcol,:) &
+                   &  + tile_fraction * surface%building_fraction(jcol,jtile) &
+                   &  * this%lw_emissivity(:,iroof,jcol)*this%planck_facet(:,iroof,jcol)
+              
+              ! Add canyon component: longwave adding method for a single layer
+              inv_denominator_lw(:) = 1.0_jprb &
+                   &  / (1.0_jprb - (1.0_jprb - this%lw_emissivity(:,iground,jcol)) &
+                   &               *this%lw_reflectance(:,iregion,jcol))
+              this%lw_emissivity_region(:,iregion,jcol) &
+                   &  = (1.0_jprb - (this%lw_reflectance(:,iregion,jcol) &
+                   &  + this%lw_transmittance(:,iregion,jcol)**2 &
+                   &  * (1.0_jprb - this%lw_emissivity(:,iground,jcol)) * inv_denominator_lw(:)))
+              single_level%lw_emissivity(jcol,:) = single_level%lw_emissivity(jcol,:) &
+                   &  + tile_fraction * canyon_fraction * this%lw_emissivity_region(:,iregion,jcol) 
+              this%lw_emission_region(:,iregion,jcol) &
+                   &  = this%lw_source(:,iregion,jcol) * (1.0_jprb + inv_denominator_lw(:) &
+                   &       * (1.0_jprb - this%lw_emissivity(:,iground,jcol)) &
+                   &       * this%lw_transmittance(:,iregion,jcol)) &
+                   &     +this%planck_facet(:,iground,jcol)*this%lw_emissivity(:,iground,jcol) &
+                   &     *this%lw_transmittance(:,iregion,jcol)*inv_denominator_lw(:)
+              single_level%lw_emission(jcol,:) = single_level%lw_emission(jcol,:) &
+                   &  + tile_fraction * canyon_fraction * this%lw_emission_region(:,iregion,jcol)
+
+            end select
+          end if
+        end do
+      end do
+    end if
+
+    if (lhook) call dr_hook('radsurf_intermediate:calc_boundary_conditions_lw',1,hook_handle)
+
+  end subroutine calc_boundary_conditions_lw
+
+
+  !---------------------------------------------------------------------
+  ! Compute both shortwave and longwave boundary conditions neglecting
+  ! gases within vegetation and urban canopies
+  subroutine calc_boundary_conditions_vacuum(this, istartcol, iendcol, &   ! in
+       &                              config, surface,          &   ! in
+       &                              single_level)                 ! out
+
+    use radiation_config,       only : config_type
+    use radiation_single_level, only : single_level_type
+    use radsurf_properties,     only : surface_type
+
+    class(surface_intermediate_type), intent(inout) :: this
+    integer(kind=jpim),               intent(in)    :: istartcol, iendcol
+    type(config_type),                intent(in)    :: config
+    type(surface_type),               intent(in)    :: surface
+    type(single_level_type),          intent(inout) :: single_level
+
+    call this%calc_boundary_conditions_sw(istartcol, iendcol, &
+         &                                config, surface, single_level)
+    call this%calc_boundary_conditions_lw(istartcol, iendcol, &
+         &                                config, surface, single_level)
+
+  end subroutine calc_boundary_conditions_vacuum
+
+
+  !---------------------------------------------------------------------
+  ! Compute both shortwave and longwave boundary conditions
+  subroutine calc_boundary_conditions(this, istartcol, iendcol, &   ! in
+       &                              config, surface,          &   ! in
+       &                              thermodynamics, gas,      &   ! in
+       &                              single_level)                 ! out
+
+    use radiation_config,       only : config_type
+    use radiation_thermodynamics,only: thermodynamics_type
+    use radiation_gas,          only : gas_type
+    use radiation_single_level, only : single_level_type
+    use radiation_ifs_rrtm,     only : gas_optics
+    use radsurf_properties,     only : surface_type
+    use radiation_constants,    only : GasConstantDryAir, &
+         &                             AccelDueToGravity
+
+    class(surface_intermediate_type), intent(inout) :: this
+    integer(kind=jpim),               intent(in)    :: istartcol, iendcol
+    type(config_type),                intent(in)    :: config
+    type(surface_type),               intent(in)    :: surface
+    type(gas_type),                   intent(in)    :: gas
+    type(thermodynamics_type),        intent(in)    :: thermodynamics
+    type(single_level_type),          intent(inout) :: single_level
+
+    ! Ratio of gas constant for dry air to acceleration due to gravity
+    real(jprb), parameter :: R_over_g = GasConstantDryAir / AccelDueToGravity
+
+    ! Number of leves to request gas optical depths for; we only need
+    ! one but gas optics scheme assumes more
+    integer, parameter :: NGasLevels = 1
+
+    ! Canopy longwave optical depth
+    real(jprb), dimension(config%n_g_lw,NGasLevels,istartcol:iendcol) :: od_lw
+
+    ! Canopy longwave extinction coefficient
+    real(jprb), dimension(config%n_g_lw,istartcol:iendcol) :: ext_lw
+
+    ! Canopy shortwave optical depth, single scattering albedo and
+    ! asymmetry factor of gases and aerosols at each shortwave g-point
+    real(jprb), dimension(config%n_g_sw,NGasLevels,istartcol:iendcol) :: od_sw, ssa_sw, g_sw
+
+    ! Thickness of lowest model level
+    real(jprb) :: layer_depth
+
+    ! Index to final level of full model grid
+    integer :: iendlev
+
+    ! Column loop counter, number of columns
+    integer :: jcol, ncol
+
+    ncol    = ubound(thermodynamics%pressure_hl,1)
+    iendlev = ubound(thermodynamics%pressure_hl,2)-1
+
+    call gas_optics(ncol, NGasLevels, istartcol, iendcol, &
+         &  config, single_level, thermodynamics, gas, & 
+         &  od_lw, od_sw, ssa_sw)
+
+    ! Scale optical depths to extinction
+    do jcol = istartcol,iendcol
+      layer_depth = R_over_g &
+             &  * (thermodynamics%pressure_hl(jcol,iendlev+1) &
+             &     - thermodynamics%pressure_hl(jcol,iendlev)) &
+             &  * (thermodynamics%temperature_hl(jcol,iendlev) &
+             &     + thermodynamics%temperature_hl(jcol,iendlev+1)) &
+             &  / (thermodynamics%pressure_hl(jcol,iendlev) &
+             &     + thermodynamics%pressure_hl(jcol,iendlev+1))
+      !if (config%do_sw) then
+      !  ext_sw(jcol) = ext_sw(jcol) / layer_depth
+      !end if
+      if (config%do_lw) then
+        ext_lw(:,jcol) = od_lw(:,NGasLevels,jcol) / layer_depth
+      end if
+    end do
+
+    call this%calc_boundary_conditions_sw(istartcol, iendcol, &
+         &                                config, surface, single_level)
+    if (config%do_canopy_gases_lw) then
+      call this%calc_boundary_conditions_lw(istartcol, iendcol, &
+           &                                config, surface, single_level, &
+           &                                ext_lw_air=ext_lw)
+    else
+      call this%calc_boundary_conditions_lw(istartcol, iendcol, &
+           &                                config, surface, single_level)
+    end if
+
+  end subroutine calc_boundary_conditions
+
+
+  !---------------------------------------------------------------------
+  subroutine partition_fluxes(this, istartcol, iendcol, config, surface, flux, &
+       &                      surface_flux)
+
+    use yomhook,           only : lhook, dr_hook
+
+    use radiation_flux,    only : flux_type
+    use radsurf_flux,      only : surface_flux_type
+    use radiation_config,  only : config_type
+    use radsurf_properties,only : surface_type, ITileFlat,ITileVegetation,ITileUrban3D
+
+    class(surface_intermediate_type), intent(in)    :: this
+    integer(kind=jpim),               intent(in)    :: istartcol, iendcol
+    type(config_type),                intent(in)    :: config
+    type(surface_type),               intent(in)    :: surface
+    type(flux_type),                  intent(in)    :: flux
+    type(surface_flux_type),          intent(inout) :: surface_flux
+
+    real(kind=jprb), dimension(config%n_g_lw)       :: lw_dn_g, lw_up_g
+    real(kind=jprb), dimension(config%n_canopy_bands_sw) &
+         &  :: sw_dn_diffuse_g, sw_dn_direct_g, sw_up_g, sw_abs_g
+    real(kind=jprb), dimension(config%n_canopy_bands_lw) :: lw_abs_g
+
+    ! Ratio of street planar area to wall frontal area
+    real(kind=jprb)    :: wall_scaling
+
+    real(kind=jprb)    :: tile_fraction
+    integer(kind=jpim) :: iground, iroof, iwall, iregion
+    integer(kind=jpim) :: isurf ! index to lowest flux level (=nlev+1)
+    integer(kind=jpim) :: jcol, jtile
+
+    real(kind=jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radsurf_intermediate:partition_fluxes',0,hook_handle)
+
+    if (.not. surface%is_simple) then
+      isurf = size(flux%lw_dn,2)
+
+      if (config%do_lw) then
+        surface_flux%lw_dn_facet(istartcol:iendcol,:) = 0.0_jprb
+        surface_flux%lw_up_facet(istartcol:iendcol,:) = 0.0_jprb
+        surface_flux%lw_abs_canopy(istartcol:iendcol,:)=0.0_jprb
+      end if
+      if (config%do_sw) then
+        surface_flux%sw_dn_facet(istartcol:iendcol,:) = 0.0_jprb
+        surface_flux%sw_dn_direct_facet(istartcol:iendcol,:) = 0.0_jprb
+        surface_flux%sw_up_facet(istartcol:iendcol,:) = 0.0_jprb
+        surface_flux%sw_abs_canopy(istartcol:iendcol,:)=0.0_jprb
+      end if
+
+      ! Loop over column and tile
+      do jcol = istartcol,iendcol
+        do jtile = 1,surface%ntile
+          tile_fraction = surface%tile_fraction(jcol,jtile)
+
+          if (tile_fraction > 0.0_jprb) then
+
+            select case (surface%i_representation(jtile))
+            case (ITileFlat)
+              iground = surface%i_ground_facet(jcol,jtile)
+              if (config%do_lw) then
+                surface_flux%lw_dn_facet(jcol,iground) = flux%lw_dn(jcol,isurf)
+                surface_flux%lw_up_facet(jcol,iground) &
+                     &  = sum(this%lw_emissivity(:,iground,jcol)*this%planck_facet(:,iground,jcol) &
+                     &        + (1.0_jprb - this%lw_emissivity(:,iground,jcol)) &
+                     &        * flux%lw_dn_surf_canopy(:,jcol))
+              end if
+              if (config%do_sw) then
+                surface_flux%sw_dn_facet(jcol,iground)        = flux%sw_dn(jcol,isurf)
+                surface_flux%sw_dn_direct_facet(jcol,iground) = flux%sw_dn_direct(jcol,isurf)
+                surface_flux%sw_up_facet(jcol,iground) &
+                     & = sum(this%sw_albedo_diffuse(:,iground,jcol) &
+                     &       * flux%sw_dn_diffuse_surf_canopy(:,jcol) &
+                     &       + this%sw_albedo_direct (:,iground,jcol) &
+                     &       * flux%sw_dn_direct_surf_canopy (:,jcol))
+              end if
+
+            case (ITileVegetation)
+              iground  = surface%i_ground_facet(jcol,jtile)
+              iregion = surface%i_region_1(jcol,jtile)
+              ! Adding method in longwave and shortwave
+              if (config%do_lw) then
+                ! Surface downwelling fluxes at each g point
+                lw_dn_g = (this%lw_transmittance(:,iregion,jcol)*flux%lw_dn_surf_canopy(:,jcol) &
+                     &    +this%lw_reflectance  (:,iregion,jcol) &
+                     &     *this%lw_emissivity(:,iground,jcol)*this%planck_facet(:,iground,jcol) &
+                     &    +this%lw_source(:,iregion,jcol)) &
+                     &  / (1.0_jprb - (1.0_jprb - this%lw_emissivity(:,iground,jcol)) &
+                     &               *this%lw_reflectance(:,iregion,jcol))
+                surface_flux%lw_dn_facet(jcol,iground) = sum(lw_dn_g)
+                surface_flux%lw_up_facet(jcol,iground) &
+                     &  = sum((1.0_jprb-this%lw_emissivity(:,iground,jcol))*lw_dn_g &
+                     &       +this%lw_emissivity(:,iground,jcol)*this%planck_facet(:,iground,jcol))
+                surface_flux%lw_abs_canopy(jcol,jtile) = flux%lw_dn(jcol,isurf) &
+                     &  - flux%lw_up(jcol,isurf) - surface_flux%lw_dn_facet(jcol,iground) &
+                     &  + surface_flux%lw_up_facet(jcol,iground)
+
+              end if
+              if (config%do_sw) then
+                sw_dn_direct_g = this%sw_tra_dir_dir(:,iregion,jcol) &
+                     &  * flux%sw_dn_direct_surf_canopy(:,jcol)
+                ! Note that the following is initially just the
+                ! upwelling due to scattering of the direct beam
+                sw_up_g = sw_dn_direct_g * this%sw_albedo_direct(:,iground,jcol)
+                sw_dn_diffuse_g &
+                     &  = (this%sw_tra_dif(:,iregion,jcol)*flux%sw_dn_diffuse_surf_canopy(:,jcol) &
+                     &    +this%sw_ref_dif(:,iregion,jcol)*sw_up_g &
+                     &    +this%sw_tra_dir_dif(:,iregion,jcol)*flux%sw_dn_direct_surf_canopy(:,jcol)) &
+                     &  / (1.0_jprb - this%sw_albedo_diffuse(:,iground,jcol) & 
+                     &               *this%sw_ref_dif(:,iregion,jcol))
+                sw_up_g = sw_up_g + sw_dn_diffuse_g * this%sw_albedo_diffuse(:,iground,jcol)
+                surface_flux%sw_dn_direct_facet(jcol,iground) = sum(sw_dn_direct_g)
+                surface_flux%sw_dn_facet(jcol,iground) = surface_flux%sw_dn_direct_facet(jcol,iground) &
+                     &  + sum(sw_dn_diffuse_g)
+                surface_flux%sw_up_facet(jcol,iground) = sum(sw_up_g)
+                surface_flux%sw_abs_canopy(jcol,jtile) &
+                     &  = flux%sw_dn(jcol,isurf) - flux%sw_up(jcol,isurf) &
+                     &  - surface_flux%sw_dn_facet(jcol,iground) &
+                     &  + surface_flux%sw_up_facet(jcol,iground)
+              end if
+            case (ITileUrban3D)
+              iground = surface%i_ground_facet(jcol,jtile)
+              iroof   = surface%i_roof_facet(jcol,jtile)
+              iwall   = surface%i_wall_facet(jcol,jtile)
+              iregion = surface%i_region_1(jcol,jtile)
+
+              ! We want wall fluxes per unit area of wall, not per
+              ! unit area of street
+              wall_scaling = (1.0_jprb - surface%building_fraction(jcol,jtile)) &
+                   &  / max(1.0e-4_jprb, surface%building_normalized_perimeter(jcol,jtile) &
+                   &                     * surface%canopy_depth(jcol,jtile))
+
+              if (config%do_sw) then
+                ! Roof fluxes
+                surface_flux%sw_dn_facet(jcol,iroof)        = flux%sw_dn(jcol,isurf)
+                surface_flux%sw_dn_direct_facet(jcol,iroof) = flux%sw_dn_direct(jcol,isurf)
+                surface_flux%sw_up_facet(jcol,iroof) &
+                     & = sum(this%sw_albedo_diffuse(:,iroof,jcol) &
+                     &       * flux%sw_dn_diffuse_surf_canopy(:,jcol) &
+                     &       + this%sw_albedo_direct (:,iroof,jcol) &
+                     &       * flux%sw_dn_direct_surf_canopy (:,jcol))
+
+                ! Ground fluxes
+                sw_dn_direct_g = this%sw_tra_dir_dir(:,iregion,jcol) &
+                     &         * flux%sw_dn_direct_surf_canopy(:,jcol)
+                ! Note that the following is initially just the
+                ! upwelling due to scattering of the direct beam
+                sw_up_g = sw_dn_direct_g * this%sw_albedo_direct(:,iground,jcol)
+                sw_dn_diffuse_g &
+                     &  = (this%sw_tra_dif(:,iregion,jcol)*flux%sw_dn_diffuse_surf_canopy(:,jcol) &
+                     &    +this%sw_ref_dif(:,iregion,jcol)*sw_up_g &
+                     &    +this%sw_tra_dir_dif(:,iregion,jcol)*flux%sw_dn_direct_surf_canopy(:,jcol)) &
+                     &  / (1.0_jprb - this%sw_albedo_diffuse(:,iground,jcol) & 
+                     &               *this%sw_ref_dif(:,iregion,jcol))
+                sw_up_g = sw_up_g + sw_dn_diffuse_g * this%sw_albedo_diffuse(:,iground,jcol)
+                surface_flux%sw_dn_direct_facet(jcol,iground) = sum(sw_dn_direct_g)
+                surface_flux%sw_dn_facet(jcol,iground) = surface_flux%sw_dn_direct_facet(jcol,iground) &
+                     &  + sum(sw_dn_diffuse_g)
+                surface_flux%sw_up_facet(jcol,iground) = sum(sw_up_g)
+
+                ! Wall fluxes
+                sw_abs_g = flux%sw_dn_direct_surf_canopy(:,jcol)*this%sw_wall_abs_dir(:,iregion,jcol)
+                surface_flux%sw_dn_direct_facet(jcol,iwall) &
+                     &  = wall_scaling * sum(sw_abs_g / (1.0_jprb - this%sw_albedo_direct(:,iwall,jcol)))
+                ! Initially just the direct reflection
+                surface_flux%sw_up_facet(jcol,iwall) = wall_scaling &
+                     &  * sum(sw_abs_g * this%sw_albedo_direct(:,iwall,jcol) &
+                     &        / (1.0_jprb - this%sw_albedo_direct(:,iwall,jcol)))
+                ! Initially just the direct absorption
+                surface_flux%sw_abs_canopy(jcol,jtile) &
+                     &  = sum(flux%sw_dn_direct_surf_canopy(:,jcol)*this%sw_air_abs_dir(:,iregion,jcol))
+
+                ! Diffuse absorption within canopy
+                sw_abs_g = flux%sw_dn_direct_surf_canopy(:,jcol) &
+                     &   * (1.0-this%sw_albedo_direct_reg (:,iregion,jcol)) &
+                     &   + flux%sw_dn_diffuse_surf_canopy(:,jcol) &
+                     &   * (1.0-this%sw_albedo_diffuse_reg(:,iregion,jcol)) &
+                     &   - sw_dn_direct_g - sw_dn_diffuse_g + sw_up_g - sw_abs_g
+                ! Add diffuse absorption
+                surface_flux%sw_abs_canopy(jcol,jtile) = surface_flux%sw_abs_canopy(jcol,jtile) &
+                     &   + sum(sw_abs_g * (1.0_jprb - this%sw_wall_abs_frac_dif(:,iregion,jcol)))
+                ! Add diffuse reflection
+                surface_flux%sw_up_facet(jcol,iwall) = surface_flux%sw_up_facet(jcol,iwall) &
+                     &   +  wall_scaling * sum(sw_abs_g * this%sw_wall_abs_frac_dif(:,iregion,jcol) &
+                     &         * this%sw_albedo_diffuse(:,iwall,jcol) &
+                     &         / (1.0_jprb - this%sw_albedo_diffuse(:,iwall,jcol)))
+                ! Add diffuse into wall
+                surface_flux%sw_dn_facet(jcol,iwall) = surface_flux%sw_dn_direct_facet(jcol,iwall) &
+                     &   + wall_scaling * sum(sw_abs_g * this%sw_wall_abs_frac_dif(:,iregion,jcol) &
+                     &         / (1.0_jprb - this%sw_albedo_diffuse(:,iwall,jcol)))
+!!$
+!!$                sw_direct_abs_g  = flux%sw_dn_direct_surf_g (:,jcol) - sw_dn_direct_g
+!!$                sw_diffuse_abs_g = flux%sw_dn_diffuse_surf_g(:,jcol)*(1.0_jprb - this%sw_albedo_diffuse_reg(:,iregion,jcol)) &
+!!$                     &   + flux%sw_dn_direct_surf_g (:,jcol)*(1.0_jprb - this%sw_albedo_direct_reg (:,iregion,jcol)) &
+!!$                     &   - sw_dn_direct_g - sw_dn_diffuse_g + sw_up_g
+!!$
+!!$
+!!$                surface_flux%sw_abs_canopy(jcol,jtile) = sum((1.0_jprb - this%sw_wall_abs_frac(:,iregion,jcol))*sw_abs_g)
+!!$                surface_flux%sw_dn_facet(jcol,iwall) = sum(this%sw_wall_abs_frac(:,iregion,jcol)*sw_abs_g &
+!!$                     &                           / (1.0_jprb - this%sw_albedo_diffuse(:,iwall,jcol)))
+!!$                surface_flux%sw_up_facet(jcol,iwall) = sum(this%sw_albedo_diffuse(:,iwall,jcol) &
+!!$                     &                             *this%sw_wall_abs_frac(:,iregion,jcol)*sw_abs_g &
+!!$                     &                           / (1.0_jprb - this%sw_albedo_diffuse(:,iwall,jcol)))
+              end if
+
+              if (config%do_lw) then
+                surface_flux%lw_dn_facet(jcol,iroof) = flux%lw_dn(jcol,isurf)
+                surface_flux%lw_up_facet(jcol,iroof) &
+                     &  = sum(this%lw_emissivity(:,iroof,jcol)*this%planck_facet(:,iroof,jcol) &
+                     &  +  (1.0_jprb - this%lw_emissivity(:,iroof,jcol))*flux%lw_dn_surf_canopy(:,jcol))
+                lw_dn_g = (this%lw_transmittance(:,iregion,jcol)*flux%lw_dn_surf_canopy(:,jcol) &
+                     &    +this%lw_reflectance  (:,iregion,jcol) &
+                     &     *this%lw_emissivity(:,iground,jcol)*this%planck_facet(:,iground,jcol) &
+                     &    +this%lw_source(:,iregion,jcol)) &
+                     &  / (1.0_jprb - (1.0_jprb - this%lw_emissivity(:,iground,jcol)) &
+                     &               *this%lw_reflectance(:,iregion,jcol))
+                lw_up_g = (1.0_jprb-this%lw_emissivity(:,iground,jcol))*lw_dn_g &
+                     &       +this%lw_emissivity(:,iground,jcol)*this%planck_facet(:,iground,jcol)
+                surface_flux%lw_dn_facet(jcol,iground) = sum(lw_dn_g)
+                surface_flux%lw_up_facet(jcol,iground) = sum(lw_up_g)
+!                lw_abs_g = flux%lw_dn(jcol,isurf)-flux%lw_up(jcol,isurf) &
+!                     &  - surface_flux%lw_dn_facet(jcol,iground)+surface_flux%lw_up_facet(jcol,iground)
+!                lw_abs_g = flux%lw_dn_surf_canopy(:,jcol) &
+!                     &  * (1.0_jprb-this%lw_emissivity_region(:,iregion,jcol)) &
+!                     &  - this%lw_emission_region(:,iregion,jcol) &
+!                     &  - lw_dn_g*(1.0_jprb-this%lw_emissivity(:,iground,jcol)) &
+!                     &  + this%lw_emissivity(:,iground,jcol)*this%planck_facet(:,iground,jcol)
+!                lw_abs_g = flux%lw_dn_surf_canopy(:,jcol) &
+!                     &  * this%lw_emissivity_region(:,iregion,jcol) &
+!                     &  - this%lw_emission_region(:,iregion,jcol) &
+!                     &  - lw_dn_g*this%lw_emissivity(:,iground,jcol) &
+!                     &  + this%lw_emissivity(:,iground,jcol)*this%planck_facet(:,iground,jcol)
+                lw_abs_g = (flux%lw_dn_surf_canopy(:,jcol) + lw_up_g) &
+                     &   * (1.0_jprb - this%lw_reflectance(:,iregion,jcol) &
+                     &               - this%lw_transmittance(:,iregion,jcol)) &
+                     &   + this%lw_total_wall_emission(:,iregion,jcol) &
+                     &   + this%lw_total_canopy_emission(:,iregion,jcol) &
+                     &   - 2.0_jprb * this%lw_source(:,iregion,jcol)
+
+!                surface_flux%lw_up_facet(jcol,iwall) = sum(this%planck_facet(:,iwall,jcol) &
+!                     &  + wall_scaling*(1.0_jprb-this%lw_emissivity(:,iwall,jcol)) &
+!                     &    *this%lw_wall_abs_frac(:,iregion,jcol)*lw_abs_g &
+!                     &    / this%lw_emissivity(:,iwall,jcol))
+!                surface_flux%lw_dn_facet(jcol,iwall) = sum((this%planck_facet(:,iwall,jcol) &
+!                     &  + this%lw_total_wall_emission(:,iregion,jcol)) / this%lw_emissivity(:,iwall,jcol))
+
+!                surface_flux%lw_dn_facet(jcol,iwall) = wall_scaling*sum((this%lw_total_wall_emission(:,iregion,jcol) &
+!                     &  + this%lw_wall_abs_frac(:,iregion,jcol)*lw_abs_g) &
+!                     &  / this%lw_emissivity(:,iwall,jcol))
+!                surface_flux%lw_up_facet(jcol,iwall) = surface_flux%lw_dn_facet(jcol,iwall) &
+!                     &  - wall_scaling*sum(this%lw_wall_abs_frac(:,iregion,jcol)*lw_abs_g)
+
+                surface_flux%lw_dn_facet(jcol,iwall) &
+                     &  = wall_scaling*sum(this%lw_wall_abs_frac(:,iregion,jcol)*lw_abs_g &
+                     &                     / this%lw_emissivity(:,iwall,jcol))
+                surface_flux%lw_up_facet(jcol,iwall) = surface_flux%lw_dn_facet(jcol,iwall) &
+                     &  + wall_scaling * sum(this%lw_total_wall_emission(:,iregion,jcol) &
+                     &                       - this%lw_wall_abs_frac(:,iregion,jcol)*lw_abs_g)
+
+                surface_flux%lw_abs_canopy(jcol,jtile) &
+                     &  = sum(lw_abs_g*(1.0_jprb-this%lw_wall_abs_frac(:,iregion,jcol)) &
+                     &        -this%lw_total_canopy_emission(:,iregion,jcol))
+              end if
+            end select
+
+          end if
+
+        end do
+      end do
+    end if
+
+    if (lhook) call dr_hook('radsurf_intermediate:partition_fluxes',1,hook_handle)
+
+  end subroutine partition_fluxes
+
+end module radsurf_intermediate
Index: LMDZ6/trunk/libf/phylmd/ecrad/radsurf_properties.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radsurf_properties.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radsurf_properties.F90	(revision 3908)
@@ -0,0 +1,446 @@
+! radsurf_properties.f90 - Derived type for surface properties
+!
+! (C) Copyright 2017- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+
+module radsurf_properties
+
+  use parkind1, only : jpim, jprb
+
+  implicit none
+
+  public
+
+  ! Number of tile types
+  integer(kind=jpim), parameter :: NTileTypes = 3
+
+  ! Codes for the different type of tile
+  enum, bind(c)
+    enumerator :: ITileFlat = 1, &
+         &        ITileVegetation, &
+         &        ITileUrban3D
+  end enum
+
+  character(len=*), parameter :: TileRepresentationName(NTileTypes) &
+       &  = (/ 'Flat                 ', &
+       &       'HomogeneousVegetation', &
+       &       'Urban3D              ' /)
+
+  ! Number of surface facets and regions 
+  integer(kind=jpim), parameter :: NTileFacets (NTileTypes) = (/ 1, 1, 3 /)
+  integer(kind=jpim), parameter :: NTileRegions(NTileTypes) = (/ 0, 1, 1 /)
+
+
+  !---------------------------------------------------------------------
+  ! Derived type storing a physical description of the properties of
+  ! the surface tiles needed to compute the boundary conditions for
+  ! the radiation scheme.
+  type surface_type
+    ! Skin temperature (ncol,nfacet)
+    real(kind=jprb), allocatable :: skin_temperature(:,:)
+
+    ! Air temperature in canopy (ncol,ntile)
+    real(kind=jprb), allocatable :: canopy_temperature(:,:)
+
+    ! Shortwave albedo: if sw_albedo_direct is not allocated then
+    ! sw_albedo will be used for both direct and diffuse solar
+    ! radiation; otherwise, sw_albedo will be used for diffuse
+    ! radiation and sw_albedo_direct for direct
+    ! radiation. Dimensioning is (ncol,nalbedobands,nfacet).
+    real(kind=jprb), allocatable, dimension(:,:,:) :: &
+         &  sw_albedo, sw_albedo_direct
+
+    ! Longwave emissivity: dimensioning is (ncol,nemissbands,nfacet)
+    real(kind=jprb), allocatable, dimension(:,:,:) :: &
+         &  lw_emissivity
+
+    ! Representation codes (ITileFlat etc) for each tile: dimensioning
+    ! is (ntile)
+    integer(kind=jpim), allocatable, dimension(:) :: &
+         &  i_representation
+
+    ! Indices to the facets: dimensioning is (ncol,ntile)
+    integer(kind=jpim), allocatable, dimension(:,:) :: &
+         &  i_ground_facet, &
+         &  i_roof_facet, &
+         &  i_wall_facet
+
+    ! Indices to the regions: dimensioning is (ncol,ntile)
+    integer(kind=jpim), allocatable, dimension(:,:) :: &
+         &  i_region_1 !, i_region_2
+
+    ! Physical properties dimensioned (ncol,ntile)
+    real(kind=jprb), allocatable, dimension(:,:) :: &
+         &  tile_fraction, & ! Fraction of column occupied by each tile
+         &  canopy_depth     ! Depth of canopy (m)
+
+    ! Building properties in urban tile dimensioned (ncol,ntile)
+    real(kind=jprb), allocatable, dimension(:,:) :: &
+         &  building_fraction, & ! Fraction of canopy containing buildings
+         &  building_normalized_perimeter ! Perimeter length of buildings per unit area (m)
+
+    ! Vegetation physical properties dimensioned (ncol,ntile)
+    real(kind=jprb), allocatable, dimension(:,:) :: &
+         &  vegetation_optical_depth, & ! Same as LAI?
+         &  vegetation_fractional_std   ! Fractional standard deviation
+
+    ! Vegetation optical properties
+    real(kind=jprb), allocatable, dimension(:,:,:) :: &
+         &  vegetation_sw_albedo, & ! (ncol,nalbedobands,ntile)
+         &  vegetation_lw_emissivity! (ncol,nemissbands,ntile)
+
+! When 3D effects in vegetation canopies are represented, these will
+! be available
+!         &  vegetation_normalized_perimeter
+!         &  vegetation_fraction, &
+
+    ! Number of tiles, columns, facets, regions
+    integer(kind=jpim) :: ntile, ncol, nfacet, nregion
+
+    ! Number of albedo and emissivity bands
+    integer(kind=jpim) :: nalbedobands, nemissbands
+
+    ! Is this a simple surface containing one "flat" tile?
+    logical :: is_simple = .true.
+
+  contains
+    procedure :: allocate   => allocate_surface
+    procedure :: deallocate => deallocate_surface
+    procedure :: read => read_from_netcdf
+    procedure :: set_facet_indices
+
+  end type surface_type
+
+
+contains
+
+  !---------------------------------------------------------------------
+  subroutine allocate_surface(this, ncol, nalbedobands, nemissbands, &
+       &                      i_representation, &
+       &                      use_sw_albedo_direct)
+
+    use yomhook,        only : lhook, dr_hook
+
+    class(surface_type), intent(inout) :: this
+    integer(kind=jpim),  intent(in)    :: ncol, nalbedobands, nemissbands
+    integer(kind=jpim),  intent(in), optional :: i_representation(:)
+    logical(kind=jpim),  intent(in), optional :: use_sw_albedo_direct
+
+    ! Number of facets and regions
+    integer(kind=jpim) :: nfacet, nregion, ntile
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_surface:allocate',0,hook_handle)
+
+    call this%deallocate()
+
+    this%ncol   = ncol
+    if (present(i_representation)) then
+      nfacet    = sum(NTileFacets (i_representation))
+      nregion   = sum(NTileRegions(i_representation))
+      ntile     = size(i_representation)
+      this%is_simple = .false.
+    else
+      nfacet    = 1
+      nregion   = 0
+      ntile     = 1
+      this%is_simple = .true.
+    end if
+    this%nfacet = nfacet
+    this%nregion= nregion
+    this%ntile  = ntile
+    this%nalbedobands = nalbedobands
+    this%nemissbands  = nemissbands
+
+    allocate(this%skin_temperature(ncol,nfacet))
+    allocate(this%sw_albedo(ncol, nalbedobands, nfacet))
+
+    if (present(use_sw_albedo_direct)) then
+      if (use_sw_albedo_direct) then
+        allocate(this%sw_albedo_direct(ncol, nalbedobands, nfacet))
+      end if
+    end if
+
+    allocate(this%lw_emissivity(ncol, nemissbands, nfacet))
+
+    if (this%ntile > 1) then
+      allocate(this%tile_fraction(ncol,ntile))
+    end if
+
+    if (nregion > 0) then
+      allocate(this%canopy_depth(ncol,ntile))
+      allocate(this%canopy_temperature(ncol,ntile))
+      this%canopy_depth = 0.0_jprb
+      this%canopy_temperature = -1.0_jprb
+    end if
+
+    if (.not. this%is_simple) then
+      allocate(this%i_representation(ntile))
+      this%i_representation = i_representation
+
+      if (any(i_representation == ITileUrban3D)) then
+        allocate(this%building_fraction(ncol,ntile))
+        allocate(this%building_normalized_perimeter(ncol,ntile))
+        ! Initialize to default values
+        this%building_fraction = 0.0_jprb
+        this%building_normalized_perimeter = 0.0_jprb
+      end if
+      
+      if (any(i_representation == ITileVegetation)) then
+        allocate(this%vegetation_optical_depth(ncol,ntile))
+        allocate(this%vegetation_fractional_std(ncol,ntile))
+        allocate(this%vegetation_sw_albedo(ncol,nalbedobands,ntile))
+        allocate(this%vegetation_lw_emissivity(ncol,nemissbands,ntile))
+        ! Initialize to default values
+        this%vegetation_optical_depth = 0.0_jprb
+        this%vegetation_fractional_std = 0.0_jprb
+        this%vegetation_sw_albedo = 0.0_jprb
+        this%vegetation_lw_emissivity = 1.0_jprb
+      end if
+      
+      call this%set_facet_indices 
+
+    end if
+
+    if (lhook) call dr_hook('radiation_surface:allocate',1,hook_handle)
+
+  end subroutine allocate_surface
+
+
+  !---------------------------------------------------------------------
+  ! Set the indices to facets
+  subroutine set_facet_indices(this)
+
+    use radiation_io,   only : nulerr, radiation_abort
+
+    class(surface_type), intent(inout) :: this
+
+    ! Indices to tiles and facets
+    integer(kind=jpim) :: ifacet, iregion, jtile
+    if (.not. this%is_simple) then
+
+      allocate(this%i_ground_facet(this%ncol,this%ntile))
+      this%i_ground_facet = 0
+
+      if (any(this%i_representation == ITileUrban3D)) then
+        allocate(this%i_roof_facet(this%ncol,this%ntile))
+        allocate(this%i_wall_facet(this%ncol,this%ntile))
+        ! Initialize to default values
+        this%i_roof_facet = 0
+        this%i_wall_facet = 0
+      end if
+      
+      if (this%nregion > 0) then
+        allocate(this%i_region_1(this%ncol,this%ntile))
+        this%i_region_1 = 0
+      end if
+
+      ! Set the indices to the various facets
+      ifacet = 1
+      iregion = 1
+      do jtile = 1,this%ntile
+        this%i_ground_facet(:,jtile) = ifacet
+        ifacet = ifacet + 1
+        if (this%i_representation(jtile) == ITileVegetation) then
+          this%i_region_1(:,jtile) = iregion
+          iregion = iregion+1
+        else if (this%i_representation(jtile) == ITileUrban3D) then
+          this%i_roof_facet(:,jtile) = ifacet
+          this%i_wall_facet(:,jtile) = ifacet+1
+          ifacet = ifacet+2
+          this%i_region_1(:,jtile) = iregion
+          iregion = iregion+1
+        else if (this%i_representation(jtile) /= ITileFlat) then
+          write(nulerr,'(a,i0,a)') '*** Error: tile representation ', &
+               &  this%i_representation(jtile), ' not understood'
+          call radiation_abort()
+        end if
+      end do
+    end if
+  end subroutine set_facet_indices
+
+  !---------------------------------------------------------------------
+  subroutine deallocate_surface(this)
+
+    use yomhook, only : lhook, dr_hook
+
+    class(surface_type), intent(inout) :: this
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_surface:deallocate',0,hook_handle)
+
+    if (allocated(this%skin_temperature)) then
+      deallocate(this%skin_temperature)
+    end if
+    if (allocated(this%sw_albedo)) then
+      deallocate(this%sw_albedo)
+    end if
+    if (allocated(this%sw_albedo_direct)) then
+      deallocate(this%sw_albedo_direct)
+    end if
+    if (allocated(this%lw_emissivity)) then
+      deallocate(this%lw_emissivity)
+    end if
+    if (allocated(this%i_representation)) then
+      deallocate(this%i_representation)
+    end if
+    if (allocated(this%i_ground_facet)) then
+      deallocate(this%i_ground_facet)
+    end if
+    if (allocated(this%i_roof_facet)) then
+      deallocate(this%i_roof_facet)
+    end if
+    if (allocated(this%i_wall_facet)) then
+      deallocate(this%i_wall_facet)
+    end if
+    if (allocated(this%tile_fraction)) then
+      deallocate(this%tile_fraction)
+    end if
+    if (allocated(this%canopy_depth)) then
+      deallocate(this%canopy_depth)
+    end if
+    if (allocated(this%canopy_temperature)) then
+      deallocate(this%canopy_temperature)
+    end if
+    if (allocated(this%building_fraction)) then
+      deallocate(this%building_fraction)
+    end if
+    if (allocated(this%building_normalized_perimeter)) then
+      deallocate(this%building_normalized_perimeter)
+    end if
+    if (allocated(this%vegetation_optical_depth)) then
+      deallocate(this%vegetation_optical_depth)
+    end if
+    if (allocated(this%vegetation_fractional_std)) then
+      deallocate(this%vegetation_fractional_std)
+    end if
+    if (allocated(this%vegetation_sw_albedo)) then
+      deallocate(this%vegetation_sw_albedo)
+    end if
+    if (allocated(this%vegetation_lw_emissivity)) then
+      deallocate(this%vegetation_lw_emissivity)
+    end if
+
+    this%ntile  = 0
+    this%ncol   = 0
+    this%nfacet = 0
+
+    if (lhook) call dr_hook('radiation_surface:deallocate',1,hook_handle)
+
+  end subroutine deallocate_surface
+
+
+  !---------------------------------------------------------------------
+  ! Print a description of the surface tile types
+  subroutine print_surface_representation(i_representation)
+
+    use radiation_io, only : nulout
+
+    integer(kind=jpim), dimension(:), allocatable, intent(in) :: i_representation
+
+    integer :: ntile, jtile, ifacet, iregion
+
+    write(nulout,'(a)') 'Surface tile representation:'
+    if (.not. allocated(i_representation)) then
+      write(nulout,'(a)') '  Simple (one flat tile)'
+    else
+      ntile = size(i_representation,1)
+      ifacet  = 1
+      iregion = 1;
+      do jtile = 1,ntile
+        write(nulout,'(a,i0,a,a)') '  Tile ', jtile, ': ', trim(TileRepresentationName(i_representation(jtile)))
+        write(nulout,'(a,i0,a)') '    Facet ', ifacet, ': ground'
+        ifacet = ifacet+1
+
+        select case (i_representation(jtile))
+
+        case (ITileVegetation)
+          write(nulout,'(a,i0,a)') '    Region ', iregion, ': vegetation canopy'
+          iregion = iregion+1
+
+        case (ITileUrban3D)
+          write(nulout,'(a,i0,a)') '    Facet ', ifacet, ': roof'
+          write(nulout,'(a,i0,a)') '    Facet ', ifacet+1, ': wall'
+          ifacet = ifacet+1
+          write(nulout,'(a,i0,a)') '    Region ', iregion, ': street canyon'
+          iregion = iregion+1
+
+        end select
+
+      end do
+    end if
+    
+  end subroutine print_surface_representation
+
+
+  !---------------------------------------------------------------------
+  subroutine read_from_netcdf(this, file)
+
+    use parkind1,           only : jprb, jpim
+    use easy_netcdf,        only : netcdf_file
+    
+    implicit none
+
+    type(netcdf_file),  intent(in)     :: file
+    class(surface_type), intent(inout) :: this
+
+    real(kind=jprb), allocatable       :: data_1d(:)
+
+    integer(kind=jpim), parameter :: ipermute(3) = [2,3,1]
+
+    call this%deallocate
+
+    this%is_simple = .false.
+
+    call file%get('skin_temperature', this%skin_temperature, do_transp=.true.)
+    call file%get('canopy_temperature', this%canopy_temperature, do_transp=.true.)
+    call file%get('sw_albedo', this%sw_albedo, ipermute=ipermute)
+    if (file%exists('sw_albedo_direct')) then
+      call file%get('sw_albedo', this%sw_albedo_direct, ipermute=ipermute)
+    end if
+    call file%get('lw_emissivity', this%lw_emissivity, ipermute=ipermute)
+    call file%get('tile_representation', data_1d)
+    this%ntile = size(data_1d)
+    allocate(this%i_representation(this%ntile))
+    this%i_representation = int(data_1d)
+    call file%get('tile_fraction', this%tile_fraction, do_transp=.true.)
+    call file%get('canopy_depth', this%canopy_depth, do_transp=.true.)
+    call file%get('building_fraction', this%building_fraction, do_transp=.true.)
+    if (file%exists('building_normalized_perimeter')) then
+      call file%get('building_normalized_perimeter', &
+           &  this%building_normalized_perimeter, do_transp=.true.)
+    else
+      ! Convert building scale to normalized perimeter
+      call file%get('building_scale', this%building_normalized_perimeter, do_transp=.true.)
+      this%building_normalized_perimeter = 4.0_jprb * this%building_fraction &
+           &  * (1.0_jprb-this%building_fraction) / max(1.0e-8_jprb,this%building_normalized_perimeter)
+    end if
+    call file%get('vegetation_optical_depth', this%vegetation_optical_depth, do_transp=.true.)
+    call file%get('vegetation_sw_albedo', this%vegetation_sw_albedo, ipermute=ipermute)
+    call file%get('vegetation_lw_emissivity', this%vegetation_lw_emissivity, ipermute=ipermute)
+
+    this%nregion = sum(NTileRegions(this%i_representation))
+    this%ncol    = size(this%skin_temperature,1)
+    this%nfacet  = size(this%skin_temperature,2)
+
+    this%nalbedobands = size(this%sw_albedo,2)
+    this%nemissbands = size(this%lw_emissivity,2)
+
+    call this%set_facet_indices
+
+  end subroutine read_from_netcdf
+
+
+end module radsurf_properties
Index: LMDZ6/trunk/libf/phylmd/ecrad/radsurf_save.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radsurf_save.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radsurf_save.F90	(revision 3908)
@@ -0,0 +1,143 @@
+! radsurf_save.f90 - Save surface data to NetCDF files
+!
+! (C) Copyright 2017- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author:  Robin Hogan
+! Email:   r.j.hogan@ecmwf.int
+!
+
+module radsurf_save
+
+  public :: save_surface_fluxes
+
+contains
+
+  !------------------------------------------------------------------
+  ! Save fluxes in "surface_flux" to NetCDF file_name
+  subroutine save_surface_fluxes(file_name, config, surface_flux, iverbose)
+
+    use yomhook,                  only : lhook, dr_hook
+
+    use easy_netcdf
+
+    use radiation_io,             only : nulout
+    use radiation_config,         only : config_type, IGasModelMonochromatic
+    use radsurf_flux,             only : surface_flux_type
+
+    character(len=*),        intent(in)  :: file_name
+    type(config_type),       intent(in)  :: config
+    type(surface_flux_type), intent(in)  :: surface_flux
+
+    type(netcdf_file)                    :: out_file
+    integer                              :: ncol
+
+    character(5), parameter :: default_lw_units_str = 'W m-2'
+    character(5)            :: lw_units_str
+
+    integer, optional, intent(in) :: iverbose
+    integer                       :: i_local_verbose
+
+    integer :: nfacet, ntile
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radsurf_save:save_surface_fluxes',0,hook_handle)
+
+    if (present(iverbose)) then
+      i_local_verbose = iverbose
+    else
+      i_local_verbose = config%iverbose
+    end if
+
+    ncol   = 0
+    ntile  = 0
+    nfacet = 0
+    if (allocated(surface_flux%lw_dn_facet)) then
+      ncol   = size(surface_flux%lw_dn_facet,1)
+      nfacet = size(surface_flux%lw_dn_facet,2)
+      ntile  = size(surface_flux%lw_abs_canopy,2)
+    else if (allocated(surface_flux%sw_dn_facet)) then
+      ncol   = size(surface_flux%sw_dn_facet,1)
+      nfacet = size(surface_flux%sw_dn_facet,2)
+      ntile  = size(surface_flux%sw_abs_canopy,2)
+    end if
+
+    if (ncol == 0) then
+      write(nulout,'(a)') 'Warning: surface-flux structure contains no data to write'
+    else
+
+      if (config%i_gas_model == IGasModelMonochromatic &
+           .and. config%mono_lw_wavelength > 0.0_jprb) then
+        lw_units_str = 'W m-3'
+      else
+        lw_units_str = default_lw_units_str
+      end if
+
+      ! Open the file
+      call out_file%create(trim(file_name), iverbose=i_local_verbose)
+
+      ! Variables stored internally with column varying fastest, but in
+      ! output file column varies most slowly so need to transpose
+      call out_file%transpose_matrices(.true.)
+
+      ! Define dimensions
+      call out_file%define_dimension("column", ncol)
+      if (ntile > 0) then
+        call out_file%define_dimension("tile",  ntile)
+        call out_file%define_dimension("facet", nfacet)
+      end if
+
+      if (allocated(surface_flux%lw_dn_facet)) then
+        call out_file%define_variable("flux_dn_lw_facet", &
+             &  dim2_name="column", dim1_name="facet", units_str=lw_units_str, &
+             &  long_name="Longwave flux into facet of surface")
+        call out_file%define_variable("flux_up_lw_facet", &
+             &  dim2_name="column", dim1_name="facet", units_str=lw_units_str, &
+             &  long_name="Longwave flux out of facet of surface")
+        call out_file%define_variable("absorption_lw_canopy", &
+             &  dim2_name="column", dim1_name="tile", units_str=lw_units_str, &
+             &  long_name="Longwave absorption by tile canopy")
+      end if
+      if (allocated(surface_flux%sw_dn_facet)) then
+        call out_file%define_variable("flux_dn_sw_facet", &
+             &  dim2_name="column", dim1_name="facet", units_str="W m-2", &
+             &  long_name="Shortwave flux into facet of surface")
+        call out_file%define_variable("flux_dn_direct_sw_facet", &
+             &  dim2_name="column", dim1_name="facet", units_str="W m-2", &
+             &  long_name="Shortwave direct flux into facet of surface")
+        call out_file%define_variable("flux_up_sw_facet", &
+             &  dim2_name="column", dim1_name="facet", units_str="W m-2", &
+             &  long_name="Shortwave flux out of facet of surface")
+        call out_file%define_variable("absorption_sw_canopy", &
+             &  dim2_name="column", dim1_name="tile", units_str="W m-2", &
+             &  long_name="Shortwave absorption by tile canopy")
+      end if
+
+      if (allocated(surface_flux%lw_dn_facet)) then
+        call out_file%put("flux_dn_lw_facet", surface_flux%lw_dn_facet)
+        call out_file%put("flux_up_lw_facet", surface_flux%lw_up_facet)
+        call out_file%put("absorption_lw_canopy", surface_flux%lw_abs_canopy)
+      end if
+      if (allocated(surface_flux%sw_dn_facet)) then
+        call out_file%put("flux_dn_sw_facet", surface_flux%sw_dn_facet)
+        call out_file%put("flux_dn_direct_sw_facet", surface_flux%sw_dn_direct_facet)
+        call out_file%put("flux_up_sw_facet", surface_flux%sw_up_facet)
+        call out_file%put("absorption_sw_canopy", surface_flux%sw_abs_canopy)
+      end if
+      
+      ! Close file
+      call out_file%close()
+
+    end if
+    if (lhook) call dr_hook('radsurf_save:save_surface_fluxes',1,hook_handle)
+      
+    end subroutine save_surface_fluxes
+    
+end module radsurf_save
Index: LMDZ6/trunk/libf/phylmd/ecrad/raise.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/raise.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/raise.h	(revision 3908)
@@ -0,0 +1,44 @@
+/**
+ * (C) Copyright 2014- ECMWF.
+ *
+ * This software is licensed under the terms of the Apache Licence Version 2.0
+ * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+ *
+ * In applying this licence, ECMWF does not waive the privileges and immunities
+ * granted to it by virtue of its status as an intergovernmental organisation
+ * nor does it submit to any jurisdiction.
+ */
+
+#ifndef _RAISE_H_
+#define _RAISE_H_
+
+/* raise.h */
+
+#include <stdio.h>
+#include <string.h>
+#include <signal.h>
+#include <unistd.h>
+
+extern void abor1fl_(const char *filename, const int *linenum, 
+		     const char *s, 
+		     int filenamelen, int slen);
+extern void abor1_(const char *s, int slen);
+
+#define ABOR1(txt) { const char *t = (txt); t ? abor1_(t, strlen(t)) : abor1_("",0); }
+
+#define ABOR1FL(txt) { \
+  const char *t = (txt); \
+  int linenum=__LINE__; \
+  t ? abor1fl_(__FILE__, &linenum,  t, sizeof(__FILE__)-1, strlen(t)) \
+    : abor1fl_(__FILE__, &linenum, "", sizeof(__FILE__)-1, 0); \
+  _exit(1); /* Should never end up here */ }
+
+#define RAISE(x) { \
+  if ((x) == SIGABRT) { \
+    ABOR1FL("*** Fatal error; aborting (SIGABRT) ..."); \
+    _exit(1); /* Should never end up here */ \
+  } \
+  else raise(x); \
+}
+
+#endif /* _RAISE_H_ */
Index: LMDZ6/trunk/libf/phylmd/ecrad/random_numbers_mix.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/random_numbers_mix.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/random_numbers_mix.F90	(revision 3908)
@@ -0,0 +1,440 @@
+!**** *RANDOM_NUMBERS_MIX*  - Portable Random Number Generator
+
+! (C) Copyright 2002- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+!     Purpose.
+!     --------
+!           Generate machine-independent pseudo-random numbers
+
+!**   Interface.
+!     ----------
+!        CALL initialize_random_numbers (kseed, yd_stream)
+!        CALL uniform_distribution      (px   , yd_stream)
+!        CALL gaussian_distribution     (px   , yd_stream)
+!        CALL random_number_restartfile (fname, action)
+!        CALL wr_rangen_state           (nunit)
+
+!        Explicit arguments :
+!        --------------------
+!        kseed  (input)    : integer seed in the range [0,HUGE(kseed)]
+!        yd_stream (optional) : the state of the random number generator
+!        px     (output)   : array to receive random numbers in the range
+
+!        In the case of uniform_distribution, px has values in the range [0.0,1.0)
+
+!        Implicit arguments :
+!        --------------------
+!        None
+
+!     Method.
+!     -------
+!        Based loosly on ZUFALL (Petersen, 1994).
+
+!        The main difference between this generator and ZUFALL is that integer arithmetic
+!        is used. This ensures portability to vector machines that implement different
+!        real arithmetic. In particular, vector machines often implement non-IEEE
+!        arithmetic for their vector pipes. This routine will give identical results for
+!        any integer type with at least 32 bits.
+
+!        The generator is a lagged-Fibonacci generator: x(i) = x(i-p) + x(i-q) mod 2**m.
+!        Lagged-Fibonacci generators have very long repeat periods: (2**q -1) * 2**(m-1)
+!        (i.e about 2.85E191 for q=607, m=30). They pass most tests for randomness.
+
+!        p and q must be chosen carefully. Values from the following table are OK.
+!        Larger values give better random numbers, but smaller values are more
+!        cache-friendly.
+
+!          q         p
+!        9689      4187
+!        4423      2098
+!        2281      1029
+!        1279       418
+!         607       273
+!         521       168
+!         250       103
+!         127        63
+!          97        33
+!          55        24
+!          43        22
+!          31        13
+!          24        10
+
+!        The initial q values of x are set using the binary shirt register method of
+!        Burns and Pryor 1999.
+
+!        Mascagni et al (1995) show how to choose different sets of initial values that
+!        are guaranteed to be drawn from different maximal-length cycles. This requires
+!        the initial values of x(1)...x(q) to be in "canonical form". Specifically,
+!        x(1) must be zero and all but a particular one or two values of x must be
+!        even. For q=607 and p=273, only one element (jpq-jps) must be odd.
+
+!     Externals.
+!     ----------
+!        None
+
+!     Reference.
+!     ----------
+!        Burns P.J. and Pryor D.V. 1999,
+!                             Surface Radiative Transport at Large Scale via Monte Carlo.
+!                             Annual Review of Heat Transfer, Vol 9.
+!
+!        Petersen W.P., 1994, Lagged Fibonacci Series Random Number Generator
+!                             for the NEC SX-3. International Journal of High Speed Computing
+!                             Vol. 6, No. 3, pp387-398.
+!
+!        Mascagni M., Cuccaro S.A., Pryor D.V., Robinson M.L., 1995,
+!                             A Fast, High Quality and Reproducible Parallel Lagged-Fibonacci
+!                             Pseudorandom Number Generator. Journal of Computational Physics
+!                             Vol 119. pp211-219.
+
+!     Author.
+!     -------
+!        Mike Fisher *ECMWF*
+
+!     Modifications.
+!     --------------
+!        Original : 2002-09-25
+!        Made parallel friendly: 2003-08-11 Robert Pincus
+!        M Leutbecher: 2004-05-10 restart capability
+!        M Fisher:     2005-03-30 replaced LCG initialization with shift register
+!     ------------------------------------------------------------------
+
+#ifdef RS6K
+@PROCESS HOT(NOVECTOR) NOSTRICT
+#endif
+MODULE RANDOM_NUMBERS_MIX
+USE YOMHOOK,  ONLY : LHOOK, DR_HOOK
+USE PARKIND1, ONLY : JPIM, JPRB
+
+IMPLICIT NONE
+
+SAVE
+
+PRIVATE
+PUBLIC RANDOMNUMBERSTREAM,WR_RANGEN_STATE, &
+     & INITIALIZE_RANDOM_NUMBERS, UNIFORM_DISTRIBUTION, GAUSSIAN_DISTRIBUTION ! ,&
+!     & RANDOM_NUMBER_RESTARTFILE, 
+
+INTEGER(KIND=JPIM), PARAMETER      :: JPP=273, JPQ=607, JPS=105
+INTEGER(KIND=JPIM), PARAMETER      :: JPMM=30
+INTEGER(KIND=JPIM), PARAMETER      :: JPM=2**JPMM
+INTEGER(KIND=JPIM), PARAMETER      :: JPNUMSPLIT=(JPQ-2)/(JPP-1)
+INTEGER(KIND=JPIM), PARAMETER      :: JPLENSPLIT=(JPQ-JPP+JPNUMSPLIT-1)/JPNUMSPLIT
+INTEGER(KIND=JPIM), PARAMETER      :: INITVALUE = 12345678
+
+TYPE RANDOMNUMBERSTREAM
+  PRIVATE
+  INTEGER(KIND=JPIM)                 :: IUSED
+  INTEGER(KIND=JPIM)                 :: INITTEST ! Should initialize to zero, but can't in F90
+  INTEGER(KIND=JPIM), DIMENSION(JPQ) :: IX 
+  REAL(KIND=JPRB)                    :: ZRM
+END TYPE RANDOMNUMBERSTREAM
+
+CONTAINS
+!-------------------------------------------------------------------------------
+SUBROUTINE INITIALIZE_RANDOM_NUMBERS (KSEED, YD_STREAM) 
+  !-------------------------------------------------------------------------------
+  ! Initialize fibgen
+  !-------------------------------------------------------------------------------
+  INTEGER(KIND=JPIM),                INTENT(IN   ) :: KSEED
+  TYPE(RANDOMNUMBERSTREAM), INTENT(INOUT) :: YD_STREAM
+  
+  INTEGER, PARAMETER :: JPMASK=123459876
+  INTEGER(KIND=JPIM), PARAMETER     :: JPWARMUP_SHFT=64, JPWARMUP_LFG=999
+  INTEGER(KIND=JPIM)                :: IDUM,JK,JJ,JBIT
+  REAL(KIND=JPRB), DIMENSION(JPWARMUP_LFG)   :: ZWARMUP
+
+  !-------------------------------------------------------------------------------
+  ! Initialize the buffer using a binary shift register (Burns and Pryor, 1999).
+  ! The Galois representation is used for the shift register as it is more
+  ! efficient than the Fibonacci representation. The magic numbers 31 and 87
+  ! define the shift register primitive polynomial=(32,7,5,3,2,1,0).
+  !
+  ! To ensure that different seeds produce distinct initial buffer states in
+  ! canonical form, bits 0...jpmm-2 of the initial seed (after XORing with jpmask
+  ! and spinning up using the linear congruential generator) are used to construct
+  ! x(2), and the remaining bits are used to construct x(jpq).
+  !-------------------------------------------------------------------------------
+  
+  REAL(KIND=JPRB) :: ZHOOK_HANDLE
+  IF (LHOOK) CALL DR_HOOK('RANDOM_NUMBERS_MIX:INITIALIZE_RANDOM_NUMBERS',0,ZHOOK_HANDLE)
+  IDUM = ABS(IEOR(KSEED,JPMASK))
+  IF (IDUM==0) IDUM=JPMASK
+
+  DO JJ=1,JPWARMUP_SHFT
+    IF (BTEST(IDUM,31)) THEN
+      IDUM=IBSET(ISHFT(IEOR(IDUM,87),1),0)
+    ELSE
+      IDUM=IBCLR(ISHFT(IDUM,1),0)
+    ENDIF
+  ENDDO
+
+  YD_STREAM%IX(1:JPQ-1)= 0
+  YD_STREAM%IX(2)      = ISHFT(IBITS(IDUM,0,JPMM-1),1)
+  YD_STREAM%IX(JPQ)    = IBITS(IDUM,JPMM-1,BIT_SIZE(IDUM)+1-JPMM)
+
+  DO JBIT=1,JPMM-1
+    DO JJ=3,JPQ-1
+      IF (BTEST(IDUM,31)) THEN
+        IDUM=IBSET(ISHFT(IEOR(IDUM,87),1),0)
+        YD_STREAM%IX(JJ)=IBSET(YD_STREAM%IX(JJ),JBIT)
+      ELSE
+        IDUM=IBCLR(ISHFT(IDUM,1),0)
+      ENDIF
+    ENDDO
+  ENDDO
+
+  YD_STREAM%IX(JPQ-JPS) = IBSET(YD_STREAM%IX(JPQ-JPS),0)
+  
+  !-------------------------------------------------------------------------------
+  ! Initialize some constants
+  !-------------------------------------------------------------------------------
+  
+  YD_STREAM%IUSED=JPQ
+  YD_STREAM%ZRM=1.0_JPRB/REAL(JPM,JPRB)
+  
+  !-------------------------------------------------------------------------------
+  ! Check the calculation of jpnumsplit and jplensplit.
+  !-------------------------------------------------------------------------------
+  
+  IF (JPP+JPNUMSPLIT*JPLENSPLIT < JPQ) THEN
+    CALL ABOR1 ('initialize_random_numbers: upper limit of last loop < jpq')
+  ENDIF
+  
+  IF (JPLENSPLIT >=JPP) THEN
+    CALL ABOR1 ('initialize_random_numbers: loop length > jpp')
+  ENDIF
+  
+  IF (JPNUMSPLIT>1) THEN
+    IF ((JPQ-JPP+JPNUMSPLIT-2)/(JPNUMSPLIT-1) < JPP) THEN
+      CALL ABOR1 ('initialize_random_numbers: jpnumsplit is bigger than necessary')
+    ENDIF
+  ENDIF
+
+  !-------------------------------------------------------------------------------
+  ! Set initTest to show that the stream is initialized.
+  !-------------------------------------------------------------------------------
+
+  YD_STREAM%INITTEST = INITVALUE
+  
+  !-------------------------------------------------------------------------------
+  ! Warm up the generator.
+  !-------------------------------------------------------------------------------
+
+  CALL UNIFORM_DISTRIBUTION (ZWARMUP, YD_STREAM)
+
+IF (LHOOK) CALL DR_HOOK('RANDOM_NUMBERS_MIX:INITIALIZE_RANDOM_NUMBERS',1,ZHOOK_HANDLE)
+END SUBROUTINE INITIALIZE_RANDOM_NUMBERS
+
+!@PROCESS HOT NOSTRICT
+SUBROUTINE UNIFORM_DISTRIBUTION (PX,YD_STREAM)
+  !--------------------------------------------------------------------------------
+  ! Generate uniformly distributed random numbers in the range 0.0<= px < 1.0
+  !--------------------------------------------------------------------------------
+  INTEGER(KIND=JPIM), PARAMETER :: IVAR=Z"3FFFFFFF"
+  TYPE(RANDOMNUMBERSTREAM), INTENT(INOUT) :: YD_STREAM
+  REAL(KIND=JPRB), DIMENSION(:),     INTENT(  OUT) :: PX
+
+  INTEGER(KIND=JPIM)                :: JJ, JK, IN, IFILLED
+  
+  ! This test is a little dirty but Fortran 90 doesn't allow for the initialization
+  !   of components of derived types. 
+  REAL(KIND=JPRB) :: ZHOOK_HANDLE
+! DR_HOOK removed to reduce overhead
+! IF (LHOOK) CALL DR_HOOK('RANDOM_NUMBERS_MIX:UNIFORM_DISTRIBUTION',0,ZHOOK_HANDLE)
+  IF(YD_STREAM%INITTEST /= INITVALUE) &
+    & CALL ABOR1 ('uniform_distribution called before initialize_random_numbers')
+  
+  !--------------------------------------------------------------------------------
+  ! Copy numbers that were generated during the last call, but not used.
+  !--------------------------------------------------------------------------------
+  
+  IN=SIZE(PX)
+  IFILLED=0
+  
+  DO JJ=YD_STREAM%IUSED+1,MIN(JPQ,IN+YD_STREAM%IUSED)
+    PX(JJ-YD_STREAM%IUSED) = YD_STREAM%IX(JJ)*YD_STREAM%ZRM
+    IFILLED=IFILLED+1
+  ENDDO
+  
+  YD_STREAM%IUSED=YD_STREAM%IUSED+IFILLED
+  
+  IF (IFILLED==IN)  THEN 
+!   IF (LHOOK) CALL DR_HOOK('RANDOM_NUMBERS_MIX:UNIFORM_DISTRIBUTION',1,ZHOOK_HANDLE)
+! DR_HOOK removed to reduce overhead
+    RETURN
+  ENDIF
+  
+  !--------------------------------------------------------------------------------
+  ! Generate batches of jpq numbers until px has been filled
+  !--------------------------------------------------------------------------------
+  
+  DO WHILE (IFILLED<IN)
+  
+  !--------------------------------------------------------------------------------
+  ! Generate jpq numbers in vectorizable loops. The first loop is length jpp. The
+  ! remaining jpq-jpp elements are calculated in loops of length shorter than jpp.
+  !--------------------------------------------------------------------------------
+  
+  !OCL NOVREC
+    DO JJ=1,JPP
+!     yd_stream%ix(jj) = yd_stream%ix(jj) + yd_stream%ix(jj-jpp+jpq)
+!     if (yd_stream%ix(jj)>=jpm) yd_stream%ix(jj) = yd_stream%ix(jj)-jpm
+      YD_STREAM%IX(JJ) = IAND(IVAR,YD_STREAM%IX(JJ) + YD_STREAM%IX(JJ-JPP+JPQ))
+    ENDDO
+  
+    DO JK=1,JPNUMSPLIT
+  !OCL NOVREC
+      DO JJ=1+JPP+(JK-1)*JPLENSPLIT,MIN(JPQ,JPP+JK*JPLENSPLIT)
+!       yd_stream%ix(jj) = yd_stream%ix(jj) + yd_stream%ix(jj-jpp)
+!       if (yd_stream%ix(jj)>=jpm) yd_stream%ix(jj) = yd_stream%ix(jj)-jpm
+        YD_STREAM%IX(JJ) = IAND(IVAR,YD_STREAM%IX(JJ) + YD_STREAM%IX(JJ-JPP))
+      ENDDO
+    ENDDO
+  
+    YD_STREAM%IUSED = MIN(JPQ,IN-IFILLED)
+    PX(IFILLED+1:IFILLED+YD_STREAM%IUSED) = YD_STREAM%IX(1:YD_STREAM%IUSED)*YD_STREAM%ZRM
+    IFILLED = IFILLED+YD_STREAM%IUSED
+  ENDDO
+  
+!IF (LHOOK) CALL DR_HOOK('RANDOM_NUMBERS_MIX:UNIFORM_DISTRIBUTION',1,ZHOOK_HANDLE)
+! DR_HOOK removed to reduce overhead
+END SUBROUTINE UNIFORM_DISTRIBUTION
+!-------------------------------------------------------------------------------
+SUBROUTINE GAUSSIAN_DISTRIBUTION (PX, YD_STREAM)
+  TYPE(RANDOMNUMBERSTREAM), INTENT(INOUT) :: YD_STREAM
+  REAL(KIND=JPRB),                   INTENT(  OUT) :: PX(:)
+  !--------------------------------------------------------------------------------
+  ! Generate normally-distributed random numbers using the Box-Muller method.
+  !
+  ! NB: this routine does not use buffering. This means that the following calls:
+  !     call gaussian_distribution (zx(1:k))
+  !     call gaussian_distribution (zx(k+1:n))
+  ! will produce different numbers for elements k+1 onwards than the single call:
+  !     call gaussian_distribution (zx(1:n))
+  !--------------------------------------------------------------------------------
+  
+  INTEGER(KIND=JPIM) :: ILEN, J
+  REAL(KIND=JPRB) :: ZFAC, ZTWOPI
+  REAL(KIND=JPRB) :: ZX(SIZE(PX)+1)
+  
+  !--------------------------------------------------------------------------------
+  ! Generate uniform random points in the range [0,1)
+  !--------------------------------------------------------------------------------
+
+    REAL(KIND=JPRB) :: ZHOOK_HANDLE
+    IF (LHOOK) CALL DR_HOOK('RANDOM_NUMBERS_MIX:GAUSSIAN_DISTRIBUTION',0,ZHOOK_HANDLE)
+    CALL UNIFORM_DISTRIBUTION (ZX, YD_STREAM)
+
+  !--------------------------------------------------------------------------------
+  ! Generate gaussian deviates using Box-Muller method
+  !--------------------------------------------------------------------------------
+  
+  ZTWOPI = 8.0_JPRB*ATAN(1.0_JPRB)
+  ILEN=SIZE(PX)
+  
+  DO J=1,ILEN-1,2
+    ZFAC = SQRT(-2.0_JPRB*LOG(1.0_JPRB-ZX(J)))
+    PX(J  ) = ZFAC*COS(ZTWOPI*ZX(J+1))
+    PX(J+1) = ZFAC*SIN(ZTWOPI*ZX(J+1))
+  ENDDO
+  
+  !--------------------------------------------------------------------------------
+  ! Generate the last point if ilen is odd
+  !--------------------------------------------------------------------------------
+  
+  IF (MOD(ILEN,2) /= 0) THEN
+    ZFAC = SQRT(-2.0_JPRB*LOG(1.0_JPRB-ZX(ILEN)))
+    PX(ILEN) = ZFAC*COS(ZTWOPI*ZX(ILEN+1))
+  ENDIF
+  
+IF (LHOOK) CALL DR_HOOK('RANDOM_NUMBERS_MIX:GAUSSIAN_DISTRIBUTION',1,ZHOOK_HANDLE)
+END SUBROUTINE GAUSSIAN_DISTRIBUTION
+!-------------------------------------------------------------------------------
+!!$SUBROUTINE RANDOM_NUMBER_RESTARTFILE( CDFNAME, CDACTION,YD_STREAM )
+!!$!--------------------------------------------------------------------------------
+!!$!
+!!$! read (cdaction='r') or write (cdaction='w') restart file
+!!$! for random number generator
+!!$!
+!!$!--------------------------------------------------------------------------------
+!!$CHARACTER (LEN=*),   INTENT(IN) :: CDFNAME
+!!$CHARACTER (LEN=1  ), INTENT(IN) :: CDACTION
+!!$TYPE(RANDOMNUMBERSTREAM), INTENT(INOUT) :: YD_STREAM
+!!$  
+!!$INTEGER(KIND=JPIM) :: IUNIT, IRET, IBYTES_IN_JPIM
+!!$
+!!$REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!!$IF (LHOOK) CALL DR_HOOK('RANDOM_NUMBERS_MIX:RANDOM_NUMBER_RESTARTFILE',0,ZHOOK_HANDLE)
+!!$IBYTES_IN_JPIM= CEILING(REAL(BIT_SIZE(YD_STREAM%IUSED))/8.0_JPRB - TINY(1.0_JPRB))
+!!$
+!!$IF (IBYTES_IN_JPIM /= 4) THEN
+!!$  CALL ABOR1('random_number_restartfile: number of bytes for JPIM is not 4 ')        
+!!$ENDIF
+!!$
+!!$CALL PBOPEN(IUNIT, CDFNAME, CDACTION, IRET)
+!!$IF (IRET /= 0) THEN
+!!$  CALL ABOR1('random_number_restartfile: PBOPEN FAILED opening '//CDFNAME)    
+!!$ENDIF
+!!$
+!!$
+!!$IF (CDACTION=='r' .OR. CDACTION=='R') THEN
+!!$  CALL PBREAD(IUNIT, YD_STREAM%IX,    IBYTES_IN_JPIM*JPQ, IRET)
+!!$  IF (IRET < 0) THEN
+!!$    CALL ABOR1('random_number_restartfile: PBREAD could not read ix from '//CDFNAME)    
+!!$  ENDIF
+!!$  CALL PBREAD(IUNIT, YD_STREAM%IUSED, IBYTES_IN_JPIM    , IRET)
+!!$  IF (IRET < 0) THEN
+!!$    CALL ABOR1('random_number_restartfile: PBREAD could not read iused from '//CDFNAME)    
+!!$  ENDIF
+!!$
+!!$!  l_initialized = .TRUE.
+!!$  YD_STREAM%INITTEST = INITVALUE
+!!$  YD_STREAM%ZRM=1.0_JPRB/REAL(JPM,JPRB)
+!!$ELSEIF(CDACTION=='w' .OR. CDACTION=='W') THEN
+!!$  CALL PBWRITE(IUNIT, YD_STREAM%IX, IBYTES_IN_JPIM*JPQ, IRET)
+!!$  IF (IRET < 0) THEN
+!!$    CALL ABOR1('random_number_restartfile: PBWRITE could not write ix on '//CDFNAME)    
+!!$  ENDIF
+!!$  CALL PBWRITE(IUNIT, YD_STREAM%IUSED, IBYTES_IN_JPIM , IRET)
+!!$  IF (IRET < 0) THEN
+!!$    CALL ABOR1('random_number_restartfile: PBWRITE could not write iused on '//CDFNAME)    
+!!$  ENDIF
+!!$
+!!$ELSE
+!!$  CALL ABOR1 ('random_number_restartfile: cdaction = '//CDACTION//' is undefined.')
+!!$ENDIF
+!!$
+!!$CALL PBCLOSE(IUNIT, IRET)
+!!$IF (IRET /= 0) THEN
+!!$  CALL ABOR1('random_number_restartfile: PBCLOSE FAILED closing '//CDFNAME)    
+!!$ENDIF
+!!$
+!!$IF (LHOOK) CALL DR_HOOK('RANDOM_NUMBERS_MIX:RANDOM_NUMBER_RESTARTFILE',1,ZHOOK_HANDLE)
+!!$END SUBROUTINE RANDOM_NUMBER_RESTARTFILE
+
+
+SUBROUTINE WR_RANGEN_STATE( KUNIT, YD_STREAM )
+!--------------------------------------------------------------------------------
+! write state of random number generator to unit kunit
+!--------------------------------------------------------------------------------
+INTEGER(KIND=JPIM), INTENT(IN) :: KUNIT
+TYPE(RANDOMNUMBERSTREAM), INTENT(IN) :: YD_STREAM
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('RANDOM_NUMBERS_MIX:WR_RANGEN_STATE',0,ZHOOK_HANDLE)
+WRITE( KUNIT, * ) 'module random_numbers_mix, generator state is'
+WRITE( KUNIT, '(8I10)') YD_STREAM%IX
+WRITE( KUNIT, '(I10)')  YD_STREAM%IUSED
+
+IF (LHOOK) CALL DR_HOOK('RANDOM_NUMBERS_MIX:WR_RANGEN_STATE',1,ZHOOK_HANDLE)
+END SUBROUTINE WR_RANGEN_STATE
+
+END MODULE RANDOM_NUMBERS_MIX
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb1.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb1.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb1.F90	(revision 3908)
@@ -0,0 +1,124 @@
+!***************************************************************************
+SUBROUTINE RRTM_CMBGB1
+!***************************************************************************
+
+!  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-250 cm-1 (low - H2O; high - H2O)
+
+! ABozzo may 2013 update to the last version of rrtmg
+
+!band 1:  10-350 cm-1 (low key - h2o; low minor - n2)
+!                       (high key - h2o; high minor - n2)
+!***************************************************************************
+
+! Parameters
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE YOERRTO1 , ONLY : KAO, KBO, SELFREFO, FORREFO, FRACREFAO,FRACREFBO,KAO_MN2, KBO_MN2
+USE YOERRTA1 , ONLY : KA , KB , SELFREF , FORREF , FRACREFA ,FRACREFB,  KA_MN2, KB_MN2
+USE YOERRTRWT, ONLY : RWGT
+USE YOERRTFTR, ONLY : NGC      ,NGN      
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JP, JT
+
+REAL(KIND=JPRB) :: Z_SUMF1, Z_SUMF2, Z_SUMK, Z_SUMK1, Z_SUMK2
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB1',0,ZHOOK_HANDLE)
+DO JT = 1,5
+  DO JP = 1,13
+    IPRSM = 0
+    DO IGC = 1,NGC(1)
+      Z_SUMK = 0.0_JPRB
+      DO IPR = 1, NGN(IGC)
+        IPRSM = IPRSM + 1
+
+        Z_SUMK = Z_SUMK + KAO(JT,JP,IPRSM)*RWGT(IPRSM)
+      ENDDO
+
+      KA(JT,JP,IGC) = Z_SUMK
+    ENDDO
+  ENDDO
+  DO JP = 13,59
+    IPRSM = 0
+    DO IGC = 1,NGC(1)
+      Z_SUMK = 0.0_JPRB
+      DO IPR = 1, NGN(IGC)
+        IPRSM = IPRSM + 1
+
+        Z_SUMK = Z_SUMK + KBO(JT,JP,IPRSM)*RWGT(IPRSM)
+      ENDDO
+
+      KB(JT,JP,IGC) = Z_SUMK
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JT = 1,10
+  IPRSM = 0
+  DO IGC = 1,NGC(1)
+    Z_SUMK = 0.0_JPRB
+    DO IPR = 1, NGN(IGC)
+      IPRSM = IPRSM + 1
+
+      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM)
+    ENDDO
+
+    SELFREF(JT,IGC) = Z_SUMK
+  ENDDO
+ENDDO
+
+DO JT = 1,4
+         IPRSM = 0
+         DO IGC = 1,NGC(1)
+            Z_SUMK = 0.0_JPRB
+            DO IPR = 1, NGN(IGC)
+               IPRSM = IPRSM + 1
+               Z_SUMK = Z_SUMK + FORREFO(JT,IPRSM)*RWGT(IPRSM)
+            ENDDO
+            FORREF(JT,IGC) = Z_SUMK
+         ENDDO
+      ENDDO
+
+      DO JT = 1,19
+         IPRSM = 0
+         DO IGC = 1,NGC(1)
+            Z_SUMK1 = 0.0_JPRB
+            Z_SUMK2 = 0.0_JPRB
+            DO IPR = 1, NGN(IGC)
+               IPRSM = IPRSM + 1
+               Z_SUMK1 = Z_SUMK1 + KAO_MN2(JT,IPRSM)*RWGT(IPRSM)
+               Z_SUMK2 = Z_SUMK2 + KBO_MN2(JT,IPRSM)*RWGT(IPRSM)
+            ENDDO
+            KA_MN2(JT,IGC) = Z_SUMK1
+            KB_MN2(JT,IGC) = Z_SUMK2
+         ENDDO
+      ENDDO
+
+IPRSM = 0
+DO IGC = 1,NGC(1)
+  Z_SUMF1 = 0.0_JPRB
+  Z_SUMF2 = 0.0_JPRB
+  DO IPR = 1, NGN(IGC)
+    IPRSM = IPRSM + 1
+
+    Z_SUMF1= Z_SUMF1+ FRACREFAO(IPRSM)
+    Z_SUMF2= Z_SUMF2+ FRACREFBO(IPRSM)
+  ENDDO
+
+  FRACREFA(IGC) = Z_SUMF1
+  FRACREFB(IGC) = Z_SUMF2
+ENDDO
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB1',1,ZHOOK_HANDLE)
+END SUBROUTINE RRTM_CMBGB1
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb1.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb1.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb1.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_CMBGB1
+END SUBROUTINE RRTM_CMBGB1
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb10.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb10.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb10.F90	(revision 3908)
@@ -0,0 +1,96 @@
+!***************************************************************************
+SUBROUTINE RRTM_CMBGB10
+!***************************************************************************
+
+!     BAND 10:  1390-1480 cm-1 (low - H2O; high - H2O)
+!     ABozzo updated to rrtmg v4.85
+!***************************************************************************
+
+! Parameters
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE YOERRTO10, ONLY : KAO     ,KBO      ,FRACREFAO   ,FRACREFBO, SELFREFO,FORREFO
+USE YOERRTA10, ONLY : KA      ,KB       ,FRACREFA    ,FRACREFB, SELFREF,FORREF
+USE YOERRTRWT, ONLY : RWGT
+USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN      
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JP, JT
+
+REAL(KIND=JPRB) :: Z_SUMF1, Z_SUMF2, Z_SUMK
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB10',0,ZHOOK_HANDLE)
+DO JT = 1,5
+  DO JP = 1,13
+    IPRSM = 0
+    DO IGC = 1,NGC(10)
+      Z_SUMK = 0.0_JPRB
+      DO IPR = 1, NGN(NGS(9)+IGC)
+        IPRSM = IPRSM + 1
+
+        Z_SUMK = Z_SUMK + KAO(JT,JP,IPRSM)*RWGT(IPRSM+144)
+      ENDDO
+
+      KA(JT,JP,IGC) = Z_SUMK
+    ENDDO
+  ENDDO
+ENDDO
+DO JT = 1,5
+  DO JP = 13,59
+    IPRSM = 0
+    DO IGC = 1,NGC(10)
+      Z_SUMK = 0.0_JPRB
+      DO IPR = 1, NGN(NGS(9)+IGC)
+        IPRSM = IPRSM + 1
+
+        Z_SUMK = Z_SUMK + KBO(JT,JP,IPRSM)*RWGT(IPRSM+144)
+      ENDDO
+
+      KB(JT,JP,IGC) = Z_SUMK
+    ENDDO
+  ENDDO
+ENDDO
+
+  DO JT = 1,10
+         IPRSM = 0
+         DO IGC = 1,NGC(10)
+            Z_SUMK = 0.0_JPRB
+            DO IPR = 1, NGN(NGS(9)+IGC)
+               IPRSM = IPRSM + 1
+               Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+144)
+            ENDDO
+            SELFREF(JT,IGC) = Z_SUMK
+         ENDDO
+      ENDDO
+
+      DO JT = 1,4
+         IPRSM = 0
+         DO IGC = 1,NGC(10)
+            Z_SUMK = 0.0_JPRB
+            DO IPR = 1, NGN(NGS(9)+IGC)
+               IPRSM = IPRSM + 1
+               Z_SUMK = Z_SUMK + FORREFO(JT,IPRSM)*RWGT(IPRSM+144)
+            ENDDO
+            FORREF(JT,IGC) = Z_SUMK
+         ENDDO
+      ENDDO
+
+      IPRSM = 0
+      DO IGC = 1,NGC(10)
+         Z_SUMF1= 0.0_JPRB
+         Z_SUMF2= 0.0_JPRB
+         DO IPR = 1, NGN(NGS(9)+IGC)
+            IPRSM = IPRSM + 1
+            Z_SUMF1= Z_SUMF1+ FRACREFAO(IPRSM)
+            Z_SUMF2= Z_SUMF2+ FRACREFBO(IPRSM)
+         ENDDO
+         FRACREFA(IGC) = Z_SUMF1
+         FRACREFB(IGC) = Z_SUMF2
+      ENDDO
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB10',1,ZHOOK_HANDLE)
+END SUBROUTINE RRTM_CMBGB10
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb10.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb10.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb10.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_CMBGB10
+END SUBROUTINE RRTM_CMBGB10
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb11.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb11.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb11.F90	(revision 3908)
@@ -0,0 +1,117 @@
+!***************************************************************************
+SUBROUTINE RRTM_CMBGB11
+!***************************************************************************
+
+!     BAND 11:  1480-1800 cm-1 (low - H2O; high - H2O)
+!     ABozzo updated to rrtmg v4.85
+!     band 11:  1480-1800 cm-1 (low - h2o; low minor - o2)
+!                              (high key - h2o; high minor - o2)
+!***************************************************************************
+
+! Parameters
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE YOERRTO11, ONLY : KAO     ,KBO     ,SELFREFO,FORREFO    ,FRACREFAO ,FRACREFBO, &
+                    & KAO_MO2, KBO_MO2
+USE YOERRTA11, ONLY : KA      ,KB      ,SELFREF,FORREF     ,FRACREFA  ,FRACREFB, &
+                    & KA_MO2, KB_MO2
+USE YOERRTRWT, ONLY : RWGT
+USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN      
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JP, JT
+
+REAL(KIND=JPRB) :: Z_SUMF1, Z_SUMF2, Z_SUMK,Z_SUMK1,Z_SUMK2
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB11',0,ZHOOK_HANDLE)
+DO JT = 1,5
+  DO JP = 1,13
+    IPRSM = 0
+    DO IGC = 1,NGC(11)
+      Z_SUMK = 0.0_JPRB
+      DO IPR = 1, NGN(NGS(10)+IGC)
+        IPRSM = IPRSM + 1
+
+        Z_SUMK = Z_SUMK + KAO(JT,JP,IPRSM)*RWGT(IPRSM+160)
+      ENDDO
+
+      KA(JT,JP,IGC) = Z_SUMK
+    ENDDO
+  ENDDO
+ENDDO
+DO JT = 1,5
+  DO JP = 13,59
+    IPRSM = 0
+    DO IGC = 1,NGC(11)
+      Z_SUMK = 0.0_JPRB
+      DO IPR = 1, NGN(NGS(10)+IGC)
+        IPRSM = IPRSM + 1
+
+        Z_SUMK = Z_SUMK + KBO(JT,JP,IPRSM)*RWGT(IPRSM+160)
+      ENDDO
+
+      KB(JT,JP,IGC) = Z_SUMK
+    ENDDO
+  ENDDO
+ENDDO
+
+      DO JT = 1,19
+         IPRSM = 0
+         DO IGC = 1,NGC(11)
+            Z_SUMK1 = 0.0_JPRB
+            Z_SUMK2 = 0.0_JPRB
+            DO IPR = 1, NGN(NGS(10)+IGC)
+               IPRSM = IPRSM + 1
+               Z_SUMK1 = Z_SUMK1 + KAO_MO2(JT,IPRSM)*RWGT(IPRSM+160)
+               Z_SUMK2 = Z_SUMK2 + KBO_MO2(JT,IPRSM)*RWGT(IPRSM+160)
+            ENDDO
+            KA_MO2(JT,IGC) = Z_SUMK1
+            KB_MO2(JT,IGC) = Z_SUMK2
+         ENDDO
+      ENDDO
+
+
+DO JT = 1,10
+  IPRSM = 0
+  DO IGC = 1,NGC(11)
+    Z_SUMK = 0.0_JPRB
+    DO IPR = 1, NGN(NGS(10)+IGC)
+      IPRSM = IPRSM + 1
+
+      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+160)
+    ENDDO
+
+    SELFREF(JT,IGC) = Z_SUMK
+  ENDDO
+ENDDO
+
+DO JT = 1,4
+         IPRSM = 0
+         DO IGC = 1,NGC(11)
+            Z_SUMK = 0.0_JPRB
+            DO IPR = 1, NGN(NGS(10)+IGC)
+               IPRSM = IPRSM + 1
+               Z_SUMK = Z_SUMK + FORREFO(JT,IPRSM)*RWGT(IPRSM+160)
+            ENDDO
+            FORREF(JT,IGC) = Z_SUMK
+         ENDDO
+ENDDO
+
+IPRSM = 0
+DO IGC = 1,NGC(11)
+         Z_SUMF1= 0.0_JPRB
+         Z_SUMF2= 0.0_JPRB
+   DO IPR = 1, NGN(NGS(10)+IGC)
+            IPRSM = IPRSM + 1
+            Z_SUMF1= Z_SUMF1+ FRACREFAO(IPRSM)
+            Z_SUMF2= Z_SUMF2+ FRACREFBO(IPRSM)
+   ENDDO
+         FRACREFA(IGC) = Z_SUMF1
+         FRACREFB(IGC) = Z_SUMF2
+ ENDDO
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB11',1,ZHOOK_HANDLE)
+END SUBROUTINE RRTM_CMBGB11
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb11.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb11.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb11.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_CMBGB11
+END SUBROUTINE RRTM_CMBGB11
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb12.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb12.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb12.F90	(revision 3908)
@@ -0,0 +1,86 @@
+!***************************************************************************
+SUBROUTINE RRTM_CMBGB12
+!***************************************************************************
+
+!     BAND 12:  1800-2080 cm-1 (low - H2O,CO2; high - nothing)
+!     ABozzo updated to rrtmg v4.85
+!***************************************************************************
+
+! Parameters
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE YOERRTO12, ONLY : KAO     ,SELFREFO, FORREFO   ,FRACREFAO
+USE YOERRTA12, ONLY : KA      ,SELFREF, FORREF    ,FRACREFA
+USE YOERRTRWT, ONLY : RWGT
+USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN      
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JN, JP, JT
+
+REAL(KIND=JPRB) :: Z_SUMF, Z_SUMK
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB12',0,ZHOOK_HANDLE)
+DO JN = 1,9
+  DO JT = 1,5
+    DO JP = 1,13
+      IPRSM = 0
+      DO IGC = 1,NGC(12)
+        Z_SUMK = 0.0_JPRB
+        DO IPR = 1, NGN(NGS(11)+IGC)
+          IPRSM = IPRSM + 1
+
+          Z_SUMK = Z_SUMK + KAO(JN,JT,JP,IPRSM)*RWGT(IPRSM+176)
+        ENDDO
+
+        KA(JN,JT,JP,IGC) = Z_SUMK
+      ENDDO
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JT = 1,10
+  IPRSM = 0
+  DO IGC = 1,NGC(12)
+    Z_SUMK = 0.0_JPRB
+    DO IPR = 1, NGN(NGS(11)+IGC)
+      IPRSM = IPRSM + 1
+
+      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+176)
+    ENDDO
+
+    SELFREF(JT,IGC) = Z_SUMK
+  ENDDO
+ENDDO
+
+DO JT = 1,4
+    IPRSM = 0
+    DO IGC = 1,NGC(12)
+       Z_SUMK = 0.0_JPRB
+       DO IPR = 1, NGN(NGS(11)+IGC)
+          IPRSM = IPRSM + 1
+          Z_SUMK = Z_SUMK + FORREFO(JT,IPRSM)*RWGT(IPRSM+176)
+       ENDDO
+       FORREF(JT,IGC) = Z_SUMK
+    ENDDO
+ENDDO
+
+
+DO JP = 1,9
+  IPRSM = 0
+  DO IGC = 1,NGC(12)
+    Z_SUMF = 0.0_JPRB
+    DO IPR = 1, NGN(NGS(11)+IGC)
+      IPRSM = IPRSM + 1
+
+      Z_SUMF = Z_SUMF + FRACREFAO(IPRSM,JP)
+    ENDDO
+
+    FRACREFA(IGC,JP) = Z_SUMF
+  ENDDO
+ENDDO
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB12',1,ZHOOK_HANDLE)
+END SUBROUTINE RRTM_CMBGB12
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb12.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb12.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb12.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_CMBGB12
+END SUBROUTINE RRTM_CMBGB12
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb13.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb13.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb13.F90	(revision 3908)
@@ -0,0 +1,129 @@
+!***************************************************************************
+SUBROUTINE RRTM_CMBGB13
+!***************************************************************************
+
+!     BAND 13:  2080-2250 cm-1 (low - H2O,N2O; high - nothing)
+!     ABozzo 201306 updated to rrtmg v4.85
+!     band 13:  2080-2250 cm-1 (low key - h2o,n2o; high minor - o3 minor)
+!***************************************************************************
+
+! Parameters
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE YOERRTO13, ONLY : KAO     ,SELFREFO, FORREFO   ,FRACREFAO, FRACREFBO, &
+                     & KAO_MCO2, KAO_MCO, KBO_MO3
+USE YOERRTA13, ONLY : KA      ,SELFREF, FORREF    ,FRACREFA, FRACREFB, &
+                     & KA_MCO2, KA_MCO, KB_MO3
+USE YOERRTRWT, ONLY : RWGT
+USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN      
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JN, JP, JT
+
+REAL(KIND=JPRB) :: Z_SUMF, Z_SUMK, Z_SUMK1, Z_SUMK2
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB13',0,ZHOOK_HANDLE)
+DO JN = 1,9
+  DO JT = 1,5
+    DO JP = 1,13
+      IPRSM = 0
+      DO IGC = 1,NGC(13)
+        Z_SUMK = 0.0_JPRB
+        DO IPR = 1, NGN(NGS(12)+IGC)
+          IPRSM = IPRSM + 1
+
+          Z_SUMK = Z_SUMK + KAO(JN,JT,JP,IPRSM)*RWGT(IPRSM+192)
+        ENDDO
+
+        KA(JN,JT,JP,IGC) = Z_SUMK
+      ENDDO
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JN = 1,9
+   DO JT = 1,19
+      IPRSM = 0
+      DO IGC = 1,NGC(13)
+        Z_SUMK1 = 0.0_JPRB
+        Z_SUMK2 = 0.0_JPRB
+         DO IPR = 1, NGN(NGS(12)+IGC)
+            IPRSM = IPRSM + 1
+            Z_SUMK1 = Z_SUMK1 + KAO_MCO2(JN,JT,IPRSM)*RWGT(IPRSM+192)
+            Z_SUMK2 = Z_SUMK2 + KAO_MCO(JN,JT,IPRSM)*RWGT(IPRSM+192)
+         ENDDO
+         KA_MCO2(JN,JT,IGC) = Z_SUMK1
+         KA_MCO(JN,JT,IGC) = Z_SUMK2
+      ENDDO
+   ENDDO
+ENDDO
+
+DO JT = 1,19
+   IPRSM = 0
+   DO IGC = 1,NGC(13)
+      Z_SUMK = 0.0_JPRB
+      DO IPR = 1, NGN(NGS(12)+IGC)
+         IPRSM = IPRSM + 1
+         Z_SUMK = Z_SUMK + KBO_MO3(JT,IPRSM)*RWGT(IPRSM+192)
+      ENDDO
+      KB_MO3(JT,IGC) = Z_SUMK
+   ENDDO
+ENDDO
+
+
+DO JT = 1,10
+  IPRSM = 0
+  DO IGC = 1,NGC(13)
+    Z_SUMK = 0.0_JPRB
+    DO IPR = 1, NGN(NGS(12)+IGC)
+      IPRSM = IPRSM + 1
+
+      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+192)
+    ENDDO
+
+    SELFREF(JT,IGC) = Z_SUMK
+  ENDDO
+ENDDO
+
+DO JT = 1,4
+   IPRSM = 0
+   DO IGC = 1,NGC(13)
+      Z_SUMK = 0.0_JPRB
+      DO IPR = 1, NGN(NGS(12)+IGC)
+         IPRSM = IPRSM + 1
+         Z_SUMK = Z_SUMK + FORREFO(JT,IPRSM)*RWGT(IPRSM+192)
+      ENDDO
+      FORREF(JT,IGC) = Z_SUMK
+   ENDDO
+ENDDO
+
+IPRSM = 0
+DO IGC = 1,NGC(13)
+   Z_SUMF = 0.0_JPRB
+   DO IPR = 1, NGN(NGS(12)+IGC)
+      IPRSM = IPRSM + 1
+      Z_SUMF = Z_SUMF + FRACREFBO(IPRSM)
+   ENDDO
+   FRACREFB(IGC) = Z_SUMF
+ENDDO
+
+DO JP = 1,9
+  IPRSM = 0
+  DO IGC = 1,NGC(13)
+    Z_SUMF = 0.0_JPRB
+    DO IPR = 1, NGN(NGS(12)+IGC)
+      IPRSM = IPRSM + 1
+
+      Z_SUMF = Z_SUMF + FRACREFAO(IPRSM,JP)
+    ENDDO
+
+    FRACREFA(IGC,JP) = Z_SUMF
+  ENDDO
+ENDDO
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB13',1,ZHOOK_HANDLE)
+END SUBROUTINE RRTM_CMBGB13
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb13.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb13.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb13.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_CMBGB13
+END SUBROUTINE RRTM_CMBGB13
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb14.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb14.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb14.F90	(revision 3908)
@@ -0,0 +1,101 @@
+!***************************************************************************
+SUBROUTINE RRTM_CMBGB14
+!***************************************************************************
+
+!     BAND 14:  2250-2380 cm-1 (low - CO2; high - CO2)
+!     ABozzo 201306 updated to rrtmg v4.85
+!***************************************************************************
+
+! Parameters
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE YOERRTO14, ONLY : KAO     ,KBO     ,SELFREFO, FORREFO   ,FRACREFAO  ,FRACREFBO
+USE YOERRTA14, ONLY : KA      ,KB      ,SELFREF,  FORREF    ,FRACREFA   ,FRACREFB
+USE YOERRTRWT, ONLY : RWGT 
+USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN      
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JP, JT
+
+REAL(KIND=JPRB) :: Z_SUMF1, Z_SUMF2, Z_SUMK
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB14',0,ZHOOK_HANDLE)
+DO JT = 1,5
+  DO JP = 1,13
+    IPRSM = 0
+    DO IGC = 1,NGC(14)
+      Z_SUMK = 0.0_JPRB
+      DO IPR = 1, NGN(NGS(13)+IGC)
+        IPRSM = IPRSM + 1
+
+        Z_SUMK = Z_SUMK + KAO(JT,JP,IPRSM)*RWGT(IPRSM+208)
+      ENDDO
+
+      KA(JT,JP,IGC) = Z_SUMK
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JT = 1,5
+  DO JP = 13,59
+    IPRSM = 0
+    DO IGC = 1,NGC(14)
+      Z_SUMK = 0.0_JPRB
+      DO IPR = 1, NGN(NGS(13)+IGC)
+        IPRSM = IPRSM + 1
+
+        Z_SUMK = Z_SUMK + KBO(JT,JP,IPRSM)*RWGT(IPRSM+208)
+      ENDDO
+
+      KB(JT,JP,IGC) = Z_SUMK
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JT = 1,10
+  IPRSM = 0
+  DO IGC = 1,NGC(14)
+    Z_SUMK = 0.0_JPRB
+    DO IPR = 1, NGN(NGS(13)+IGC)
+      IPRSM = IPRSM + 1
+
+      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+208)
+    ENDDO
+
+    SELFREF(JT,IGC) = Z_SUMK
+  ENDDO
+ENDDO
+
+DO JT = 1,4
+   IPRSM = 0
+   DO IGC = 1,NGC(14)
+      Z_SUMK = 0.0_JPRB
+      DO IPR = 1, NGN(NGS(13)+IGC)
+         IPRSM = IPRSM + 1
+         Z_SUMK = Z_SUMK + FORREFO(JT,IPRSM)*RWGT(IPRSM+208)
+      ENDDO
+      FORREF(JT,IGC) = Z_SUMK
+   ENDDO
+ENDDO
+
+IPRSM = 0
+DO IGC = 1,NGC(14)
+  Z_SUMF1= 0.0_JPRB
+  Z_SUMF2= 0.0_JPRB
+  DO IPR = 1, NGN(NGS(13)+IGC)
+    IPRSM = IPRSM + 1
+
+    Z_SUMF1= Z_SUMF1+ FRACREFAO(IPRSM)
+    Z_SUMF2= Z_SUMF2+ FRACREFBO(IPRSM)
+  ENDDO
+
+  FRACREFA(IGC) = Z_SUMF1
+  FRACREFB(IGC) = Z_SUMF2
+ENDDO
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB14',1,ZHOOK_HANDLE)
+END SUBROUTINE RRTM_CMBGB14
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb14.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb14.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb14.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_CMBGB14
+END SUBROUTINE RRTM_CMBGB14
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb15.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb15.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb15.F90	(revision 3908)
@@ -0,0 +1,102 @@
+!***************************************************************************
+SUBROUTINE RRTM_CMBGB15
+!***************************************************************************
+
+!     BAND 15:  2380-2600 cm-1 (low - N2O,CO2; high - nothing)
+!     ABozzo 2001306 updated to rrtmg v4.85
+!     band 15:  2380-2600 cm-1 (low - n2o,co2; low minor - n2)
+!                              (high - nothing)
+!***************************************************************************
+
+! Parameters
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE YOERRTO15, ONLY : KAO     ,KAO_MN2,SELFREFO,FORREFO   ,FRACREFAO
+USE YOERRTA15, ONLY : KA      ,KA_MN2,SELFREF,FORREF    ,FRACREFA
+USE YOERRTRWT, ONLY : RWGT
+USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN      
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JN, JP, JT
+
+REAL(KIND=JPRB) :: Z_SUMF, Z_SUMK
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB15',0,ZHOOK_HANDLE)
+DO JN = 1,9
+  DO JT = 1,5
+    DO JP = 1,13
+      IPRSM = 0
+      DO IGC = 1,NGC(15)
+        Z_SUMK = 0.0_JPRB
+        DO IPR = 1, NGN(NGS(14)+IGC)
+          IPRSM = IPRSM + 1
+
+          Z_SUMK = Z_SUMK + KAO(JN,JT,JP,IPRSM)*RWGT(IPRSM+224)
+        ENDDO
+
+        KA(JN,JT,JP,IGC) = Z_SUMK
+      ENDDO
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JN = 1,9
+   DO JT = 1,19
+      IPRSM = 0
+      DO IGC = 1,NGC(15)
+        Z_SUMK = 0.0_JPRB
+         DO IPR = 1, NGN(NGS(14)+IGC)
+            IPRSM = IPRSM + 1
+            Z_SUMK = Z_SUMK + KAO_MN2(JN,JT,IPRSM)*RWGT(IPRSM+224)
+         ENDDO
+         KA_MN2(JN,JT,IGC) = Z_SUMK
+      ENDDO
+   ENDDO
+ENDDO
+
+DO JT = 1,10
+  IPRSM = 0
+  DO IGC = 1,NGC(15)
+    Z_SUMK = 0.0_JPRB
+    DO IPR = 1, NGN(NGS(14)+IGC)
+      IPRSM = IPRSM + 1
+
+      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+224)
+    ENDDO
+
+    SELFREF(JT,IGC) = Z_SUMK
+  ENDDO
+ENDDO
+
+DO JT = 1,4
+   IPRSM = 0
+   DO IGC = 1,NGC(15)
+      Z_SUMK = 0.0_JPRB
+      DO IPR = 1, NGN(NGS(14)+IGC)
+         IPRSM = IPRSM + 1
+         Z_SUMK = Z_SUMK + FORREFO(JT,IPRSM)*RWGT(IPRSM+224)
+      ENDDO
+      FORREF(JT,IGC) = Z_SUMK
+   ENDDO
+ENDDO
+
+DO JP = 1,9
+  IPRSM = 0
+  DO IGC = 1,NGC(15)
+    Z_SUMF = 0.0_JPRB
+    DO IPR = 1, NGN(NGS(14)+IGC)
+      IPRSM = IPRSM + 1
+
+      Z_SUMF = Z_SUMF + FRACREFAO(IPRSM,JP)
+    ENDDO
+
+    FRACREFA(IGC,JP) = Z_SUMF
+  ENDDO
+ENDDO
+
+ 
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB15',1,ZHOOK_HANDLE)
+END SUBROUTINE RRTM_CMBGB15
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb15.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb15.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb15.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_CMBGB15
+END SUBROUTINE RRTM_CMBGB15
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb16.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb16.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb16.F90	(revision 3908)
@@ -0,0 +1,112 @@
+!***************************************************************************
+SUBROUTINE RRTM_CMBGB16
+!***************************************************************************
+
+!     BAND 16:  2600-3000 cm-1 (low - H2O,CH4; high - nothing)
+!     ABozzo 201306 updated to rrtmg v4.85
+!     band 16:  2600-3250 cm-1 (low key- h2o,ch4; high key - ch4)
+!***************************************************************************
+
+! Parameters
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE YOERRTO16, ONLY : KAO,KBO   ,SELFREFO,FORREFO  ,FRACREFAO,FRACREFBO
+USE YOERRTA16, ONLY : KA,KB     ,SELFREF,FORREF    ,FRACREFA,FRACREFB
+USE YOERRTRWT, ONLY : RWGT
+USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN      
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JN, JP, JT
+
+REAL(KIND=JPRB) :: Z_SUMF, Z_SUMK
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB16',0,ZHOOK_HANDLE)
+DO JN = 1,9
+  DO JT = 1,5
+    DO JP = 1,13
+      IPRSM = 0
+      DO IGC = 1,NGC(16)
+        Z_SUMK = 0.0_JPRB
+        DO IPR = 1, NGN(NGS(15)+IGC)
+          IPRSM = IPRSM + 1
+
+          Z_SUMK = Z_SUMK + KAO(JN,JT,JP,IPRSM)*RWGT(IPRSM+240)
+        ENDDO
+
+        KA(JN,JT,JP,IGC) = Z_SUMK
+      ENDDO
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JT = 1,5
+   DO JP = 13,59
+      IPRSM = 0
+      DO IGC = 1,NGC(16)
+         Z_SUMK = 0.0_JPRB
+         DO IPR = 1, NGN(NGS(15)+IGC)
+            IPRSM = IPRSM + 1
+            Z_SUMK = Z_SUMK + KBO(JT,JP,IPRSM)*RWGT(IPRSM+240)
+         ENDDO
+         KB(JT,JP,IGC) = Z_SUMK
+      ENDDO
+   ENDDO
+ENDDO
+
+
+DO JT = 1,10
+  IPRSM = 0
+  DO IGC = 1,NGC(16)
+    Z_SUMK = 0.0_JPRB
+    DO IPR = 1, NGN(NGS(15)+IGC)
+      IPRSM = IPRSM + 1
+
+      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+240)
+    ENDDO
+
+    SELFREF(JT,IGC) = Z_SUMK
+  ENDDO
+ENDDO
+
+DO JT = 1,4
+   IPRSM = 0
+   DO IGC = 1,NGC(16)
+      Z_SUMK = 0.0_JPRB
+      DO IPR = 1, NGN(NGS(15)+IGC)
+         IPRSM = IPRSM + 1
+         Z_SUMK = Z_SUMK + FORREFO(JT,IPRSM)*RWGT(IPRSM+240)
+      ENDDO
+      FORREF(JT,IGC) = Z_SUMK
+   ENDDO
+ENDDO
+
+IPRSM = 0
+DO IGC = 1,NGC(16)
+   Z_SUMF = 0.0_JPRB
+   DO IPR = 1, NGN(NGS(15)+IGC)
+      IPRSM = IPRSM + 1
+      Z_SUMF = Z_SUMF + FRACREFBO(IPRSM)
+   ENDDO
+   FRACREFB(IGC) = Z_SUMF
+ENDDO
+
+DO JP = 1,9
+  IPRSM = 0
+  DO IGC = 1,NGC(16)
+    Z_SUMF = 0.0_JPRB
+    DO IPR = 1, NGN(NGS(15)+IGC)
+      IPRSM = IPRSM + 1
+
+      Z_SUMF = Z_SUMF + FRACREFAO(IPRSM,JP)
+    ENDDO
+
+    FRACREFA(IGC,JP) = Z_SUMF
+  ENDDO
+ENDDO
+
+ 
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB16',1,ZHOOK_HANDLE)
+END SUBROUTINE RRTM_CMBGB16
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb16.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb16.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb16.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_CMBGB16
+END SUBROUTINE RRTM_CMBGB16
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb2.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb2.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb2.F90	(revision 3908)
@@ -0,0 +1,118 @@
+!***************************************************************************
+SUBROUTINE RRTM_CMBGB2
+!***************************************************************************
+
+!     BAND 2:  250-500 cm-1 (low - H2O; high - H2O)
+! ABozzo May 2013 updated to last version of rrtmg
+!     band 2:  350-500 cm-1 (low key - h2o; high key - h2o)
+!***************************************************************************
+
+! Parameters
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE YOERRTO2 , ONLY : KAO     ,KBO     ,SELFREFO   ,FRACREFAO  ,&
+ & FRACREFBO  ,FORREFO  
+USE YOERRTA2 , ONLY : KA      ,KB      ,SELFREF    ,FRACREFA   ,&
+ & FRACREFB   ,FORREF       
+USE YOERRTRWT, ONLY : RWGT
+USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN      
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JP, JT
+
+REAL(KIND=JPRB) :: Z_SUMF, Z_SUMK
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB2',0,ZHOOK_HANDLE)
+DO JT = 1,5
+  DO JP = 1,13
+    IPRSM = 0
+    DO IGC = 1,NGC(2)
+      Z_SUMK = 0.0_JPRB
+      DO IPR = 1, NGN(NGS(1)+IGC)
+        IPRSM = IPRSM + 1
+
+        Z_SUMK = Z_SUMK + KAO(JT,JP,IPRSM)*RWGT(IPRSM+16)
+      ENDDO
+
+      KA(JT,JP,IGC) = Z_SUMK
+    ENDDO
+  ENDDO
+  DO JP = 13,59
+    IPRSM = 0
+    DO IGC = 1,NGC(2)
+      Z_SUMK = 0.0_JPRB
+      DO IPR = 1, NGN(NGS(1)+IGC)
+        IPRSM = IPRSM + 1
+
+        Z_SUMK = Z_SUMK + KBO(JT,JP,IPRSM)*RWGT(IPRSM+16)
+      ENDDO
+!               KBC(JT,JP,IGC) = SUMK
+      KB(JT,JP,IGC) = Z_SUMK
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JT = 1,10
+  IPRSM = 0
+  DO IGC = 1,NGC(2)
+    Z_SUMK = 0.0_JPRB
+    DO IPR = 1, NGN(NGS(1)+IGC)
+      IPRSM = IPRSM + 1
+
+      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+16)
+    ENDDO
+
+    SELFREF(JT,IGC) = Z_SUMK
+  ENDDO
+ENDDO
+
+DO JT = 1,4
+   IPRSM = 0
+   DO IGC = 1,NGC(2)
+      Z_SUMK = 0.0_JPRB
+        DO IPR = 1, NGN(NGS(1)+IGC)
+           IPRSM = IPRSM + 1
+           Z_SUMK = Z_SUMK + FORREFO(JT,IPRSM)*RWGT(IPRSM+16)
+        ENDDO
+      FORREF(JT,IGC) = Z_SUMK
+   ENDDO
+ENDDO
+
+
+IPRSM = 0
+DO IGC = 1,NGC(2)
+  Z_SUMK = 0.0_JPRB
+  Z_SUMF = 0.0_JPRB
+  DO IPR = 1, NGN(NGS(1)+IGC)
+    IPRSM = IPRSM + 1
+
+    Z_SUMK = Z_SUMK + FRACREFAO(IPRSM)
+    Z_SUMF = Z_SUMF + FRACREFBO(IPRSM)
+  ENDDO
+
+  FRACREFA(IGC) = Z_SUMK
+  FRACREFB(IGC) = Z_SUMF
+ENDDO
+
+!DO JP = 1,13
+!  DO IGC = 1,NGC(2)
+
+!    FREFA(NGS(1)+IGC,JP) = FRACREFA(IGC,JP)
+!  ENDDO
+!ENDDO
+!DO JP = 2,13
+!  DO IGC = 1,NGC(2)
+
+!    FREFADF(NGS(1)+IGC,JP) = FRACREFA(IGC,JP-1) -FRACREFA(IGC,JP)
+!  ENDDO
+!ENDDO
+!DO IGC = 1,NGC(2)
+
+!  FREFB(NGS(1)+IGC,1) = FRACREFB(IGC)
+!ENDDO
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB2',1,ZHOOK_HANDLE)
+END SUBROUTINE RRTM_CMBGB2
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb2.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb2.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb2.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_CMBGB2
+END SUBROUTINE RRTM_CMBGB2
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb3.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb3.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb3.F90	(revision 3908)
@@ -0,0 +1,149 @@
+!***************************************************************************
+SUBROUTINE RRTM_CMBGB3
+!***************************************************************************
+
+!     BAND 3:  500-630 cm-1 (low - H2O,CO2; high - H2O,CO2)
+!      ABozzo 200130517 updated to rrtmg_lw_v4.85:
+!     band 3:  500-630 cm-1 (low key - h2o,co2; low minor - n2o)
+!                           (high key - h2o,co2; high minor - n2o)
+!***************************************************************************
+
+! Parameters
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE YOERRTO3 , ONLY : KAO     ,KBO     ,SELFREFO   ,FRACREFAO  ,&
+ & FRACREFBO  ,FORREFO    ,KAO_MN2O   ,KBO_MN2O  
+USE YOERRTA3 , ONLY : KA      ,KB      ,SELFREF    ,FRACREFA   ,&
+ & FRACREFB   ,FORREF    ,KA_MN2O   ,KB_MN2O  
+USE YOERRTRWT, ONLY : RWGT
+USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN      
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JN, JP, JT
+
+REAL(KIND=JPRB) :: Z_SUMF, Z_SUMK
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB3',0,ZHOOK_HANDLE)
+DO JN = 1,9
+  DO JT = 1,5
+    DO JP = 1,13
+      IPRSM = 0
+      DO IGC = 1,NGC(3)
+        Z_SUMK = 0.0_JPRB
+        DO IPR = 1, NGN(NGS(2)+IGC)
+          IPRSM = IPRSM + 1
+
+          Z_SUMK = Z_SUMK + KAO(JN,JT,JP,IPRSM)*RWGT(IPRSM+32)
+        ENDDO
+
+        KA(JN,JT,JP,IGC) = Z_SUMK
+      ENDDO
+    ENDDO
+  ENDDO
+ENDDO
+DO JN = 1,5
+  DO JT = 1,5
+    DO JP = 13,59
+      IPRSM = 0
+      DO IGC = 1,NGC(3)
+        Z_SUMK = 0.0_JPRB
+        DO IPR = 1, NGN(NGS(2)+IGC)
+          IPRSM = IPRSM + 1
+
+          Z_SUMK = Z_SUMK + KBO(JN,JT,JP,IPRSM)*RWGT(IPRSM+32)
+        ENDDO
+
+        KB(JN,JT,JP,IGC) = Z_SUMK
+      ENDDO
+    ENDDO
+  ENDDO
+ENDDO
+
+    DO JN = 1,9
+         DO JT = 1,19
+            IPRSM = 0
+            DO IGC = 1,NGC(3)
+              Z_SUMK = 0.
+               DO IPR = 1, NGN(NGS(2)+IGC)
+                  IPRSM = IPRSM + 1
+                  Z_SUMK = Z_SUMK + KAO_MN2O(JN,JT,IPRSM)*RWGT(IPRSM+32)
+               ENDDO
+               KA_MN2O(JN,JT,IGC) = Z_SUMK
+            ENDDO
+         ENDDO
+      ENDDO
+
+      DO JN = 1,5
+         DO JT = 1,19
+            IPRSM = 0
+            DO IGC = 1,NGC(3)
+              Z_SUMK = 0.
+               DO IPR = 1, NGN(NGS(2)+IGC)
+                  IPRSM = IPRSM + 1
+                  Z_SUMK = Z_SUMK + KBO_MN2O(JN,JT,IPRSM)*RWGT(IPRSM+32)
+               ENDDO
+               KB_MN2O(JN,JT,IGC) = Z_SUMK
+            ENDDO
+         ENDDO
+      ENDDO
+
+
+
+DO JT = 1,10
+  IPRSM = 0
+  DO IGC = 1,NGC(3)
+    Z_SUMK = 0.0_JPRB
+    DO IPR = 1, NGN(NGS(2)+IGC)
+      IPRSM = IPRSM + 1
+      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+32)
+    ENDDO
+    SELFREF(JT,IGC) = Z_SUMK
+  ENDDO
+ENDDO
+
+      DO JT = 1,4
+         IPRSM = 0
+         DO IGC = 1,NGC(3)
+            Z_SUMK = 0.
+            DO IPR = 1, NGN(NGS(2)+IGC)
+               IPRSM = IPRSM + 1
+               Z_SUMK = Z_SUMK + FORREFO(JT,IPRSM)*RWGT(IPRSM+32)
+            ENDDO
+            FORREF(JT,IGC) = Z_SUMK
+         ENDDO
+      ENDDO
+
+      DO JP = 1,9
+         IPRSM = 0
+         DO IGC = 1,NGC(3)
+            Z_SUMF = 0.
+            DO IPR = 1, NGN(NGS(2)+IGC)
+               IPRSM = IPRSM + 1
+               Z_SUMF = Z_SUMF + FRACREFAO(IPRSM,JP)
+            ENDDO
+            FRACREFA(IGC,JP) = Z_SUMF
+         ENDDO
+      ENDDO
+
+
+
+DO JP = 1,5
+  IPRSM = 0
+  DO IGC = 1,NGC(3)
+    Z_SUMF = 0.0_JPRB
+    DO IPR = 1, NGN(NGS(2)+IGC)
+      IPRSM = IPRSM + 1
+
+      Z_SUMF = Z_SUMF + FRACREFBO(IPRSM,JP)
+    ENDDO
+
+    FRACREFB(IGC,JP) = Z_SUMF
+  ENDDO
+ENDDO
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB3',1,ZHOOK_HANDLE)
+END SUBROUTINE RRTM_CMBGB3
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb3.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb3.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb3.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_CMBGB3
+END SUBROUTINE RRTM_CMBGB3
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb4.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb4.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb4.F90	(revision 3908)
@@ -0,0 +1,117 @@
+!***************************************************************************
+SUBROUTINE RRTM_CMBGB4
+!***************************************************************************
+
+!     BAND 4:  630-700 cm-1 (low - H2O,CO2; high - O3,CO2)
+!     ABozzo 201306 updated to rrtmg v4.85
+!***************************************************************************
+
+! Parameters
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE YOERRTO4 , ONLY : KAO     ,KBO     ,SELFREFO   , FORREFO, FRACREFAO  ,FRACREFBO
+USE YOERRTA4 , ONLY : KA      ,KB      ,SELFREF    , FORREF, FRACREFA   ,FRACREFB
+USE YOERRTRWT, ONLY : RWGT
+USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN      
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JN, JP, JT
+
+REAL(KIND=JPRB) :: Z_SUMF, Z_SUMK
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB4',0,ZHOOK_HANDLE)
+DO JN = 1,9
+  DO JT = 1,5
+    DO JP = 1,13
+      IPRSM = 0
+      DO IGC = 1,NGC(4)
+        Z_SUMK = 0.0_JPRB
+        DO IPR = 1, NGN(NGS(3)+IGC)
+          IPRSM = IPRSM + 1
+
+          Z_SUMK = Z_SUMK + KAO(JN,JT,JP,IPRSM)*RWGT(IPRSM+48)
+        ENDDO
+
+        KA(JN,JT,JP,IGC) = Z_SUMK
+      ENDDO
+    ENDDO
+  ENDDO
+ENDDO
+DO JN = 1,5
+  DO JT = 1,5
+    DO JP = 13,59
+      IPRSM = 0
+      DO IGC = 1,NGC(4)
+        Z_SUMK = 0.0_JPRB
+        DO IPR = 1, NGN(NGS(3)+IGC)
+          IPRSM = IPRSM + 1
+
+          Z_SUMK = Z_SUMK + KBO(JN,JT,JP,IPRSM)*RWGT(IPRSM+48)
+        ENDDO
+
+        KB(JN,JT,JP,IGC) = Z_SUMK
+      ENDDO
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JT = 1,10
+  IPRSM = 0
+  DO IGC = 1,NGC(4)
+    Z_SUMK = 0.0_JPRB
+    DO IPR = 1, NGN(NGS(3)+IGC)
+      IPRSM = IPRSM + 1
+
+      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+48)
+    ENDDO
+
+    SELFREF(JT,IGC) = Z_SUMK
+  ENDDO
+ENDDO
+
+DO JT = 1,4
+   IPRSM = 0
+   DO IGC = 1,NGC(4)
+     Z_SUMK = 0.0_JPRB
+     DO IPR = 1, NGN(NGS(3)+IGC)
+       IPRSM = IPRSM + 1
+       Z_SUMK = Z_SUMK + FORREFO(JT,IPRSM)*RWGT(IPRSM+48)
+     ENDDO
+     FORREF(JT,IGC) = Z_SUMK
+   ENDDO
+ENDDO
+
+DO JP = 1,9
+  IPRSM = 0
+  DO IGC = 1,NGC(4)
+    Z_SUMF = 0.0_JPRB
+    DO IPR = 1, NGN(NGS(3)+IGC)
+      IPRSM = IPRSM + 1
+
+      Z_SUMF = Z_SUMF + FRACREFAO(IPRSM,JP)
+    ENDDO
+
+    FRACREFA(IGC,JP) = Z_SUMF
+  ENDDO
+ENDDO
+
+DO JP = 1,5
+  IPRSM = 0
+  DO IGC = 1,NGC(4)
+    Z_SUMF = 0.0_JPRB
+    DO IPR = 1, NGN(NGS(3)+IGC)
+      IPRSM = IPRSM + 1
+
+      Z_SUMF = Z_SUMF + FRACREFBO(IPRSM,JP)
+    ENDDO
+
+    FRACREFB(IGC,JP) = Z_SUMF
+  ENDDO
+ENDDO
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB4',1,ZHOOK_HANDLE)
+END SUBROUTINE RRTM_CMBGB4
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb4.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb4.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb4.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_CMBGB4
+END SUBROUTINE RRTM_CMBGB4
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb5.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb5.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb5.F90	(revision 3908)
@@ -0,0 +1,151 @@
+!***************************************************************************
+SUBROUTINE RRTM_CMBGB5
+!***************************************************************************
+
+!     BAND 5:  700-820 cm-1 (low - H2O,CO2; high - O3,CO2)
+!     ABozzo 201306 updated to rrtmg v4.85
+!     band 5:  700-820 cm-1 (low key - h2o,co2; low minor - o3, ccl4)
+!                           (high key - o3,co2)
+!***************************************************************************
+
+! Parameters
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE YOERRTO5 , ONLY : KAO     ,KBO     ,SELFREFO   ,FORREFO, FRACREFAO  ,&
+ & FRACREFBO, CCL4O, KAO_MO3
+USE YOERRTA5 , ONLY : KA      ,KB      ,SELFREF    ,FORREF, FRACREFA   ,&
+ & FRACREFB , CCL4, KA_MO3  
+USE YOERRTRWT, ONLY : RWGT
+USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN      
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JN, JP, JT
+
+REAL(KIND=JPRB) :: Z_SUMF, Z_SUMK
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB5',0,ZHOOK_HANDLE)
+DO JN = 1,9
+  DO JT = 1,5
+    DO JP = 1,13
+      IPRSM = 0
+      DO IGC = 1,NGC(5)
+        Z_SUMK = 0.0_JPRB
+        DO IPR = 1, NGN(NGS(4)+IGC)
+          IPRSM = IPRSM + 1
+
+          Z_SUMK = Z_SUMK + KAO(JN,JT,JP,IPRSM)*RWGT(IPRSM+64)
+        ENDDO
+
+        KA(JN,JT,JP,IGC) = Z_SUMK
+      ENDDO
+    ENDDO
+  ENDDO
+ENDDO
+DO JN = 1,5
+  DO JT = 1,5
+    DO JP = 13,59
+      IPRSM = 0
+      DO IGC = 1,NGC(5)
+        Z_SUMK = 0.0_JPRB
+        DO IPR = 1, NGN(NGS(4)+IGC)
+          IPRSM = IPRSM + 1
+
+          Z_SUMK = Z_SUMK + KBO(JN,JT,JP,IPRSM)*RWGT(IPRSM+64)
+        ENDDO
+
+        KB(JN,JT,JP,IGC) = Z_SUMK
+      ENDDO
+    ENDDO
+  ENDDO
+ENDDO
+
+ DO JN = 1,9
+    DO JT = 1,19
+       IPRSM = 0
+       DO IGC = 1,NGC(5)
+          Z_SUMK = 0.0_JPRB
+          DO IPR = 1, NGN(NGS(4)+IGC)
+               IPRSM = IPRSM + 1
+               Z_SUMK = Z_SUMK + KAO_MO3(JN,JT,IPRSM)*RWGT(IPRSM+64)
+          ENDDO
+          KA_MO3(JN,JT,IGC) = Z_SUMK
+       ENDDO
+    ENDDO
+ENDDO
+
+
+
+DO JT = 1,10
+  IPRSM = 0
+  DO IGC = 1,NGC(5)
+    Z_SUMK = 0.0_JPRB
+    DO IPR = 1, NGN(NGS(4)+IGC)
+      IPRSM = IPRSM + 1
+
+      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+64)
+    ENDDO
+
+    SELFREF(JT,IGC) = Z_SUMK
+  ENDDO
+ENDDO
+
+DO JT = 1,4
+   IPRSM = 0
+   DO IGC = 1,NGC(5)
+      Z_SUMK = 0.0_JPRB
+      DO IPR = 1, NGN(NGS(4)+IGC)
+         IPRSM = IPRSM + 1
+         Z_SUMK = Z_SUMK + FORREFO(JT,IPRSM)*RWGT(IPRSM+64)
+      ENDDO
+      FORREF(JT,IGC) = Z_SUMK
+   ENDDO
+ENDDO
+
+
+
+DO JP = 1,9
+  IPRSM = 0
+  DO IGC = 1,NGC(5)
+    Z_SUMF = 0.0_JPRB
+    DO IPR = 1, NGN(NGS(4)+IGC)
+      IPRSM = IPRSM + 1
+
+      Z_SUMF = Z_SUMF + FRACREFAO(IPRSM,JP)
+    ENDDO
+
+    FRACREFA(IGC,JP) = Z_SUMF
+  ENDDO
+ENDDO
+
+DO JP = 1,5
+  IPRSM = 0
+  DO IGC = 1,NGC(5)
+    Z_SUMF = 0.0_JPRB
+    DO IPR = 1, NGN(NGS(4)+IGC)
+      IPRSM = IPRSM + 1
+
+      Z_SUMF = Z_SUMF + FRACREFBO(IPRSM,JP)
+    ENDDO
+
+    FRACREFB(IGC,JP) = Z_SUMF
+  ENDDO
+ENDDO
+
+IPRSM = 0
+DO IGC = 1,NGC(5)
+  Z_SUMK = 0.0_JPRB
+  DO IPR = 1, NGN(NGS(4)+IGC)
+    IPRSM = IPRSM + 1
+
+    Z_SUMK = Z_SUMK + CCL4O(IPRSM)*RWGT(IPRSM+64)
+  ENDDO
+
+  CCL4(IGC) = Z_SUMK
+ENDDO
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB5',1,ZHOOK_HANDLE)
+END SUBROUTINE RRTM_CMBGB5
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb5.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb5.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb5.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_CMBGB5
+END SUBROUTINE RRTM_CMBGB5
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb6.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb6.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb6.F90	(revision 3908)
@@ -0,0 +1,104 @@
+!***************************************************************************
+SUBROUTINE RRTM_CMBGB6
+!***************************************************************************
+
+!     BAND 6:  820-980 cm-1 (low - H2O; high - nothing)
+!     ABozzo 201306 updated to rrtmg v4.85
+!     band 6:  820-980 cm-1 (low key - h2o; low minor - co2)
+!                           (high key - nothing; high minor - cfc11, cfc12)
+!***************************************************************************
+
+! Parameters
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE YOERRTO6 , ONLY : KAO     ,SELFREFO   , FORREFO, FRACREFAO  ,&
+ & KAO_MCO2 ,CFC11ADJO,CFC12O  
+USE YOERRTA6 , ONLY : KA      ,SELFREF    , FORREF, FRACREFA   ,&
+ & KA_MCO2  ,CFC11ADJ ,CFC12  
+USE YOERRTRWT, ONLY : RWGT
+USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN      
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JP, JT
+
+REAL(KIND=JPRB) :: Z_SUMF, Z_SUMK, Z_SUMK2, Z_SUMK3
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB6',0,ZHOOK_HANDLE)
+DO JT = 1,5
+  DO JP = 1,13
+    IPRSM = 0
+    DO IGC = 1,NGC(6)
+      Z_SUMK = 0.0_JPRB
+      DO IPR = 1, NGN(NGS(5)+IGC)
+        IPRSM = IPRSM + 1
+
+        Z_SUMK = Z_SUMK + KAO(JT,JP,IPRSM)*RWGT(IPRSM+80)
+      ENDDO
+
+      KA(JT,JP,IGC) = Z_SUMK
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JT = 1,19
+    IPRSM = 0
+    DO IGC = 1,NGC(6)
+        Z_SUMK = 0.0_JPRB
+        DO IPR = 1, NGN(NGS(5)+IGC)
+            IPRSM = IPRSM + 1
+            Z_SUMK = Z_SUMK + KAO_MCO2(JT,IPRSM)*RWGT(IPRSM+80)
+        ENDDO
+        KA_MCO2(JT,IGC) = Z_SUMK
+    ENDDO
+ENDDO
+
+DO JT = 1,10
+  IPRSM = 0
+  DO IGC = 1,NGC(6)
+    Z_SUMK = 0.0_JPRB
+    DO IPR = 1, NGN(NGS(5)+IGC)
+      IPRSM = IPRSM + 1
+
+      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+80)
+    ENDDO
+
+    SELFREF(JT,IGC) = Z_SUMK
+  ENDDO
+ENDDO
+
+DO JT = 1,4
+   IPRSM = 0
+   DO IGC = 1,NGC(6)
+      Z_SUMK = 0.0_JPRB
+      DO IPR = 1, NGN(NGS(5)+IGC)
+         IPRSM = IPRSM + 1
+         Z_SUMK = Z_SUMK + FORREFO(JT,IPRSM)*RWGT(IPRSM+80)
+      ENDDO
+      FORREF(JT,IGC) = Z_SUMK
+   ENDDO
+ENDDO
+
+IPRSM = 0
+DO IGC = 1,NGC(6)
+  Z_SUMF = 0.0_JPRB
+  Z_SUMK2= 0.0_JPRB
+  Z_SUMK3= 0.0_JPRB
+  DO IPR = 1, NGN(NGS(5)+IGC)
+    IPRSM = IPRSM + 1
+
+    Z_SUMF = Z_SUMF + FRACREFAO(IPRSM)
+    Z_SUMK2= Z_SUMK2+ CFC11ADJO(IPRSM)*RWGT(IPRSM+80)
+    Z_SUMK3= Z_SUMK3+ CFC12O(IPRSM)*RWGT(IPRSM+80)
+  ENDDO
+
+  FRACREFA(IGC) = Z_SUMF
+  CFC11ADJ(IGC) = Z_SUMK2
+  CFC12(IGC) = Z_SUMK3
+ENDDO
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB6',1,ZHOOK_HANDLE)
+END SUBROUTINE RRTM_CMBGB6
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb6.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb6.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb6.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_CMBGB6
+END SUBROUTINE RRTM_CMBGB6
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb7.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb7.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb7.F90	(revision 3908)
@@ -0,0 +1,144 @@
+!***************************************************************************
+SUBROUTINE RRTM_CMBGB7
+!***************************************************************************
+
+!     BAND 7:  980-1080 cm-1 (low - H2O,O3; high - O3)
+!     ABozzo 201306 updated to rrtmg v4.85
+!     band 7:  980-1080 cm-1 (low key - h2o,o3; low minor - co2)
+!                            (high key - o3; high minor - co2)
+!***************************************************************************
+
+! Parameters
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE YOERRTO7 , ONLY : KAO     ,KBO     ,SELFREFO   ,FORREFO, FRACREFAO  ,&
+ & FRACREFBO,  KAO_MCO2     ,KBO_MCO2  
+USE YOERRTA7 , ONLY : KA      ,KB      ,SELFREF    ,FORREF, FRACREFA   ,&
+ & FRACREFB,  KA_MCO2     ,KB_MCO2     
+USE YOERRTRWT, ONLY : RWGT
+USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN      
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JN, JP, JT
+
+REAL(KIND=JPRB) :: Z_SUMF, Z_SUMK
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB7',0,ZHOOK_HANDLE)
+DO JN = 1,9
+  DO JT = 1,5
+    DO JP = 1,13
+      IPRSM = 0
+      DO IGC = 1,NGC(7)
+        Z_SUMK = 0.0_JPRB
+        DO IPR = 1, NGN(NGS(6)+IGC)
+          IPRSM = IPRSM + 1
+
+          Z_SUMK = Z_SUMK + KAO(JN,JT,JP,IPRSM)*RWGT(IPRSM+96)
+        ENDDO
+
+        KA(JN,JT,JP,IGC) = Z_SUMK
+      ENDDO
+    ENDDO
+  ENDDO
+ENDDO
+DO JT = 1,5
+  DO JP = 13,59
+    IPRSM = 0
+    DO IGC = 1,NGC(7)
+      Z_SUMK = 0.0_JPRB
+      DO IPR = 1, NGN(NGS(6)+IGC)
+        IPRSM = IPRSM + 1
+
+        Z_SUMK = Z_SUMK + KBO(JT,JP,IPRSM)*RWGT(IPRSM+96)
+      ENDDO
+
+      KB(JT,JP,IGC) = Z_SUMK
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JN = 1,9
+      DO JT = 1,19
+         IPRSM = 0
+         DO IGC = 1,NGC(7)
+            Z_SUMK = 0.0_JPRB
+            DO IPR = 1, NGN(NGS(6)+IGC)
+               IPRSM = IPRSM + 1
+               Z_SUMK = Z_SUMK + KAO_MCO2(JN,JT,IPRSM)*RWGT(IPRSM+96)
+            ENDDO
+            KA_MCO2(JN,JT,IGC) = Z_SUMK
+         ENDDO
+       ENDDO
+ENDDO
+
+DO JT = 1,19
+      IPRSM = 0
+      DO IGC = 1,NGC(7)
+         Z_SUMK = 0.0_JPRB
+         DO IPR = 1, NGN(NGS(6)+IGC)
+            IPRSM = IPRSM + 1
+            Z_SUMK = Z_SUMK + KBO_MCO2(JT,IPRSM)*RWGT(IPRSM+96)
+         ENDDO
+         KB_MCO2(JT,IGC) = Z_SUMK
+      ENDDO
+ENDDO
+
+
+DO JT = 1,10
+  IPRSM = 0
+  DO IGC = 1,NGC(7)
+    Z_SUMK = 0.0_JPRB
+    DO IPR = 1, NGN(NGS(6)+IGC)
+      IPRSM = IPRSM + 1
+
+      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+96)
+    ENDDO
+
+    SELFREF(JT,IGC) = Z_SUMK
+  ENDDO
+ENDDO
+
+DO JT = 1,4
+      IPRSM = 0
+      DO IGC = 1,NGC(7)
+         Z_SUMK = 0.0_JPRB
+         DO IPR = 1, NGN(NGS(6)+IGC)
+            IPRSM = IPRSM + 1
+            Z_SUMK = Z_SUMK + FORREFO(JT,IPRSM)*RWGT(IPRSM+96)
+         ENDDO
+         FORREF(JT,IGC) = Z_SUMK
+      ENDDO
+ENDDO
+
+DO JP = 1,9
+  IPRSM = 0
+  DO IGC = 1,NGC(7)
+    Z_SUMF = 0.0_JPRB
+    DO IPR = 1, NGN(NGS(6)+IGC)
+      IPRSM = IPRSM + 1
+
+      Z_SUMF = Z_SUMF + FRACREFAO(IPRSM,JP)
+    ENDDO
+
+    FRACREFA(IGC,JP) = Z_SUMF
+  ENDDO
+ENDDO
+
+IPRSM = 0
+DO IGC = 1,NGC(7)
+  Z_SUMF = 0.0_JPRB
+  DO IPR = 1, NGN(NGS(6)+IGC)
+    IPRSM = IPRSM + 1
+
+    Z_SUMF = Z_SUMF + FRACREFBO(IPRSM)
+  ENDDO
+
+  FRACREFB(IGC) = Z_SUMF
+ENDDO
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB7',1,ZHOOK_HANDLE)
+END SUBROUTINE RRTM_CMBGB7
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb7.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb7.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb7.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_CMBGB7
+END SUBROUTINE RRTM_CMBGB7
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb8.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb8.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb8.F90	(revision 3908)
@@ -0,0 +1,128 @@
+!***************************************************************************
+SUBROUTINE RRTM_CMBGB8
+!***************************************************************************
+
+!     BAND 8:  1080-1180 cm-1 (low (i.e.>~300mb) - H2O; high - O3)
+!     ABozzo 201306 updated to rrtmg v4.85
+!***************************************************************************
+
+! Parameters
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE YOERRTO8 , ONLY : KAO     ,KBO     ,SELFREFO   ,FORREFO, FRACREFAO  ,&
+ & FRACREFBO, KAO_MCO2, KAO_MN2O ,KAO_MO3, KBO_MCO2, KBO_MN2O, &
+ & CFC12O   , CFC22ADJO  
+USE YOERRTA8 , ONLY : KA      ,KB      ,SELFREF    ,FORREF, FRACREFA   ,&
+ & FRACREFB , KA_MCO2, KA_MN2O ,KA_MO3, KB_MCO2, KB_MN2O,&
+ & CFC12    , CFC22ADJ  
+USE YOERRTRWT, ONLY : RWGT
+USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN      
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JP, JT
+
+REAL(KIND=JPRB) :: Z_SUMF1, Z_SUMF2, Z_SUMK, Z_SUMK1, Z_SUMK2, Z_SUMK3, Z_SUMK4, Z_SUMK5
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB8',0,ZHOOK_HANDLE)
+DO JT = 1,5
+  DO JP = 1,13
+    IPRSM = 0
+    DO IGC = 1,NGC(8)
+      Z_SUMK = 0.0_JPRB
+      DO IPR = 1, NGN(NGS(7)+IGC)
+        IPRSM = IPRSM + 1
+        Z_SUMK = Z_SUMK + KAO(JT,JP,IPRSM)*RWGT(IPRSM+112)
+      ENDDO
+      KA(JT,JP,IGC) = Z_SUMK
+    ENDDO
+  ENDDO
+ENDDO
+DO JT = 1,5
+  DO JP = 13,59
+    IPRSM = 0
+    DO IGC = 1,NGC(8)
+      Z_SUMK = 0.0_JPRB
+      DO IPR = 1, NGN(NGS(7)+IGC)
+        IPRSM = IPRSM + 1
+        Z_SUMK = Z_SUMK + KBO(JT,JP,IPRSM)*RWGT(IPRSM+112)
+      ENDDO
+      KB(JT,JP,IGC) = Z_SUMK
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JT = 1,10
+  IPRSM = 0
+  DO IGC = 1,NGC(8)
+    Z_SUMK = 0.0_JPRB
+    DO IPR = 1, NGN(NGS(7)+IGC)
+      IPRSM = IPRSM + 1
+      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+112)
+    ENDDO
+    SELFREF(JT,IGC) = Z_SUMK
+  ENDDO
+ENDDO
+DO JT = 1,4
+   IPRSM = 0
+   DO IGC = 1,NGC(8)
+      Z_SUMK = 0.0_JPRB
+      DO IPR = 1, NGN(NGS(7)+IGC)
+         IPRSM = IPRSM + 1
+         Z_SUMK = Z_SUMK + FORREFO(JT,IPRSM)*RWGT(IPRSM+112)
+      ENDDO
+      FORREF(JT,IGC) = Z_SUMK
+   ENDDO
+ENDDO
+
+DO JT = 1,19
+IPRSM = 0
+DO IGC = 1,NGC(8)
+  Z_SUMK1= 0.0_JPRB
+  Z_SUMK2= 0.0_JPRB
+  Z_SUMK3= 0.0_JPRB
+  Z_SUMK4= 0.0_JPRB
+  Z_SUMK5= 0.0_JPRB
+  DO IPR = 1, NGN(NGS(7)+IGC)
+    IPRSM = IPRSM + 1
+    Z_SUMK1= Z_SUMK1+ KAO_MCO2(JT,IPRSM)*RWGT(IPRSM+112)
+    Z_SUMK2= Z_SUMK2+ KBO_MCO2(JT,IPRSM)*RWGT(IPRSM+112)
+    Z_SUMK3= Z_SUMK3+ KAO_MO3(JT,IPRSM)*RWGT(IPRSM+112)
+    Z_SUMK4= Z_SUMK4+ KAO_MN2O(JT,IPRSM)*RWGT(IPRSM+112)
+    Z_SUMK5= Z_SUMK5+ KBO_MN2O(JT,IPRSM)*RWGT(IPRSM+112)
+  ENDDO
+  KA_MCO2(JT,IGC) = Z_SUMK1
+  KB_MCO2(JT,IGC) = Z_SUMK2
+  KA_MO3(JT,IGC) = Z_SUMK3
+  KA_MN2O(JT,IGC) = Z_SUMK4
+  KB_MN2O(JT,IGC) = Z_SUMK5
+ENDDO
+ENDDO
+
+
+
+IPRSM = 0
+DO IGC = 1,NGC(8)
+  Z_SUMF1= 0.0_JPRB
+  Z_SUMF2= 0.0_JPRB
+  Z_SUMK1= 0.0_JPRB
+  Z_SUMK2= 0.0_JPRB
+  DO IPR = 1, NGN(NGS(7)+IGC)
+    IPRSM = IPRSM + 1
+    Z_SUMF1= Z_SUMF1+ FRACREFAO(IPRSM)
+    Z_SUMF2= Z_SUMF2+ FRACREFBO(IPRSM)
+    Z_SUMK1= Z_SUMK1+ CFC12O(IPRSM)*RWGT(IPRSM+112)
+    Z_SUMK2= Z_SUMK2+ CFC22ADJO(IPRSM)*RWGT(IPRSM+112)
+  ENDDO
+  FRACREFA(IGC) = Z_SUMF1
+  FRACREFB(IGC) = Z_SUMF2
+  CFC12(IGC) = Z_SUMK1
+  CFC22ADJ(IGC) = Z_SUMK2
+ENDDO
+
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB8',1,ZHOOK_HANDLE)
+END SUBROUTINE RRTM_CMBGB8
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb8.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb8.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb8.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_CMBGB8
+END SUBROUTINE RRTM_CMBGB8
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb9.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb9.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb9.F90	(revision 3908)
@@ -0,0 +1,148 @@
+!***************************************************************************
+SUBROUTINE RRTM_CMBGB9
+!***************************************************************************
+
+!     BAND 9:  1180-1390 cm-1 (low - H2O,CH4; high - CH4)
+!     ABozzo 201306 updated to rrtmg v4.85
+!     band 9:  1180-1390 cm-1 (low key - h2o,ch4; low minor - n2o)
+!                             (high key - ch4; high minor - n2o)!
+!***************************************************************************
+
+! Parameters
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE YOERRTO9 , ONLY : KAO     ,KBO     ,SELFREFO, FORREFO   ,FRACREFAO  ,&
+ & FRACREFBO, kao_mn2o, kbo_mn2o  
+USE YOERRTA9 , ONLY : KA      ,KB      ,SELFREF, FORREF    ,FRACREFA  ,&
+ & FRACREFB , ka_mn2o,  kb_mn2o 
+USE YOERRTRWT, ONLY : RWGT
+USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN      
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JN, JP, JT
+
+
+REAL(KIND=JPRB) :: Z_SUMF, Z_SUMK
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB9',0,ZHOOK_HANDLE)
+DO JN = 1,9
+  DO JT = 1,5
+    DO JP = 1,13
+      IPRSM = 0
+      DO IGC = 1,NGC(9)
+        Z_SUMK = 0.0_JPRB
+        DO IPR = 1, NGN(NGS(8)+IGC)
+          IPRSM = IPRSM + 1
+
+          Z_SUMK = Z_SUMK + KAO(JN,JT,JP,IPRSM)*RWGT(IPRSM+128)
+        ENDDO
+
+        KA(JN,JT,JP,IGC) = Z_SUMK
+      ENDDO
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JT = 1,5
+  DO JP = 13,59
+    IPRSM = 0
+    DO IGC = 1,NGC(9)
+      Z_SUMK = 0.0_JPRB
+      DO IPR = 1, NGN(NGS(8)+IGC)
+        IPRSM = IPRSM + 1
+
+        Z_SUMK = Z_SUMK + KBO(JT,JP,IPRSM)*RWGT(IPRSM+128)
+      ENDDO
+
+      KB(JT,JP,IGC) = Z_SUMK
+    ENDDO
+  ENDDO
+ENDDO
+
+   DO JN = 1,9
+         DO JT = 1,19
+            IPRSM = 0
+            DO IGC = 1,NGC(9)
+              Z_SUMK = 0.0_JPRB
+               DO IPR = 1, NGN(NGS(8)+IGC)
+                  IPRSM = IPRSM + 1
+                  Z_SUMK = Z_SUMK + KAO_MN2O(JN,JT,IPRSM)*RWGT(IPRSM+128)
+               ENDDO
+               KA_MN2O(JN,JT,IGC) = Z_SUMK
+            ENDDO
+         ENDDO
+      ENDDO
+
+      DO JT = 1,19
+         IPRSM = 0
+         DO IGC = 1,NGC(9)
+            Z_SUMK = 0.0_JPRB
+            DO IPR = 1, NGN(NGS(8)+IGC)
+               IPRSM = IPRSM + 1
+               Z_SUMK = Z_SUMK + KBO_MN2O(JT,IPRSM)*RWGT(IPRSM+128)
+            ENDDO
+            KB_MN2O(JT,IGC) = Z_SUMK
+         ENDDO
+      ENDDO
+
+
+
+DO JT = 1,10
+  IPRSM = 0
+  DO IGC = 1,NGC(9)
+    Z_SUMK = 0.0_JPRB
+    DO IPR = 1, NGN(NGS(8)+IGC)
+      IPRSM = IPRSM + 1
+
+      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+128)
+    ENDDO
+
+    SELFREF(JT,IGC) = Z_SUMK
+  ENDDO
+ENDDO
+
+   DO JT = 1,4
+         IPRSM = 0
+         DO IGC = 1,NGC(9)
+            Z_SUMK = 0.0_JPRB
+            DO IPR = 1, NGN(NGS(8)+IGC)
+               IPRSM = IPRSM + 1
+               Z_SUMK = Z_SUMK + FORREFO(JT,IPRSM)*RWGT(IPRSM+128)
+            ENDDO
+            FORREF(JT,IGC) = Z_SUMK
+         ENDDO
+      ENDDO
+
+
+DO JP = 1,9
+  IPRSM = 0
+  DO IGC = 1,NGC(9)
+    Z_SUMF = 0.0_JPRB
+    DO IPR = 1, NGN(NGS(8)+IGC)
+      IPRSM = IPRSM + 1
+
+      Z_SUMF = Z_SUMF + FRACREFAO(IPRSM,JP)
+    ENDDO
+
+    FRACREFA(IGC,JP) = Z_SUMF
+  ENDDO
+ENDDO
+
+IPRSM = 0
+DO IGC = 1,NGC(9)
+  Z_SUMF = 0.0_JPRB
+  DO IPR = 1, NGN(NGS(8)+IGC)
+    IPRSM = IPRSM + 1
+
+    Z_SUMF = Z_SUMF + FRACREFBO(IPRSM)
+  ENDDO
+
+  FRACREFB(IGC) = Z_SUMF
+ENDDO
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB9',1,ZHOOK_HANDLE)
+END SUBROUTINE RRTM_CMBGB9
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb9.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb9.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_cmbgb9.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_CMBGB9
+END SUBROUTINE RRTM_CMBGB9
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_ecrt_140gp_mcica.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_ecrt_140gp_mcica.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_ecrt_140gp_mcica.F90	(revision 3908)
@@ -0,0 +1,370 @@
+SUBROUTINE RRTM_ECRT_140GP_MCICA &
+ &( KIDIA, KFDIA, KLON, KLEV, KCOLS ,&
+ &  PAER , PAPH , PAP , PAERTAUL, PAERASYL, PAEROMGL, &
+ &  PTS  , PTH  , PT  , &
+ &  PEMIS, PEMIW, &
+ &  PQ   , PCO2 , PCH4, PN2O  , PNO2, PC11, PC12, PC22, PCL4, POZN, PCLDF  , PTAUCLDI, &
+ &  PCLDFRAC, PTAUCLD, PCOLDRY, PWBRODL, PWKL, PWX , &
+ &  PTAUAERL, PAVEL  , PTAVEL , PZ  , PTZ , PTBOUND, PSEMISS , KREFLECT)  
+
+!----compiled for Cray with -h nopattern----
+
+!     Reformatted for F90 by JJMorcrette, ECMWF, 980714
+
+!     Read in atmospheric profile from ECMWF radiation code, and prepare it
+!     for use in RRTM.  Set other RRTM input parameters.  Values are passed
+!     back through existing RRTM arrays and commons.
+
+!- Modifications
+
+!     2000-05-15 Deborah Salmond  Speed-up
+!     JJMorcrette 20050110  McICA version
+!        NEC           25-Oct-2007 Optimisations
+!     PBechtold+NSemane        09-Jul-2012 Gravity
+!     201305 ABozzo PWBRODL,O2
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
+USE YOMCST   , ONLY : RG
+USE PARRRTM  , ONLY : JPBAND, JPXSEC, JPINPX  
+USE YOERAD   , ONLY : NSPMAPL
+USE YOESW    , ONLY : RAER
+USE YOEAERATM, ONLY : LAERRRTM, LAERCSTR, LAERVOL
+USE YOM_YGFL , ONLY : YGFL
+USE YOMDYNCORE,ONLY : RPLRG
+
+!------------------------------Arguments--------------------------------
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLON! Number of atmospheres (longitudes) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV! Number of atmospheric layers 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA, KFDIA 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KCOLS
+
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PAER(KLON,6,KLEV) ! Aerosol optical thickness
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PAERTAUL(KLON,KLEV,16), PAERASYL(KLON,KLEV,16), PAEROMGL(KLON,KLEV,16)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPH(KLON,KLEV+1) ! Interface pressures (Pa)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PAP(KLON,KLEV) ! Layer pressures (Pa)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(KLON) ! Surface temperature (K)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PTH(KLON,KLEV+1) ! Interface temperatures (K)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KLON,KLEV) ! Layer temperature (K)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIS(KLON) ! Non-window surface emissivity
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIW(KLON) ! Window surface emissivity
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KLON,KLEV) ! H2O specific humidity (mmr)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCO2(KLON,KLEV) ! CO2 mass mixing ratio
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCH4(KLON,KLEV) ! CH4 mass mixing ratio
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PN2O(KLON,KLEV) ! N2O mass mixing ratio
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PNO2(KLON,KLEV) ! NO2 mass mixing ratio
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PC11(KLON,KLEV) ! CFC11 mass mixing ratio
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PC12(KLON,KLEV) ! CFC12 mass mixing ratio
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PC22(KLON,KLEV) ! CFC22 mass mixing ratio
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCL4(KLON,KLEV) ! CCL4  mass mixing ratio
+REAL(KIND=JPRB)   ,INTENT(IN)    :: POZN(KLON,KLEV) ! O3 mass mixing ratio
+
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLDF(KLON,KCOLS,KLEV)    ! Cloud fraction
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUCLDI(KLON,KLEV,KCOLS) ! Cloud optical depth
+
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCLDFRAC(KIDIA:KFDIA,KCOLS,KLEV)   ! Cloud fraction
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTAUCLD(KIDIA:KFDIA,KLEV,KCOLS)    ! Spectral optical thickness
+
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCOLDRY(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PWBRODL(KIDIA:KFDIA,KLEV) ! broadening gas column density (mol/cm2)
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PWKL(KIDIA:KFDIA,JPINPX,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PWX(KIDIA:KFDIA,JPXSEC,KLEV) ! Amount of trace gases
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTAUAERL(KIDIA:KFDIA,KLEV,JPBAND) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PAVEL(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTAVEL(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PZ(KIDIA:KFDIA,0:KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTZ(KIDIA:KFDIA,0:KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTBOUND(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSEMISS(KIDIA:KFDIA,JPBAND) 
+INTEGER(KIND=JPIM),INTENT(OUT)   :: KREFLECT(KIDIA:KFDIA) 
+
+!      real rch4                       ! CH4 mass mixing ratio
+!      real rn2o                       ! N2O mass mixing ratio
+!      real rcfc11                     ! CFC11 mass mixing ratio
+!      real rcfc12                     ! CFC12 mass mixing ratio
+!      real rcfc22                     ! CFC22 mass mixing ratio
+!      real rccl4                      ! CCl4  mass mixing ratio
+!- from AER
+!- from PROFILE             
+!- from SURFACE             
+REAL(KIND=JPRB) :: ztauaer(5)
+REAL(KIND=JPRB) :: ZAMD                  ! Effective molecular weight of dry air (g/mol)
+REAL(KIND=JPRB) :: ZAMW                  ! Molecular weight of water vapor (g/mol)
+REAL(KIND=JPRB) :: ZAMCO2                ! Molecular weight of carbon dioxide (g/mol)
+REAL(KIND=JPRB) :: ZAMO                  ! Molecular weight of ozone (g/mol)
+REAL(KIND=JPRB) :: ZAMCH4                ! Molecular weight of methane (g/mol)
+REAL(KIND=JPRB) :: ZAMN2O                ! Molecular weight of nitrous oxide (g/mol)
+REAL(KIND=JPRB) :: ZAMC11                ! Molecular weight of CFC11 (g/mol) - CFCL3
+REAL(KIND=JPRB) :: ZAMC12                ! Molecular weight of CFC12 (g/mol) - CF2CL2
+REAL(KIND=JPRB) :: ZAMC22                ! Molecular weight of CFC22 (g/mol) - CHF2CL
+REAL(KIND=JPRB) :: ZAMCL4                ! Molecular weight of CCl4  (g/mol) - CCL4
+REAL(KIND=JPRB) :: ZAVGDRO               ! Avogadro's number (molecules/mole)
+REAL(KIND=JPRB) :: ZGRAVIT               ! Gravitational acceleration (cm/s**2)
+
+REAL(KIND=JPRB) :: ZSUMMOL
+
+! Atomic weights for conversion from mass to volume mixing ratios; these
+!  are the same values used in ECRT to assure accurate conversion to vmr
+data ZAMD   /  28.970_JPRB    /
+data ZAMW   /  18.0154_JPRB   /
+data ZAMCO2 /  44.011_JPRB    /
+data ZAMO   /  47.9982_JPRB   /
+data ZAMCH4 /  16.043_JPRB    /
+data ZAMN2O /  44.013_JPRB    /
+data ZAMC11 / 137.3686_JPRB   /
+data ZAMC12 / 120.9140_JPRB   /
+data ZAMC22 /  86.4690_JPRB   /
+data ZAMCL4 / 153.8230_JPRB   /
+data ZAVGDRO/ 6.02214E23_JPRB /
+
+INTEGER(KIND=JPIM) :: IATM, JMOL, IXMAX, J1, J2, IAE, IKL, JK, JCOLS, JL, JLW
+INTEGER(KIND=JPIM) :: ITMOL, INXMOL
+
+REAL(KIND=JPRB) :: ZAMM
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+! ***
+
+! *** mji
+! Initialize all molecular amounts and aerosol optical depths to zero here, 
+! then pass ECRT amounts into RRTM arrays below.
+
+!      DATA ZWKL /MAXPRDW*0.0/
+!      DATA ZWX  /MAXPROD*0.0/
+!      DATA KREFLECT /0/
+
+! Activate cross section molecules:
+!     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
+!      DATA KXMOL  /2/
+!      DATA KXINDX /0,2,3,0,31*0/
+
+!      IREFLECT=KREFLECT
+!      NXMOL=KXMOL
+
+ASSOCIATE(NFLEVG=>KLEV, &
+ & NACTAERO=>YGFL%NACTAERO)
+IF (LHOOK) CALL DR_HOOK('RRTM_ECRT_140GP_MCICA',0,ZHOOK_HANDLE)
+
+ZGRAVIT=(RG/RPLRG)*1.E2_JPRB
+
+DO JL = KIDIA, KFDIA
+  KREFLECT(JL)=0
+  INXMOL=2
+ENDDO
+
+!DO J1=1,35
+! IXINDX(J1)=0
+DO J2=1,KLEV
+  DO J1=1,35
+    DO JL = KIDIA, KFDIA
+      PWKL(JL,J1,J2)=0.0_JPRB 
+    ENDDO
+  ENDDO
+ENDDO
+!IXINDX(2)=2
+!IXINDX(3)=3
+
+!     Set parameters needed for RRTM execution:
+IATM    = 0
+!      IXSECT  = 1
+!      NUMANGS = 0
+!      IOUT    = -1
+IXMAX   = 4
+
+!     Bands 6,7,8 are considered the 'window' and allowed to have a
+!     different surface emissivity (as in ECMWF).  Eli wrote this part....
+DO JL = KIDIA, KFDIA
+  PSEMISS(JL,1)  = PEMIS(JL)
+  PSEMISS(JL,2)  = PEMIS(JL)
+  PSEMISS(JL,3)  = PEMIS(JL)
+  PSEMISS(JL,4)  = PEMIS(JL)
+  PSEMISS(JL,5)  = PEMIS(JL)
+  PSEMISS(JL,6)  = PEMIW(JL)
+  PSEMISS(JL,7)  = PEMIW(JL)
+  PSEMISS(JL,8)  = PEMIW(JL)
+  PSEMISS(JL,9)  = PEMIS(JL)
+  PSEMISS(JL,10) = PEMIS(JL)
+  PSEMISS(JL,11) = PEMIS(JL)
+  PSEMISS(JL,12) = PEMIS(JL)
+  PSEMISS(JL,13) = PEMIS(JL)
+  PSEMISS(JL,14) = PEMIS(JL)
+  PSEMISS(JL,15) = PEMIS(JL)
+  PSEMISS(JL,16) = PEMIS(JL)
+
+!     Set surface temperature.  
+
+  PTBOUND(JL) = PTS(JL)
+
+!     Install ECRT arrays into RRTM arrays for pressure, temperature,
+!     and molecular amounts.  Pressures are converted from Pascals
+!     (ECRT) to mb (RRTM).  H2O, CO2, O3 and trace gas amounts are 
+!     converted from mass mixing ratio to volume mixing ratio.  CO2
+!     converted with same dry air and CO2 molecular weights used in 
+!     ECRT to assure correct conversion back to the proper CO2 vmr.
+!     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: RRTM levels count from bottom to top, while the ECRT input
+!     variables count from the top down and must be reversed 
+  ITMOL = 7
+  PZ(JL,0) = PAPH(JL,KLEV+1)/100._JPRB
+  PTZ(JL,0) = PTH(JL,KLEV+1)
+ENDDO
+
+  DO JK = 1, KLEV
+DO JL = KIDIA, KFDIA
+    PAVEL(JL,JK) = PAP(JL,KLEV-JK+1)/100._JPRB
+    PTAVEL(JL,JK) = PT(JL,KLEV-JK+1)
+    PZ(JL,JK) = PAPH(JL,KLEV-JK+1)/100._JPRB
+    PTZ(JL,JK) = PTH(JL,KLEV-JK+1)
+    PWKL(JL,1,JK) = PQ(JL,KLEV-JK+1)*ZAMD/ZAMW
+    PWKL(JL,2,JK) = PCO2(JL,KLEV-JK+1)*ZAMD/ZAMCO2
+    PWKL(JL,3,JK) = POZN(JL,KLEV-JK+1)*ZAMD/ZAMO
+    PWKL(JL,4,JK) = PN2O(JL,KLEV-JK+1)*ZAMD/ZAMN2O
+    PWKL(JL,6,JK) = PCH4(JL,KLEV-JK+1)*ZAMD/ZAMCH4
+    PWKL(JL,7,JK) = 0.209488_JPRB
+    ZAMM = (1.0_JPRB-PWKL(JL,1,JK))*ZAMD + PWKL(JL,1,JK)*ZAMW
+    PCOLDRY(JL,JK) = (PZ(JL,JK-1)-PZ(JL,JK))*1.E3_JPRB*ZAVGDRO/(ZGRAVIT*ZAMM*(1.0_JPRB+PWKL(JL,1,JK)))
+ENDDO
+  ENDDO
+
+!- If prognostic aerosols with proper RRTM optical properties, fill the RRTM aerosol arrays
+
+IF (LAERRRTM) THEN
+  IF (LAERCSTR .OR. (LAERVOL .AND. NACTAERO == 15)) THEN
+    DO JLW=1,16
+      DO JK=1,KLEV
+        IKL=KLEV-JK+1
+          DO JL=KIDIA,KFDIA
+            PTAUAERL(JL,JK,JLW)=PAERTAUL(JL,IKL,JLW)
+          ENDDO
+      ENDDO
+    ENDDO
+
+  ELSEIF (.NOT.LAERCSTR) THEN
+    DO JLW=1,16
+      DO JK=1,KLEV
+        IKL=KLEV-JK+1
+        DO JL=KIDIA,KFDIA
+          PTAUAERL(JL,JK,JLW)=PAERTAUL(JL,IKL,JLW)+RAER(NSPMAPL(JLW),6)*PAER(JL,6,IKL)
+        ENDDO
+      ENDDO
+    ENDDO
+  ENDIF
+
+ELSE
+
+!- Fill RRTM aerosol arrays with operational ECMWF aerosols,
+!  do the mixing and distribute over the 16 spectral intervals
+
+  DO JK=1,KLEV
+    IKL=KLEV-JK+1
+    DO JL = KIDIA, KFDIA
+    IAE=1
+    ZTAUAER(IAE) =&
+   & RAER(IAE,1)*PAER(JL,1,IKL)+RAER(IAE,2)*PAER(JL,2,IKL)&
+   & +RAER(IAE,3)*PAER(JL,3,IKL)+RAER(IAE,4)*PAER(JL,4,IKL)&
+   & +RAER(IAE,5)*PAER(JL,5,IKL)+RAER(IAE,6)*PAER(JL,6,IKL)  
+    PTAUAERL(JL,JK, 1)=ZTAUAER(1)
+    PTAUAERL(JL,JK, 2)=ZTAUAER(1)
+    IAE=2
+    ZTAUAER(IAE) =&
+   & RAER(IAE,1)*PAER(JL,1,IKL)+RAER(IAE,2)*PAER(JL,2,IKL)&
+   & +RAER(IAE,3)*PAER(JL,3,IKL)+RAER(IAE,4)*PAER(JL,4,IKL)&
+   & +RAER(IAE,5)*PAER(JL,5,IKL)+RAER(IAE,6)*PAER(JL,6,IKL)  
+    PTAUAERL(JL,JK, 3)=ZTAUAER(2)
+    PTAUAERL(JL,JK, 4)=ZTAUAER(2)
+    PTAUAERL(JL,JK, 5)=ZTAUAER(2)
+    IAE=3
+    ZTAUAER(IAE) =&
+   & RAER(IAE,1)*PAER(JL,1,IKL)+RAER(IAE,2)*PAER(JL,2,IKL)&
+   & +RAER(IAE,3)*PAER(JL,3,IKL)+RAER(IAE,4)*PAER(JL,4,IKL)&
+   & +RAER(IAE,5)*PAER(JL,5,IKL)+RAER(IAE,6)*PAER(JL,6,IKL)  
+    PTAUAERL(JL,JK, 6)=ZTAUAER(3)
+    PTAUAERL(JL,JK, 8)=ZTAUAER(3)
+    PTAUAERL(JL,JK, 9)=ZTAUAER(3)
+    IAE=4
+    ZTAUAER(IAE) =&
+   & RAER(IAE,1)*PAER(JL,1,IKL)+RAER(IAE,2)*PAER(JL,2,IKL)&
+   & +RAER(IAE,3)*PAER(JL,3,IKL)+RAER(IAE,4)*PAER(JL,4,IKL)&
+   & +RAER(IAE,5)*PAER(JL,5,IKL)+RAER(IAE,6)*PAER(JL,6,IKL)  
+    PTAUAERL(JL,JK, 7)=ZTAUAER(4)
+    IAE=5
+    ZTAUAER(IAE) =&
+   & RAER(IAE,1)*PAER(JL,1,IKL)+RAER(IAE,2)*PAER(JL,2,IKL)&
+   & +RAER(IAE,3)*PAER(JL,3,IKL)+RAER(IAE,4)*PAER(JL,4,IKL)&
+   & +RAER(IAE,5)*PAER(JL,5,IKL)+RAER(IAE,6)*PAER(JL,6,IKL)  
+    PTAUAERL(JL,JK,10)=ZTAUAER(5)
+    PTAUAERL(JL,JK,11)=ZTAUAER(5)
+    PTAUAERL(JL,JK,12)=ZTAUAER(5)
+    PTAUAERL(JL,JK,13)=ZTAUAER(5)
+    PTAUAERL(JL,JK,14)=ZTAUAER(5)
+    PTAUAERL(JL,JK,15)=ZTAUAER(5)
+    PTAUAERL(JL,JK,16)=ZTAUAER(5)
+    ENDDO
+  ENDDO
+ENDIF
+
+  DO J2=1,KLEV
+    DO J1=1,JPXSEC
+DO JL = KIDIA, KFDIA
+      PWX(JL,J1,J2)=0.0_JPRB
+ENDDO
+    ENDDO
+  ENDDO
+
+  DO JK = 1, KLEV
+DO JL = KIDIA, KFDIA
+!- Set cross section molecule amounts from ECRT; convert to vmr
+    PWX(JL,1,JK) = PCL4(JL,KLEV-JK+1) * ZAMD/ZAMCL4
+    PWX(JL,2,JK) = PC11(JL,KLEV-JK+1) * ZAMD/ZAMC11
+    PWX(JL,3,JK) = PC12(JL,KLEV-JK+1) * ZAMD/ZAMC12
+    PWX(JL,4,JK) = PC22(JL,KLEV-JK+1) * ZAMD/ZAMC22
+    PWX(JL,1,JK) = PCOLDRY(JL,JK) * PWX(JL,1,JK) * 1.E-20_JPRB
+    PWX(JL,2,JK) = PCOLDRY(JL,JK) * PWX(JL,2,JK) * 1.E-20_JPRB
+    PWX(JL,3,JK) = PCOLDRY(JL,JK) * PWX(JL,3,JK) * 1.E-20_JPRB
+    PWX(JL,4,JK) = PCOLDRY(JL,JK) * PWX(JL,4,JK) * 1.E-20_JPRB
+
+!- Here, all molecules in WKL and WX are in volume mixing ratio; convert to
+!  molec/cm2 based on COLDRY for use in RRTM
+
+!CDIR UNROLL=6
+ZSUMMOL = 0.0_JPRB
+!AB broadening gases
+    DO JMOL = 2, ITMOL
+      ZSUMMOL = ZSUMMOL + PWKL(JL,JMOL,JK)
+    ENDDO
+    PWBRODL(JL,JK) = PCOLDRY(JL,JK) * (1._JPRB - ZSUMMOL)
+    DO JMOL = 1, ITMOL
+      PWKL(JL,JMOL,JK) = PCOLDRY(JL,JK) * PWKL(JL,JMOL,JK)
+    ENDDO    
+ENDDO
+  ENDDO
+
+!- McICA: No overlap; simple copy of optical thickness; layer cloud cover is 0. or 1.
+
+  DO JK=1,KLEV
+    DO JCOLS=1,KCOLS
+DO JL = KIDIA, KFDIA
+      PCLDFRAC(JL,JCOLS,JK)=PCLDF(JL,JCOLS,JK)
+      PTAUCLD(JL,JK,JCOLS) =PTAUCLDI(JL,JK,JCOLS)
+ENDDO
+    ENDDO
+  ENDDO
+
+!     ------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('RRTM_ECRT_140GP_MCICA',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE RRTM_ECRT_140GP_MCICA
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_gas_optical_depth.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_gas_optical_depth.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_gas_optical_depth.F90	(revision 3908)
@@ -0,0 +1,197 @@
+!option! -pvctl no_on_adb
+!option! -pvctl nocollapse
+SUBROUTINE RRTM_GAS_OPTICAL_DEPTH(KIDIA,KFDIA,KLEV,POD,PAVEL, PCOLDRY,PCOLBRD,PWX,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
+ & PCOLH2O,PCOLCO2,PCOLO3,PCOLN2O,PCOLCH4,PCOLO2,P_CO2MULT,&
+ & KLAYTROP,KLAYSWTCH,KLAYLOW,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
+ & KINDMINOR,PSCALEMINOR,PSCALEMINORN2,PMINORFRAC,&
+ &  PRAT_H2OCO2, PRAT_H2OCO2_1, PRAT_H2OO3, PRAT_H2OO3_1, &
+ &  PRAT_H2ON2O, PRAT_H2ON2O_1, PRAT_H2OCH4, PRAT_H2OCH4_1, &
+ &  PRAT_N2OCO2, PRAT_N2OCO2_1, PRAT_O3CO2, PRAT_O3CO2_1)  
+
+! R. J. Hogan   20160831  Adapted from rrtm_gasabs1a_140gp.F90
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE PARRRTM  , ONLY : JPBAND   ,JPXSEC
+USE YOERRTM  , ONLY : JPGPT
+USE YOERRTAB , ONLY : TRANS    ,BPADE
+
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: POD(JPGPT,KLEV,KIDIA:KFDIA) ! Optical depth: note different orientation
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PAVEL(KIDIA:KFDIA,KLEV) ! Layer pressures (Pa)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLDRY(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PWX(KIDIA:KFDIA,JPXSEC,KLEV) ! Amount of trace gases
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUAERL(KIDIA:KFDIA,KLEV,JPBAND) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KJP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KJT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KJT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PONEMINUS
+
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLH2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLCO2(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLO3(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLN2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLCH4(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLO2(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_CO2MULT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLAYTROP(KIDIA:KFDIA) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLAYSWTCH(KIDIA:KFDIA) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLAYLOW(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PSELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PSELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KINDSELF(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PFORFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PFORFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KINDFOR(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PMINORFRAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PSCALEMINOR(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PSCALEMINORN2(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KINDMINOR(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLBRD(KIDIA:KFDIA,KLEV)  
+REAL(KIND=JPRB)  , INTENT(IN) :: &                  !
+                    &   PRAT_H2OCO2(KIDIA:KFDIA,KLEV),PRAT_H2OCO2_1(KIDIA:KFDIA,KLEV), &
+                    &   PRAT_H2OO3(KIDIA:KFDIA,KLEV),PRAT_H2OO3_1(KIDIA:KFDIA,KLEV), & !    DIMENSIONS: (NLAYERS)
+                    &   PRAT_H2ON2O(KIDIA:KFDIA,KLEV),PRAT_H2ON2O_1(KIDIA:KFDIA,KLEV), &
+                    &   PRAT_H2OCH4(KIDIA:KFDIA,KLEV),PRAT_H2OCH4_1(KIDIA:KFDIA,KLEV), &
+                    &   PRAT_N2OCO2(KIDIA:KFDIA,KLEV),PRAT_N2OCO2_1(KIDIA:KFDIA,KLEV), &
+                    &   PRAT_O3CO2(KIDIA:KFDIA,KLEV),PRAT_O3CO2_1(KIDIA:KFDIA,KLEV)
+           
+REAL(KIND=JPRB) :: ZTAU   (KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) :: ZTF
+
+INTEGER(KIND=JPIM) :: JI, ITR, JLEV
+INTEGER(KIND=JPIM) :: JLON
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "rrtm_taumol1.intfb.h"
+#include "rrtm_taumol10.intfb.h"
+#include "rrtm_taumol11.intfb.h"
+#include "rrtm_taumol12.intfb.h"
+#include "rrtm_taumol13.intfb.h"
+#include "rrtm_taumol14.intfb.h"
+#include "rrtm_taumol15.intfb.h"
+#include "rrtm_taumol16.intfb.h"
+#include "rrtm_taumol2.intfb.h"
+#include "rrtm_taumol3.intfb.h"
+#include "rrtm_taumol4.intfb.h"
+#include "rrtm_taumol5.intfb.h"
+#include "rrtm_taumol6.intfb.h"
+#include "rrtm_taumol7.intfb.h"
+#include "rrtm_taumol8.intfb.h"
+#include "rrtm_taumol9.intfb.h"
+
+!CDIR DUPLICATE(TRANS,256)
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('RRTM_GAS_OPTICAL_DEPTH',0,ZHOOK_HANDLE)
+
+CALL RRTM_TAUMOL1  (KIDIA,KFDIA,KLEV,ZTAU,PAVEL,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
+ & PCOLH2O,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, PMINORFRAC, &
+ & KINDMINOR,PSCALEMINORN2,PCOLBRD)  
+CALL RRTM_TAUMOL2  (KIDIA,KFDIA,KLEV,ZTAU,PAVEL,PCOLDRY,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
+ & PCOLH2O,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC)  
+CALL RRTM_TAUMOL3  (KIDIA,KFDIA,KLEV,ZTAU,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
+ & PCOLH2O,PCOLCO2,PCOLN2O,PCOLDRY,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
+ & PRAT_H2OCO2, PRAT_H2OCO2_1,PMINORFRAC,KINDMINOR)  
+CALL RRTM_TAUMOL4  (KIDIA,KFDIA,KLEV,ZTAU,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
+ & PCOLH2O,PCOLCO2,PCOLO3,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
+ & PRAT_H2OCO2, PRAT_H2OCO2_1, PRAT_O3CO2, PRAT_O3CO2_1)  
+CALL RRTM_TAUMOL5  (KIDIA,KFDIA,KLEV,ZTAU,PWX,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
+ & PCOLH2O,PCOLCO2,PCOLO3,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
+ & PRAT_H2OCO2, PRAT_H2OCO2_1, PRAT_O3CO2, PRAT_O3CO2_1,PMINORFRAC,KINDMINOR)   
+CALL RRTM_TAUMOL6  (KIDIA,KFDIA,KLEV,ZTAU,PWX,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
+ & PCOLH2O,PCOLCO2,PCOLDRY,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC,PMINORFRAC,KINDMINOR)  
+CALL RRTM_TAUMOL7  (KIDIA,KFDIA,KLEV,ZTAU,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
+ & PCOLH2O,PCOLO3,PCOLCO2,PCOLDRY,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
+ & PRAT_H2OO3, PRAT_H2OO3_1,PMINORFRAC,KINDMINOR)  
+CALL RRTM_TAUMOL8  (KIDIA,KFDIA,KLEV,ZTAU,PWX,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
+ & PCOLH2O,PCOLO3,PCOLN2O,PCOLCO2,PCOLDRY,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
+ & PMINORFRAC,KINDMINOR)  
+CALL RRTM_TAUMOL9  (KIDIA,KFDIA,KLEV,ZTAU,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
+ & PCOLH2O,PCOLN2O,PCOLCH4,PCOLDRY,KLAYTROP,KLAYSWTCH,KLAYLOW,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
+ & PRAT_H2OCH4,PRAT_H2OCH4_1,PMINORFRAC,KINDMINOR)  
+CALL RRTM_TAUMOL10 (KIDIA,KFDIA,KLEV,ZTAU,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
+ & PCOLH2O,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC)  
+CALL RRTM_TAUMOL11 (KIDIA,KFDIA,KLEV,ZTAU,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
+ & PCOLH2O,PCOLO2,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC,PMINORFRAC,KINDMINOR,PSCALEMINOR)  
+CALL RRTM_TAUMOL12 (KIDIA,KFDIA,KLEV,ZTAU,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
+ & PCOLH2O,PCOLCO2,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
+ & PRAT_H2OCO2, PRAT_H2OCO2_1)  
+CALL RRTM_TAUMOL13 (KIDIA,KFDIA,KLEV,ZTAU,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
+ & PCOLH2O,PCOLN2O,PCOLCO2,PCOLO3,PCOLDRY,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
+ & PRAT_H2ON2O, PRAT_H2ON2O_1,PMINORFRAC,KINDMINOR)  
+CALL RRTM_TAUMOL14 (KIDIA,KFDIA,KLEV,ZTAU,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
+ & PCOLCO2,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC)  
+CALL RRTM_TAUMOL15 (KIDIA,KFDIA,KLEV,ZTAU,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
+ & PCOLH2O,PCOLCO2,PCOLN2O,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
+ & PRAT_N2OCO2, PRAT_N2OCO2_1,PMINORFRAC,KINDMINOR,PSCALEMINOR,PCOLBRD)  
+CALL RRTM_TAUMOL16 (KIDIA,KFDIA,KLEV,ZTAU,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
+ & PCOLH2O,PCOLCH4,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
+ & PRAT_H2OCH4,PRAT_H2OCH4_1)   
+
+!TO CHECK TOTAL OD FOR EACH BAND
+    ! print*,'ZTAU2= ',sum(ZTAU(:,11:22,:),2)
+    ! print*,'ZTAU3= ',sum(ZTAU(:,23:38,:),2)
+    ! print*,'ZTAU4= ',sum(ZTAU(:,39:52,:),2)
+    ! print*,'ZTAU5= ',sum(ZTAU(:,53:68,:),2)
+    ! print*,'ZTAU6= ',sum(ZTAU(:,69:76,:),2)
+    ! print*,'ZTAU7= ',sum(ZTAU(:,77:88,:),2)
+    ! print*,'ZTAU8= ',sum(ZTAU(:,89:96,:),2)
+    ! print*,'ZTAU9= ',sum(ZTAU(:,97:108,:),2)
+    ! print*,'ZTAU10= ',sum(ZTAU(:,109:114,:),2)
+    ! print*,'ZTAU11= ',sum(ZTAU(:,115:122,:),2)
+    ! print*,'ZTAU12= ',sum(ZTAU(:,123:130,:),2)
+    ! print*,'ZTAU13= ',sum(ZTAU(:,131:134,:),2)
+    ! print*,'ZTAU14= ',sum(ZTAU(:,135:136,:),2)
+    ! print*,'ZTAU15= ',sum(ZTAU(:,137:138,:),2)
+    ! print*,'ZTAU16= ',sum(ZTAU(:,139:140,:),2)
+
+
+!- Loop over g-channels.
+DO JLEV = 1, KLEV
+!cdir unroll=4
+  DO JI = 1, JPGPT
+    DO JLON = KIDIA, KFDIA
+      POD(JI,JLEV,JLON) = ZTAU(JLON,JI,JLEV)
+
+!      ZTF = ZTAU(JLON,JI,JLEV)*1.66_jprb/(BPADE+ZTAU(JLON,JI,JLEV)*1.66_jprb)
+!      ITR=INT(5.E+03_JPRB*ZTF+0.5_JPRB)
+!      write(37,*) pod(ji,jlev,jlon), 1.0_JPRB - TRANS(ITR), ztf
+
+    ENDDO
+  ENDDO
+ENDDO
+!     -----------------------------------------------------------------
+
+IF (LHOOK) CALL DR_HOOK('RRTM_GAS_OPTICAL_DEPTH',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE RRTM_GAS_OPTICAL_DEPTH
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_gas_optical_depth.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_gas_optical_depth.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_gas_optical_depth.intfb.h	(revision 3908)
@@ -0,0 +1,59 @@
+INTERFACE
+SUBROUTINE RRTM_GAS_OPTICAL_DEPTH(KIDIA,KFDIA,KLEV,POD,PAVEL, PCOLDRY,PCOLBRD,PWX,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
+ & PCOLH2O,PCOLCO2,PCOLO3,PCOLN2O,PCOLCH4,PCOLO2,P_CO2MULT,&
+ & KLAYTROP,KLAYSWTCH,KLAYLOW,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC,&
+ & KINDMINOR,PSCALEMINOR,PSCALEMINORN2,PMINORFRAC,&
+ & PRAT_H2OCO2, PRAT_H2OCO2_1, PRAT_H2OO3, PRAT_H2OO3_1,&
+ & PRAT_H2ON2O, PRAT_H2ON2O_1, PRAT_H2OCH4, PRAT_H2OCH4_1,&
+ & PRAT_N2OCO2, PRAT_N2OCO2_1, PRAT_O3CO2, PRAT_O3CO2_1) 
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+USE PARRRTM , ONLY : JPBAND ,JPXSEC
+USE YOERRTM , ONLY : JPGPT
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(OUT) :: POD(JPGPT,KLEV,KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: PAVEL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLDRY(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PWX(KIDIA:KFDIA,JPXSEC,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PTAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KJP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KJT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KJT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PONEMINUS
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLO3(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLN2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLCH4(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_CO2MULT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KLAYTROP(KIDIA:KFDIA)
+INTEGER(KIND=JPIM),INTENT(IN) :: KLAYSWTCH(KIDIA:KFDIA)
+INTEGER(KIND=JPIM),INTENT(IN) :: KLAYLOW(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: PSELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PSELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KINDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KINDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PMINORFRAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PSCALEMINOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PSCALEMINORN2(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KINDMINOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLBRD(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) , INTENT(IN) ::&
+ & PRAT_H2OCO2(KIDIA:KFDIA,KLEV),PRAT_H2OCO2_1(KIDIA:KFDIA,KLEV),&
+ & PRAT_H2OO3(KIDIA:KFDIA,KLEV),PRAT_H2OO3_1(KIDIA:KFDIA,KLEV),&
+ & PRAT_H2ON2O(KIDIA:KFDIA,KLEV),PRAT_H2ON2O_1(KIDIA:KFDIA,KLEV),&
+ & PRAT_H2OCH4(KIDIA:KFDIA,KLEV),PRAT_H2OCH4_1(KIDIA:KFDIA,KLEV),&
+ & PRAT_N2OCO2(KIDIA:KFDIA,KLEV),PRAT_N2OCO2_1(KIDIA:KFDIA,KLEV),&
+ & PRAT_O3CO2(KIDIA:KFDIA,KLEV),PRAT_O3CO2_1(KIDIA:KFDIA,KLEV) 
+END SUBROUTINE RRTM_GAS_OPTICAL_DEPTH
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_gasabs1a_140gp.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_gasabs1a_140gp.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_gasabs1a_140gp.F90	(revision 3908)
@@ -0,0 +1,235 @@
+!option! -pvctl no_on_adb
+!option! -pvctl nocollapse
+SUBROUTINE RRTM_GASABS1A_140GP (KIDIA,KFDIA,KLEV,PATR1,POD,PTF1,PAVEL, PCOLDRY,PCOLBRD,PWX,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
+ & PCOLH2O,PCOLCO2,PCOLO3,PCOLN2O,PCOLCH4,PCOLO2,P_CO2MULT,&
+ & KLAYTROP,KLAYSWTCH,KLAYLOW,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
+ & KINDMINOR,PSCALEMINOR,PSCALEMINORN2,PMINORFRAC,&
+ &  PRAT_H2OCO2, PRAT_H2OCO2_1, PRAT_H2OO3, PRAT_H2OO3_1, &
+ &  PRAT_H2ON2O, PRAT_H2ON2O_1, PRAT_H2OCH4, PRAT_H2OCH4_1, &
+ &  PRAT_N2OCO2, PRAT_N2OCO2_1, PRAT_O3CO2, PRAT_O3CO2_1)  
+
+!        NEC/FC        05-Oct-2009 Optimisation 
+!     Reformatted for F90 by JJMorcrette, ECMWF, 980714
+!        NEC           25-Oct-2007 Optimisations
+!        D. Salmond    11-Dec-2007 Optimizations
+!     JJMorcrette 20110613 flexible number of g-points
+!     ABozzo  201306 update to rrtmg-lw v4.85
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE PARRRTM  , ONLY : JPBAND   ,JPXSEC
+USE YOERRTM  , ONLY : JPGPT
+USE YOERRTAB , ONLY : TRANS    ,BPADE
+
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PATR1(KIDIA:KFDIA,JPGPT,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: POD(KIDIA:KFDIA,JPGPT,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PAVEL(KIDIA:KFDIA,KLEV) ! Layer pressures (Pa)
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTF1(KIDIA:KFDIA,JPGPT,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLDRY(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PWX(KIDIA:KFDIA,JPXSEC,KLEV) ! Amount of trace gases
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUAERL(KIDIA:KFDIA,KLEV,JPBAND) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KJP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KJT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KJT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PONEMINUS
+
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLH2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLCO2(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLO3(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLN2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLCH4(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLO2(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_CO2MULT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLAYTROP(KIDIA:KFDIA) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLAYSWTCH(KIDIA:KFDIA) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLAYLOW(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PSELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PSELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KINDSELF(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PFORFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PFORFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KINDFOR(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PMINORFRAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PSCALEMINOR(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PSCALEMINORN2(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KINDMINOR(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLBRD(KIDIA:KFDIA,KLEV)  
+REAL(KIND=JPRB)  , INTENT(IN) :: &                  !
+                    &   PRAT_H2OCO2(KIDIA:KFDIA,KLEV),PRAT_H2OCO2_1(KIDIA:KFDIA,KLEV), &
+                    &   PRAT_H2OO3(KIDIA:KFDIA,KLEV),PRAT_H2OO3_1(KIDIA:KFDIA,KLEV), & !    DIMENSIONS: (NLAYERS)
+                    &   PRAT_H2ON2O(KIDIA:KFDIA,KLEV),PRAT_H2ON2O_1(KIDIA:KFDIA,KLEV), &
+                    &   PRAT_H2OCH4(KIDIA:KFDIA,KLEV),PRAT_H2OCH4_1(KIDIA:KFDIA,KLEV), &
+                    &   PRAT_N2OCO2(KIDIA:KFDIA,KLEV),PRAT_N2OCO2_1(KIDIA:KFDIA,KLEV), &
+                    &   PRAT_O3CO2(KIDIA:KFDIA,KLEV),PRAT_O3CO2_1(KIDIA:KFDIA,KLEV)
+!- from AER
+!- from INTFAC      
+!- from INTIND
+!- from PRECISE             
+!- from PROFDATA             
+!- from SELF             
+!- from SP             
+REAL(KIND=JPRB) :: ZTAU   (KIDIA:KFDIA,JPGPT,KLEV)
+
+INTEGER(KIND=JPIM) :: JI, ITR, JLEV
+INTEGER(KIND=JPIM) :: JLON
+
+REAL(KIND=JPRB) :: ZODEPTH, ZSECANG, ZTF
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "rrtm_taumol1.intfb.h"
+#include "rrtm_taumol10.intfb.h"
+#include "rrtm_taumol11.intfb.h"
+#include "rrtm_taumol12.intfb.h"
+#include "rrtm_taumol13.intfb.h"
+#include "rrtm_taumol14.intfb.h"
+#include "rrtm_taumol15.intfb.h"
+#include "rrtm_taumol16.intfb.h"
+#include "rrtm_taumol2.intfb.h"
+#include "rrtm_taumol3.intfb.h"
+#include "rrtm_taumol4.intfb.h"
+#include "rrtm_taumol5.intfb.h"
+#include "rrtm_taumol6.intfb.h"
+#include "rrtm_taumol7.intfb.h"
+#include "rrtm_taumol8.intfb.h"
+#include "rrtm_taumol9.intfb.h"
+
+!CDIR DUPLICATE(TRANS,256)
+
+!- SECANG is equal to the secant of the diffusivity angle.
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('RRTM_GASABS1A_140GP',0,ZHOOK_HANDLE)
+ZSECANG = 1.66_JPRB
+
+CALL RRTM_TAUMOL1  (KIDIA,KFDIA,KLEV,ZTAU,PAVEL,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
+ & PCOLH2O,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, PMINORFRAC, &
+ & KINDMINOR,PSCALEMINORN2,PCOLBRD)  
+CALL RRTM_TAUMOL2  (KIDIA,KFDIA,KLEV,ZTAU,PAVEL,PCOLDRY,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
+ & PCOLH2O,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC)  
+CALL RRTM_TAUMOL3  (KIDIA,KFDIA,KLEV,ZTAU,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
+ & PCOLH2O,PCOLCO2,PCOLN2O,PCOLDRY,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
+ & PRAT_H2OCO2, PRAT_H2OCO2_1,PMINORFRAC,KINDMINOR)  
+CALL RRTM_TAUMOL4  (KIDIA,KFDIA,KLEV,ZTAU,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
+ & PCOLH2O,PCOLCO2,PCOLO3,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
+ & PRAT_H2OCO2, PRAT_H2OCO2_1, PRAT_O3CO2, PRAT_O3CO2_1)  
+CALL RRTM_TAUMOL5  (KIDIA,KFDIA,KLEV,ZTAU,PWX,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
+ & PCOLH2O,PCOLCO2,PCOLO3,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
+ & PRAT_H2OCO2, PRAT_H2OCO2_1, PRAT_O3CO2, PRAT_O3CO2_1,PMINORFRAC,KINDMINOR)   
+CALL RRTM_TAUMOL6  (KIDIA,KFDIA,KLEV,ZTAU,PWX,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
+ & PCOLH2O,PCOLCO2,PCOLDRY,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC,PMINORFRAC,KINDMINOR)  
+CALL RRTM_TAUMOL7  (KIDIA,KFDIA,KLEV,ZTAU,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
+ & PCOLH2O,PCOLO3,PCOLCO2,PCOLDRY,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
+ & PRAT_H2OO3, PRAT_H2OO3_1,PMINORFRAC,KINDMINOR)  
+CALL RRTM_TAUMOL8  (KIDIA,KFDIA,KLEV,ZTAU,PWX,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
+ & PCOLH2O,PCOLO3,PCOLN2O,PCOLCO2,PCOLDRY,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
+ & PMINORFRAC,KINDMINOR)  
+CALL RRTM_TAUMOL9  (KIDIA,KFDIA,KLEV,ZTAU,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
+ & PCOLH2O,PCOLN2O,PCOLCH4,PCOLDRY,KLAYTROP,KLAYSWTCH,KLAYLOW,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
+ & PRAT_H2OCH4,PRAT_H2OCH4_1,PMINORFRAC,KINDMINOR)  
+CALL RRTM_TAUMOL10 (KIDIA,KFDIA,KLEV,ZTAU,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
+ & PCOLH2O,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC)  
+CALL RRTM_TAUMOL11 (KIDIA,KFDIA,KLEV,ZTAU,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
+ & PCOLH2O,PCOLO2,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC,PMINORFRAC,KINDMINOR,PSCALEMINOR)  
+CALL RRTM_TAUMOL12 (KIDIA,KFDIA,KLEV,ZTAU,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
+ & PCOLH2O,PCOLCO2,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
+ & PRAT_H2OCO2, PRAT_H2OCO2_1)  
+CALL RRTM_TAUMOL13 (KIDIA,KFDIA,KLEV,ZTAU,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
+ & PCOLH2O,PCOLN2O,PCOLCO2,PCOLO3,PCOLDRY,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
+ & PRAT_H2ON2O, PRAT_H2ON2O_1,PMINORFRAC,KINDMINOR)  
+CALL RRTM_TAUMOL14 (KIDIA,KFDIA,KLEV,ZTAU,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
+ & PCOLCO2,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC)  
+CALL RRTM_TAUMOL15 (KIDIA,KFDIA,KLEV,ZTAU,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
+ & PCOLH2O,PCOLCO2,PCOLN2O,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
+ & PRAT_N2OCO2, PRAT_N2OCO2_1,PMINORFRAC,KINDMINOR,PSCALEMINOR,PCOLBRD)  
+CALL RRTM_TAUMOL16 (KIDIA,KFDIA,KLEV,ZTAU,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
+ & PCOLH2O,PCOLCH4,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
+ & PRAT_H2OCH4,PRAT_H2OCH4_1)   
+
+!TO CHECK TOTAL OD FOR EACH BAND
+    ! print*,'ZTAU2= ',sum(ZTAU(:,11:22,:),2)
+    ! print*,'ZTAU3= ',sum(ZTAU(:,23:38,:),2)
+    ! print*,'ZTAU4= ',sum(ZTAU(:,39:52,:),2)
+    ! print*,'ZTAU5= ',sum(ZTAU(:,53:68,:),2)
+    ! print*,'ZTAU6= ',sum(ZTAU(:,69:76,:),2)
+    ! print*,'ZTAU7= ',sum(ZTAU(:,77:88,:),2)
+    ! print*,'ZTAU8= ',sum(ZTAU(:,89:96,:),2)
+    ! print*,'ZTAU9= ',sum(ZTAU(:,97:108,:),2)
+    ! print*,'ZTAU10= ',sum(ZTAU(:,109:114,:),2)
+    ! print*,'ZTAU11= ',sum(ZTAU(:,115:122,:),2)
+    ! print*,'ZTAU12= ',sum(ZTAU(:,123:130,:),2)
+    ! print*,'ZTAU13= ',sum(ZTAU(:,131:134,:),2)
+    ! print*,'ZTAU14= ',sum(ZTAU(:,135:136,:),2)
+    ! print*,'ZTAU15= ',sum(ZTAU(:,137:138,:),2)
+    ! print*,'ZTAU16= ',sum(ZTAU(:,139:140,:),2)
+
+
+DO JLEV = 1, KLEV
+!cdir unroll=4
+  DO JI = 1, JPGPT
+    DO JLON = KIDIA, KFDIA
+      IF (ZTAU(JLON,JI,JLEV) < 0._JPRB) THEN
+9101    FORMAT(1X,'GASABS JLEV,JI,JLON=',I3,I5,I9,' SECANG=',F9.6,' ZTAU=',E12.6)
+      ENDIF
+    ENDDO
+  ENDDO
+ENDDO
+
+
+!- Loop over g-channels.
+DO JLEV = 1, KLEV
+!cdir unroll=4
+  DO JI = 1, JPGPT
+    DO JLON = KIDIA, KFDIA
+      ZODEPTH = ZSECANG * ZTAU(JLON,JI,JLEV)
+      POD(JLON,JI,JLEV) = ZODEPTH
+      ZODEPTH=0.5D0*(ABS(ZODEPTH)+ZODEPTH)
+
+!-- revised code to get the pre-computed transmission
+!          IF (ODEPTH.LE.0.) PRINT*, 'ODEPTH = ',ODEPTH
+!!  IF (ODEPTH <= _ZERO_)THEN
+!!    ATR1(JI,LAY) = _ONE_ - TRANS(0)
+!!    TF1(JI,LAY) = _ZERO_
+!!  ELSE
+
+      ZTF = ZODEPTH/(BPADE+ZODEPTH)
+
+      ITR=INT(5.E+03_JPRB*ZTF+0.5_JPRB)
+      PATR1(JLON,JI,JLEV) = 1.0_JPRB - TRANS(ITR)
+      PTF1(JLON,JI,JLEV) = ZTF
+!!  ENDIF
+    ENDDO
+  ENDDO
+ENDDO
+!     -----------------------------------------------------------------
+
+IF (LHOOK) CALL DR_HOOK('RRTM_GASABS1A_140GP',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE RRTM_GASABS1A_140GP
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_gasabs1a_140gp.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_gasabs1a_140gp.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_gasabs1a_140gp.intfb.h	(revision 3908)
@@ -0,0 +1,61 @@
+INTERFACE
+SUBROUTINE RRTM_GASABS1A_140GP (KIDIA,KFDIA,KLEV,PATR1,POD,PTF1,PAVEL, PCOLDRY,PCOLBRD,PWX,&
+ & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
+ & PCOLH2O,PCOLCO2,PCOLO3,PCOLN2O,PCOLCH4,PCOLO2,P_CO2MULT,&
+ & KLAYTROP,KLAYSWTCH,KLAYLOW,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC,&
+ & KINDMINOR,PSCALEMINOR,PSCALEMINORN2,PMINORFRAC,&
+ & PRAT_H2OCO2, PRAT_H2OCO2_1, PRAT_H2OO3, PRAT_H2OO3_1,&
+ & PRAT_H2ON2O, PRAT_H2ON2O_1, PRAT_H2OCH4, PRAT_H2OCH4_1,&
+ & PRAT_N2OCO2, PRAT_N2OCO2_1, PRAT_O3CO2, PRAT_O3CO2_1) 
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+USE PARRRTM , ONLY : JPBAND ,JPXSEC
+USE YOERRTM , ONLY : JPGPT
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(OUT) :: PATR1(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: POD(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PAVEL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PTF1(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLDRY(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PWX(KIDIA:KFDIA,JPXSEC,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PTAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KJP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KJT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KJT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PONEMINUS
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLO3(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLN2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLCH4(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_CO2MULT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KLAYTROP(KIDIA:KFDIA)
+INTEGER(KIND=JPIM),INTENT(IN) :: KLAYSWTCH(KIDIA:KFDIA)
+INTEGER(KIND=JPIM),INTENT(IN) :: KLAYLOW(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: PSELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PSELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KINDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KINDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PMINORFRAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PSCALEMINOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PSCALEMINORN2(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KINDMINOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLBRD(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) , INTENT(IN) ::&
+ & PRAT_H2OCO2(KIDIA:KFDIA,KLEV),PRAT_H2OCO2_1(KIDIA:KFDIA,KLEV),&
+ & PRAT_H2OO3(KIDIA:KFDIA,KLEV),PRAT_H2OO3_1(KIDIA:KFDIA,KLEV),&
+ & PRAT_H2ON2O(KIDIA:KFDIA,KLEV),PRAT_H2ON2O_1(KIDIA:KFDIA,KLEV),&
+ & PRAT_H2OCH4(KIDIA:KFDIA,KLEV),PRAT_H2OCH4_1(KIDIA:KFDIA,KLEV),&
+ & PRAT_N2OCO2(KIDIA:KFDIA,KLEV),PRAT_N2OCO2_1(KIDIA:KFDIA,KLEV),&
+ & PRAT_O3CO2(KIDIA:KFDIA,KLEV),PRAT_O3CO2_1(KIDIA:KFDIA,KLEV) 
+END SUBROUTINE RRTM_GASABS1A_140GP
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_init_140gp.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_init_140gp.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_init_140gp.F90	(revision 3908)
@@ -0,0 +1,187 @@
+!***************************************************************************
+SUBROUTINE RRTM_INIT_140GP(DIRECTORY)
+!***************************************************************************
+!     Reformatted for F90 by JJMorcrette, ECMWF, 980714
+
+!     JJMorcrette 20110613 flexible number of g-points
+
+! Parameters
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE PARRRTM  , ONLY : JPBAND   ,JPG
+USE YOERRTM  , ONLY : JPGPT
+USE YOERRTWN , ONLY : NG       
+USE YOERRTFTR, ONLY : NGC      ,NGN      ,NGM     , WT
+! Output
+USE YOERRTBG2, ONLY : CORR1    ,CORR2
+USE YOERRTRWT, ONLY : FREFA    ,FREFB    ,FREFADF  ,FREFBDF   ,RWGT
+!USE YOMLUN   , ONLY : NULOUT
+
+IMPLICIT NONE
+
+CHARACTER(LEN=*), INTENT(IN) :: DIRECTORY
+
+REAL(KIND=JPRB) :: ZWTSM(JPG)
+
+INTEGER(KIND=JPIM) :: I, IBND, IG, IGC, IGCSM, IND, IPR, IPRSM, IPT
+
+REAL(KIND=JPRB) :: ZFP, ZRTFP, ZWTSUM
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+!#include "surrtmcf.intfb.h"
+#include "surrtftr.intfb.h"
+
+#include "rrtm_kgb1.intfb.h"
+#include "rrtm_kgb10.intfb.h"
+#include "rrtm_kgb11.intfb.h"
+#include "rrtm_kgb12.intfb.h"
+#include "rrtm_kgb13.intfb.h"
+#include "rrtm_kgb14.intfb.h"
+#include "rrtm_kgb15.intfb.h"
+#include "rrtm_kgb16.intfb.h"
+#include "rrtm_kgb2.intfb.h"
+#include "rrtm_kgb3.intfb.h"
+#include "rrtm_kgb4.intfb.h"
+#include "rrtm_kgb5.intfb.h"
+#include "rrtm_kgb6.intfb.h"
+#include "rrtm_kgb7.intfb.h"
+#include "rrtm_kgb8.intfb.h"
+#include "rrtm_kgb9.intfb.h"
+
+#include "rrtm_cmbgb1.intfb.h"
+#include "rrtm_cmbgb10.intfb.h"
+#include "rrtm_cmbgb11.intfb.h"
+#include "rrtm_cmbgb12.intfb.h"
+#include "rrtm_cmbgb13.intfb.h"
+#include "rrtm_cmbgb14.intfb.h"
+#include "rrtm_cmbgb15.intfb.h"
+#include "rrtm_cmbgb16.intfb.h"
+#include "rrtm_cmbgb2.intfb.h"
+#include "rrtm_cmbgb3.intfb.h"
+#include "rrtm_cmbgb4.intfb.h"
+#include "rrtm_cmbgb5.intfb.h"
+#include "rrtm_cmbgb6.intfb.h"
+#include "rrtm_cmbgb7.intfb.h"
+#include "rrtm_cmbgb8.intfb.h"
+#include "rrtm_cmbgb9.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('RRTM_INIT_140GP',0,ZHOOK_HANDLE)
+
+!CALL SURRTMCF
+CALL SURRTFTR
+
+! Read the absorption-related coefficients over the 16 x 16 g-points
+
+CALL RRTM_KGB1(DIRECTORY)
+CALL RRTM_KGB2
+CALL RRTM_KGB3
+CALL RRTM_KGB4
+CALL RRTM_KGB5
+CALL RRTM_KGB6
+CALL RRTM_KGB7
+CALL RRTM_KGB8
+CALL RRTM_KGB9
+CALL RRTM_KGB10
+CALL RRTM_KGB11
+CALL RRTM_KGB12
+CALL RRTM_KGB13
+CALL RRTM_KGB14
+CALL RRTM_KGB15
+CALL RRTM_KGB16
+
+!  Calculate lookup tables for functions needed in routine TAUMOL (TAUGB2)
+
+CORR1(0) = 1.0_JPRB
+CORR1(200) = 1.0_JPRB
+CORR2(0) = 1.0_JPRB
+CORR2(200) = 1.0_JPRB
+DO I = 1,199
+  ZFP = 0.005_JPRB*REAL(I)
+  ZRTFP = SQRT(ZFP)
+  CORR1(I) = ZRTFP/ZFP
+  CORR2(I) = (1.0_JPRB-ZRTFP)/(1.0_JPRB-ZFP)
+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
+!WRITE(NULOUT,9001) JPBAND,JPG,JPGPT
+9001 format(1x,'rrtm_init JPBAND=',I3,' JPG=',I3,' JPGPT=',I3)
+DO IBND = 1,JPBAND
+  IPRSM = 0
+!  WRITE(NULOUT,9002) IBND,NGC(IBND)
+9002 format(1x,'rrtm_init NGC(',I3,')=',I3)
+  IF (NGC(IBND) < 16) THEN
+    DO IGC = 1,NGC(IBND)
+      IGCSM = IGCSM + 1
+      ZWTSUM = 0.0_JPRB
+!      WRITE(NULOUT,9003) IGC,IGCSM,NGN(IGCSM)
+9003  format(1x,'rrtm_init IGC=',I3,' NGN(',I3,')=',I3)
+      DO IPR = 1, NGN(IGCSM)
+        IPRSM = IPRSM + 1
+!        WRITE(NULOUT,9004) IPR,IPRSM,WT(IPRSM)
+9004    format(1x,'rrtm_init IPR=',I3,' WT(',I3,')=',E14.7)
+        ZWTSUM = ZWTSUM + WT(IPRSM)
+      ENDDO
+!      WRITE(NULOUT,9005) IGC,ZWTSUM
+9005  format(1x,'rrtm_init WTSM(',I3,')=',E14.7)
+      ZWTSM(IGC) = ZWTSUM
+    ENDDO
+
+!    WRITE(NULOUT,9006) IBND,NG(IBND)
+9006 format(1x,'rrtm_init NG(',I3,')=',I3)
+    DO IG = 1,NG(IBND)
+      IND = (IBND-1)*16 + IG
+      RWGT(IND) = WT(IG)/ZWTSM(NGM(IND))
+!      WRITE(NULOUT,9007) IND,NGM(IND),IG,WT(IG),ZWTSM(NGM(IND)),IND,RWGT(IND)
+9007 format(1x,'rrtm_init NGM(',I3,')=',I3,' WT(',I3,')=',E13.7,' WTSM=',E13.7,' RWGT(',I3,')=',E13.7)
+    ENDDO
+  ELSE
+    DO IG = 1,NG(IBND)
+      IGCSM = IGCSM + 1
+      IND = (IBND-1)*16 + IG
+      RWGT(IND) = 1.0_JPRB
+    ENDDO
+  ENDIF
+ENDDO
+
+!  Initialize arrays for combined Planck fraction data.
+
+DO IPT = 1,13
+  DO IPR = 1, JPGPT
+    FREFA(IPR,IPT) = 0.0_JPRB
+    FREFADF(IPR,IPT) = 0.0_JPRB
+  ENDDO
+ENDDO
+DO IPT = 1,6
+  DO IPR = 1, JPGPT
+    FREFB(IPR,IPT) = 0.0_JPRB
+    FREFBDF(IPR,IPT) = 0.0_JPRB
+  ENDDO
+ENDDO
+
+!  Reduce g-points for relevant data in each LW spectral band.
+
+CALL RRTM_CMBGB1
+CALL RRTM_CMBGB2
+CALL RRTM_CMBGB3
+CALL RRTM_CMBGB4
+CALL RRTM_CMBGB5
+CALL RRTM_CMBGB6
+CALL RRTM_CMBGB7
+CALL RRTM_CMBGB8
+CALL RRTM_CMBGB9
+CALL RRTM_CMBGB10
+CALL RRTM_CMBGB11
+CALL RRTM_CMBGB12
+CALL RRTM_CMBGB13
+CALL RRTM_CMBGB14
+CALL RRTM_CMBGB15
+CALL RRTM_CMBGB16
+
+IF (LHOOK) CALL DR_HOOK('RRTM_INIT_140GP',1,ZHOOK_HANDLE)
+END SUBROUTINE RRTM_INIT_140GP
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_init_140gp.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_init_140gp.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_init_140gp.intfb.h	(revision 3908)
@@ -0,0 +1,5 @@
+INTERFACE
+SUBROUTINE RRTM_INIT_140GP(DIRECTORY)
+CHARACTER(LEN=*), INTENT(IN) :: DIRECTORY
+END SUBROUTINE RRTM_INIT_140GP
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb1.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb1.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb1.F90	(revision 3908)
@@ -0,0 +1,355 @@
+SUBROUTINE RRTM_KGB1(DIRECTORY)
+
+!     Originally by Eli J. Mlawer, Atmospheric & Environmental Research.
+!     BAND 1:  10-250 cm-1 (low - H2O; high - H2O)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+!     G.Mozdzynski March 2011 read constants from files
+!     ABozzo May 2013 update to RRTMG v4.85
+!     band 1:  10-350 cm-1
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+USE YOMLUN    ,ONLY : NULRAD
+USE MPL_MODULE,ONLY : MPL_BROADCAST
+USE YOMTAG    ,ONLY : MTAGRAD
+USE YOMMP0    , ONLY : NPROC, MYPROC
+
+USE YOERRTO1 , ONLY : KAO     ,KBO     ,KAO_D,KBO_D,SELFREFO   ,FRACREFAO ,&
+ & FRACREFBO  ,FORREFO, KAO_MN2, KBO_MN2
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+
+CHARACTER(LEN=*), INTENT(IN) :: DIRECTORY
+
+!CHARACTER(LEN = 80) :: CLZZZ
+CHARACTER(LEN = 255) :: CLF1
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB1',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+  !CALL GETENV("DATA",CLZZZ)
+  !IF(CLZZZ /= " ") THEN
+  !  CLF1=TRIM(CLZZZ) // "/RADRRTM"
+  CLF1 = DIRECTORY // "/RADRRTM"
+  WRITE(0,'(A,A)') 'Reading ',TRIM(CLF1)
+  OPEN(NULRAD,FILE=TRIM(CLF1),FORM="UNFORMATTED",ACTION="READ",ERR=1000,convert='big_endian')
+  !ELSE
+ ! OPEN(NULRAD,FILE='RADRRTM',FORM="UNFORMATTED",ACTION="READ",ERR=1000)
+  !ENDIF
+  READ(NULRAD,ERR=1001) KAO_D,KBO_D
+ ! Convert the data into model actual precision.
+  KAO = REAL(KAO_D,JPRB)
+  KBO = REAL(KBO_D,JPRB)
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KAO,MTAGRAD,1,CDSTRING='RRTM_KGB1:')
+  CALL MPL_BROADCAST (KBO,MTAGRAD,1,CDSTRING='RRTM_KGB1:')
+ENDIF
+
+! Planck fraction mapping level: P = 212.7250 mbar, T = 223.06 K
+FRACREFAO(:) = (/ &
+ & 2.1227E-01_JPRB,1.8897E-01_JPRB,1.3934E-01_JPRB,1.1557E-01_JPRB,9.5282E-02_JPRB,8.3359E-02_JPRB, &
+ & 6.5333E-02_JPRB,5.2016E-02_JPRB,3.4272E-02_JPRB,4.0257E-03_JPRB,3.1857E-03_JPRB,2.6014E-03_JPRB, &
+ & 1.9141E-03_JPRB,1.2612E-03_JPRB,5.3169E-04_JPRB,7.6476E-05_JPRB/)
+
+! Planck fraction mapping level: P = 212.7250 mbar, T = 223.06 K
+! These Planck fractions were calculated using lower atmosphere
+! parameters.
+FRACREFBO(:) = (/ &
+ & 2.1227E-01_JPRB,1.8897E-01_JPRB,1.3934E-01_JPRB,1.1557E-01_JPRB,9.5282E-02_JPRB,8.3359E-02_JPRB, &
+ & 6.5333E-02_JPRB,5.2016E-02_JPRB,3.4272E-02_JPRB,4.0257E-03_JPRB,3.1857E-03_JPRB,2.6014E-03_JPRB, &
+ & 1.9141E-03_JPRB,1.2612E-03_JPRB,5.3169E-04_JPRB,7.6476E-05_JPRB/)
+
+!     The array FORREFO contains the coefficient of the water vapor
+!     foreign-continuum (including the energy term).  The first 
+!     index refers to reference temperature (296,260,224,260) and 
+!     pressure (970,475,219,3 mbar) levels.  The second index 
+!     runs over the g-channel (1 to 16).
+
+      FORREFO(1,:) = (/ &
+     & 3.6742e-02_JPRB,1.0664e-01_JPRB,2.6132e-01_JPRB,2.7906e-01_JPRB,2.8151e-01_JPRB,2.7465e-01_JPRB, &
+     & 2.8530e-01_JPRB,2.9123e-01_JPRB,3.0697e-01_JPRB,3.1801e-01_JPRB,3.2444e-01_JPRB,2.7746e-01_JPRB, &
+     & 3.1994e-01_JPRB,2.9750e-01_JPRB,2.1226e-01_JPRB,1.2847e-01_JPRB/)
+      FORREFO(2,:) = (/ &
+     & 4.0450e-02_JPRB,1.1085e-01_JPRB,2.9205e-01_JPRB,3.1934e-01_JPRB,3.1739e-01_JPRB,3.1450e-01_JPRB, &
+     & 3.2797e-01_JPRB,3.2223e-01_JPRB,3.3099e-01_JPRB,3.4800e-01_JPRB,3.4046e-01_JPRB,3.5700e-01_JPRB, &
+     & 3.8264e-01_JPRB,3.6679e-01_JPRB,3.3481e-01_JPRB,3.2113e-01_JPRB/)
+      FORREFO(3,:) = (/ &
+     & 4.6952e-02_JPRB,1.1999e-01_JPRB,3.1473e-01_JPRB,3.7015e-01_JPRB,3.6913e-01_JPRB,3.6352e-01_JPRB, &
+     & 3.7754e-01_JPRB,3.7402e-01_JPRB,3.7113e-01_JPRB,3.7720e-01_JPRB,3.8365e-01_JPRB,4.0876e-01_JPRB, &
+     & 4.2968e-01_JPRB,4.4186e-01_JPRB,4.3468e-01_JPRB,4.7083e-01_JPRB/)
+      FORREFO(4,:) = (/ &
+     & 7.0645e-02_JPRB,1.6618e-01_JPRB,2.8516e-01_JPRB,3.1819e-01_JPRB,3.0131e-01_JPRB,2.9552e-01_JPRB, &
+     & 2.8972e-01_JPRB,2.9348e-01_JPRB,2.8668e-01_JPRB,2.8483e-01_JPRB,2.8130e-01_JPRB,2.7757e-01_JPRB, &
+     & 2.9735e-01_JPRB,3.1684e-01_JPRB,3.0681e-01_JPRB,3.6778e-01_JPRB/)
+
+
+!     ------------------------------------------------------------------
+
+!     The array KAO contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels > ~100mb and temperatures.  The first
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the corresponding TREF for this  pressure level, 
+!     JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, 
+!     JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  The second 
+!     index, JP, runs from 1 to 13 and refers to the corresponding 
+!     pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).  
+!     The third index, IG, goes from 1 to 16, and tells us which 
+!     g-interval the absorption coefficients are for.
+
+
+
+!     The array KBO contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels < ~100mb and temperatures. The first 
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the reference temperature TREF for this pressure 
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
+!     The second index, JP, runs from 13 to 59 and refers to the JPth
+!     reference pressure level (see taumol.f for the value of these
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
+!     and tells us which g-interval the absorption coefficients are for.
+
+
+
+     KAO_MN2(:, 1) = (/ &
+     & 5.12042E-08_JPRB, 5.51239E-08_JPRB, 5.93436E-08_JPRB, 6.38863E-08_JPRB, 6.87767E-08_JPRB, &
+     & 7.40415E-08_JPRB, 7.97093E-08_JPRB, 8.58110E-08_JPRB, 9.23797E-08_JPRB, 9.94513E-08_JPRB, &
+     & 1.07064E-07_JPRB, 1.15260E-07_JPRB, 1.24083E-07_JPRB, 1.33581E-07_JPRB, 1.43807E-07_JPRB, &
+     & 1.54815E-07_JPRB, 1.66666E-07_JPRB, 1.79424E-07_JPRB, 1.93159E-07_JPRB/)
+      KAO_MN2(:, 2) = (/ &
+     & 2.30938E-07_JPRB, 2.41696E-07_JPRB, 2.52955E-07_JPRB, 2.64738E-07_JPRB, 2.77071E-07_JPRB, &
+     & 2.89978E-07_JPRB, 3.03486E-07_JPRB, 3.17623E-07_JPRB, 3.32419E-07_JPRB, 3.47904E-07_JPRB, &
+     & 3.64111E-07_JPRB, 3.81072E-07_JPRB, 3.98824E-07_JPRB, 4.17402E-07_JPRB, 4.36846E-07_JPRB, &
+     & 4.57196E-07_JPRB, 4.78494E-07_JPRB, 5.00784E-07_JPRB, 5.24112E-07_JPRB/)
+      KAO_MN2(:, 3) = (/ &
+     & 6.70458E-07_JPRB, 7.04274E-07_JPRB, 7.39795E-07_JPRB, 7.77109E-07_JPRB, 8.16304E-07_JPRB, &
+     & 8.57476E-07_JPRB, 9.00724E-07_JPRB, 9.46154E-07_JPRB, 9.93876E-07_JPRB, 1.04400E-06_JPRB, &
+     & 1.09666E-06_JPRB, 1.15197E-06_JPRB, 1.21008E-06_JPRB, 1.27111E-06_JPRB, 1.33522E-06_JPRB, &
+     & 1.40256E-06_JPRB, 1.47331E-06_JPRB, 1.54761E-06_JPRB, 1.62567E-06_JPRB/)
+      KAO_MN2(:, 4) = (/ &
+     & 1.84182E-06_JPRB, 1.89203E-06_JPRB, 1.94360E-06_JPRB, 1.99658E-06_JPRB, 2.05101E-06_JPRB, &
+     & 2.10692E-06_JPRB, 2.16435E-06_JPRB, 2.22335E-06_JPRB, 2.28396E-06_JPRB, 2.34622E-06_JPRB, &
+     & 2.41017E-06_JPRB, 2.47587E-06_JPRB, 2.54337E-06_JPRB, 2.61270E-06_JPRB, 2.68392E-06_JPRB, &
+     & 2.75708E-06_JPRB, 2.83224E-06_JPRB, 2.90944E-06_JPRB, 2.98875E-06_JPRB/)
+      KAO_MN2(:, 5) = (/ &
+     & 3.41996E-06_JPRB, 3.32758E-06_JPRB, 3.23770E-06_JPRB, 3.15024E-06_JPRB, 3.06515E-06_JPRB, &
+     & 2.98235E-06_JPRB, 2.90180E-06_JPRB, 2.82341E-06_JPRB, 2.74715E-06_JPRB, 2.67294E-06_JPRB, &
+     & 2.60074E-06_JPRB, 2.53049E-06_JPRB, 2.46214E-06_JPRB, 2.39563E-06_JPRB, 2.33092E-06_JPRB, &
+     & 2.26796E-06_JPRB, 2.20670E-06_JPRB, 2.14709E-06_JPRB, 2.08910E-06_JPRB/)
+      KAO_MN2(:, 6) = (/ &
+     & 3.38746E-06_JPRB, 3.25966E-06_JPRB, 3.13669E-06_JPRB, 3.01836E-06_JPRB, 2.90449E-06_JPRB, &
+     & 2.79491E-06_JPRB, 2.68947E-06_JPRB, 2.58801E-06_JPRB, 2.49037E-06_JPRB, 2.39642E-06_JPRB, &
+     & 2.30601E-06_JPRB, 2.21902E-06_JPRB, 2.13530E-06_JPRB, 2.05475E-06_JPRB, 1.97723E-06_JPRB, &
+     & 1.90264E-06_JPRB, 1.83086E-06_JPRB, 1.76179E-06_JPRB, 1.69532E-06_JPRB/)
+      KAO_MN2(:, 7) = (/ &
+     & 3.17530E-06_JPRB, 3.07196E-06_JPRB, 2.97199E-06_JPRB, 2.87527E-06_JPRB, 2.78170E-06_JPRB, &
+     & 2.69118E-06_JPRB, 2.60360E-06_JPRB, 2.51887E-06_JPRB, 2.43690E-06_JPRB, 2.35759E-06_JPRB, &
+     & 2.28087E-06_JPRB, 2.20664E-06_JPRB, 2.13483E-06_JPRB, 2.06536E-06_JPRB, 1.99814E-06_JPRB, &
+     & 1.93312E-06_JPRB, 1.87021E-06_JPRB, 1.80934E-06_JPRB, 1.75046E-06_JPRB/)
+      KAO_MN2(:, 8) = (/ &
+     & 2.84701E-06_JPRB, 2.77007E-06_JPRB, 2.69521E-06_JPRB, 2.62237E-06_JPRB, 2.55150E-06_JPRB, &
+     & 2.48254E-06_JPRB, 2.41545E-06_JPRB, 2.35017E-06_JPRB, 2.28666E-06_JPRB, 2.22486E-06_JPRB, &
+     & 2.16473E-06_JPRB, 2.10623E-06_JPRB, 2.04930E-06_JPRB, 1.99392E-06_JPRB, 1.94003E-06_JPRB, &
+     & 1.88760E-06_JPRB, 1.83659E-06_JPRB, 1.78695E-06_JPRB, 1.73866E-06_JPRB/)
+      KAO_MN2(:, 9) = (/ &
+     & 2.79917E-06_JPRB, 2.73207E-06_JPRB, 2.66658E-06_JPRB, 2.60266E-06_JPRB, 2.54027E-06_JPRB, &
+     & 2.47937E-06_JPRB, 2.41994E-06_JPRB, 2.36192E-06_JPRB, 2.30530E-06_JPRB, 2.25004E-06_JPRB, &
+     & 2.19610E-06_JPRB, 2.14346E-06_JPRB, 2.09208E-06_JPRB, 2.04193E-06_JPRB, 1.99298E-06_JPRB, &
+     & 1.94520E-06_JPRB, 1.89857E-06_JPRB, 1.85306E-06_JPRB, 1.80864E-06_JPRB/)
+      KAO_MN2(:,10) = (/ &
+     & 2.74910E-06_JPRB, 2.64462E-06_JPRB, 2.54412E-06_JPRB, 2.44743E-06_JPRB, 2.35442E-06_JPRB, &
+     & 2.26495E-06_JPRB, 2.17887E-06_JPRB, 2.09606E-06_JPRB, 2.01641E-06_JPRB, 1.93978E-06_JPRB, &
+     & 1.86606E-06_JPRB, 1.79514E-06_JPRB, 1.72692E-06_JPRB, 1.66129E-06_JPRB, 1.59815E-06_JPRB, &
+     & 1.53742E-06_JPRB, 1.47899E-06_JPRB, 1.42278E-06_JPRB, 1.36871E-06_JPRB/)
+      KAO_MN2(:,11) = (/ &
+     & 2.63952E-06_JPRB, 2.60263E-06_JPRB, 2.56626E-06_JPRB, 2.53039E-06_JPRB, 2.49503E-06_JPRB, &
+     & 2.46016E-06_JPRB, 2.42578E-06_JPRB, 2.39188E-06_JPRB, 2.35845E-06_JPRB, 2.32549E-06_JPRB, &
+     & 2.29299E-06_JPRB, 2.26094E-06_JPRB, 2.22934E-06_JPRB, 2.19819E-06_JPRB, 2.16747E-06_JPRB, &
+     & 2.13717E-06_JPRB, 2.10731E-06_JPRB, 2.07786E-06_JPRB, 2.04882E-06_JPRB/)
+      KAO_MN2(:,12) = (/ &
+     & 2.94106E-06_JPRB, 2.82819E-06_JPRB, 2.71966E-06_JPRB, 2.61528E-06_JPRB, 2.51492E-06_JPRB, &
+     & 2.41841E-06_JPRB, 2.32560E-06_JPRB, 2.23635E-06_JPRB, 2.15053E-06_JPRB, 2.06800E-06_JPRB, &
+     & 1.98863E-06_JPRB, 1.91232E-06_JPRB, 1.83893E-06_JPRB, 1.76836E-06_JPRB, 1.70049E-06_JPRB, &
+     & 1.63524E-06_JPRB, 1.57248E-06_JPRB, 1.51214E-06_JPRB, 1.45411E-06_JPRB/)
+      KAO_MN2(:,13) = (/ &
+     & 2.94607E-06_JPRB, 2.87369E-06_JPRB, 2.80309E-06_JPRB, 2.73422E-06_JPRB, 2.66705E-06_JPRB, &
+     & 2.60152E-06_JPRB, 2.53760E-06_JPRB, 2.47526E-06_JPRB, 2.41445E-06_JPRB, 2.35513E-06_JPRB, &
+     & 2.29726E-06_JPRB, 2.24082E-06_JPRB, 2.18577E-06_JPRB, 2.13207E-06_JPRB, 2.07969E-06_JPRB, &
+     & 2.02859E-06_JPRB, 1.97875E-06_JPRB, 1.93014E-06_JPRB, 1.88272E-06_JPRB/)
+      KAO_MN2(:,14) = (/ &
+     & 2.58051E-06_JPRB, 2.48749E-06_JPRB, 2.39782E-06_JPRB, 2.31139E-06_JPRB, 2.22807E-06_JPRB, &
+     & 2.14775E-06_JPRB, 2.07033E-06_JPRB, 1.99570E-06_JPRB, 1.92376E-06_JPRB, 1.85441E-06_JPRB, &
+     & 1.78756E-06_JPRB, 1.72313E-06_JPRB, 1.66101E-06_JPRB, 1.60114E-06_JPRB, 1.54342E-06_JPRB, &
+     & 1.48778E-06_JPRB, 1.43415E-06_JPRB, 1.38245E-06_JPRB, 1.33262E-06_JPRB/)
+      KAO_MN2(:,15) = (/ &
+     & 3.03447E-06_JPRB, 2.88559E-06_JPRB, 2.74401E-06_JPRB, 2.60938E-06_JPRB, 2.48135E-06_JPRB, &
+     & 2.35961E-06_JPRB, 2.24384E-06_JPRB, 2.13375E-06_JPRB, 2.02906E-06_JPRB, 1.92951E-06_JPRB, &
+     & 1.83484E-06_JPRB, 1.74481E-06_JPRB, 1.65921E-06_JPRB, 1.57780E-06_JPRB, 1.50039E-06_JPRB, &
+     & 1.42677E-06_JPRB, 1.35677E-06_JPRB, 1.29020E-06_JPRB, 1.22690E-06_JPRB/)
+      KAO_MN2(:,16) = (/ &
+     & 1.48655E-06_JPRB, 1.48283E-06_JPRB, 1.47913E-06_JPRB, 1.47543E-06_JPRB, 1.47174E-06_JPRB, &
+     & 1.46806E-06_JPRB, 1.46439E-06_JPRB, 1.46072E-06_JPRB, 1.45707E-06_JPRB, 1.45343E-06_JPRB, &
+     & 1.44979E-06_JPRB, 1.44617E-06_JPRB, 1.44255E-06_JPRB, 1.43894E-06_JPRB, 1.43534E-06_JPRB, &
+     & 1.43176E-06_JPRB, 1.42817E-06_JPRB, 1.42460E-06_JPRB, 1.42104E-06_JPRB/)
+      KBO_MN2(:, 1) = (/ &
+     & 5.12042E-08_JPRB, 5.51239E-08_JPRB, 5.93436E-08_JPRB, 6.38863E-08_JPRB, 6.87767E-08_JPRB, &
+     & 7.40415E-08_JPRB, 7.97093E-08_JPRB, 8.58110E-08_JPRB, 9.23797E-08_JPRB, 9.94513E-08_JPRB, &
+     & 1.07064E-07_JPRB, 1.15260E-07_JPRB, 1.24083E-07_JPRB, 1.33581E-07_JPRB, 1.43807E-07_JPRB, &
+     & 1.54815E-07_JPRB, 1.66666E-07_JPRB, 1.79424E-07_JPRB, 1.93159E-07_JPRB/)
+      KBO_MN2(:, 2) = (/ &
+     & 2.30938E-07_JPRB, 2.41696E-07_JPRB, 2.52955E-07_JPRB, 2.64738E-07_JPRB, 2.77071E-07_JPRB, &
+     & 2.89978E-07_JPRB, 3.03486E-07_JPRB, 3.17623E-07_JPRB, 3.32419E-07_JPRB, 3.47904E-07_JPRB, &
+     & 3.64111E-07_JPRB, 3.81072E-07_JPRB, 3.98824E-07_JPRB, 4.17402E-07_JPRB, 4.36846E-07_JPRB, &
+     & 4.57196E-07_JPRB, 4.78494E-07_JPRB, 5.00784E-07_JPRB, 5.24112E-07_JPRB/)
+      KBO_MN2(:, 3) = (/ &
+     & 6.70458E-07_JPRB, 7.04274E-07_JPRB, 7.39795E-07_JPRB, 7.77109E-07_JPRB, 8.16304E-07_JPRB, &
+     & 8.57476E-07_JPRB, 9.00724E-07_JPRB, 9.46154E-07_JPRB, 9.93876E-07_JPRB, 1.04400E-06_JPRB, &
+     & 1.09666E-06_JPRB, 1.15197E-06_JPRB, 1.21008E-06_JPRB, 1.27111E-06_JPRB, 1.33522E-06_JPRB, &
+     & 1.40256E-06_JPRB, 1.47331E-06_JPRB, 1.54761E-06_JPRB, 1.62567E-06_JPRB/)
+      KBO_MN2(:, 4) = (/ &
+     & 1.84182E-06_JPRB, 1.89203E-06_JPRB, 1.94360E-06_JPRB, 1.99658E-06_JPRB, 2.05101E-06_JPRB, &
+     & 2.10692E-06_JPRB, 2.16435E-06_JPRB, 2.22335E-06_JPRB, 2.28396E-06_JPRB, 2.34622E-06_JPRB, &
+     & 2.41017E-06_JPRB, 2.47587E-06_JPRB, 2.54337E-06_JPRB, 2.61270E-06_JPRB, 2.68392E-06_JPRB, &
+     & 2.75708E-06_JPRB, 2.83224E-06_JPRB, 2.90944E-06_JPRB, 2.98875E-06_JPRB/)
+      KBO_MN2(:, 5) = (/ &
+     & 3.41996E-06_JPRB, 3.32758E-06_JPRB, 3.23770E-06_JPRB, 3.15024E-06_JPRB, 3.06515E-06_JPRB, &
+     & 2.98235E-06_JPRB, 2.90180E-06_JPRB, 2.82341E-06_JPRB, 2.74715E-06_JPRB, 2.67294E-06_JPRB, &
+     & 2.60074E-06_JPRB, 2.53049E-06_JPRB, 2.46214E-06_JPRB, 2.39563E-06_JPRB, 2.33092E-06_JPRB, &
+     & 2.26796E-06_JPRB, 2.20670E-06_JPRB, 2.14709E-06_JPRB, 2.08910E-06_JPRB/)
+      KBO_MN2(:, 6) = (/ &
+     & 3.38746E-06_JPRB, 3.25966E-06_JPRB, 3.13669E-06_JPRB, 3.01836E-06_JPRB, 2.90449E-06_JPRB, &
+     & 2.79491E-06_JPRB, 2.68947E-06_JPRB, 2.58801E-06_JPRB, 2.49037E-06_JPRB, 2.39642E-06_JPRB, &
+     & 2.30601E-06_JPRB, 2.21902E-06_JPRB, 2.13530E-06_JPRB, 2.05475E-06_JPRB, 1.97723E-06_JPRB, &
+     & 1.90264E-06_JPRB, 1.83086E-06_JPRB, 1.76179E-06_JPRB, 1.69532E-06_JPRB/)
+      KBO_MN2(:, 7) = (/ &
+     & 3.17530E-06_JPRB, 3.07196E-06_JPRB, 2.97199E-06_JPRB, 2.87527E-06_JPRB, 2.78170E-06_JPRB, &
+     & 2.69118E-06_JPRB, 2.60360E-06_JPRB, 2.51887E-06_JPRB, 2.43690E-06_JPRB, 2.35759E-06_JPRB, &
+     & 2.28087E-06_JPRB, 2.20664E-06_JPRB, 2.13483E-06_JPRB, 2.06536E-06_JPRB, 1.99814E-06_JPRB, &
+     & 1.93312E-06_JPRB, 1.87021E-06_JPRB, 1.80934E-06_JPRB, 1.75046E-06_JPRB/)
+      KBO_MN2(:, 8) = (/ &
+     & 2.84701E-06_JPRB, 2.77007E-06_JPRB, 2.69521E-06_JPRB, 2.62237E-06_JPRB, 2.55150E-06_JPRB, &
+     & 2.48254E-06_JPRB, 2.41545E-06_JPRB, 2.35017E-06_JPRB, 2.28666E-06_JPRB, 2.22486E-06_JPRB, &
+     & 2.16473E-06_JPRB, 2.10623E-06_JPRB, 2.04930E-06_JPRB, 1.99392E-06_JPRB, 1.94003E-06_JPRB, &
+     & 1.88760E-06_JPRB, 1.83659E-06_JPRB, 1.78695E-06_JPRB, 1.73866E-06_JPRB/)
+      KBO_MN2(:, 9) = (/ &
+     & 2.79917E-06_JPRB, 2.73207E-06_JPRB, 2.66658E-06_JPRB, 2.60266E-06_JPRB, 2.54027E-06_JPRB, &
+     & 2.47937E-06_JPRB, 2.41994E-06_JPRB, 2.36192E-06_JPRB, 2.30530E-06_JPRB, 2.25004E-06_JPRB, &
+     & 2.19610E-06_JPRB, 2.14346E-06_JPRB, 2.09208E-06_JPRB, 2.04193E-06_JPRB, 1.99298E-06_JPRB, &
+     & 1.94520E-06_JPRB, 1.89857E-06_JPRB, 1.85306E-06_JPRB, 1.80864E-06_JPRB/)
+      KBO_MN2(:,10) = (/ &
+     & 2.74910E-06_JPRB, 2.64462E-06_JPRB, 2.54412E-06_JPRB, 2.44743E-06_JPRB, 2.35442E-06_JPRB, &
+     & 2.26495E-06_JPRB, 2.17887E-06_JPRB, 2.09606E-06_JPRB, 2.01641E-06_JPRB, 1.93978E-06_JPRB, &
+     & 1.86606E-06_JPRB, 1.79514E-06_JPRB, 1.72692E-06_JPRB, 1.66129E-06_JPRB, 1.59815E-06_JPRB, &
+     & 1.53742E-06_JPRB, 1.47899E-06_JPRB, 1.42278E-06_JPRB, 1.36871E-06_JPRB/)
+      KBO_MN2(:,11) = (/ &
+     & 2.63952E-06_JPRB, 2.60263E-06_JPRB, 2.56626E-06_JPRB, 2.53039E-06_JPRB, 2.49503E-06_JPRB, &
+     & 2.46016E-06_JPRB, 2.42578E-06_JPRB, 2.39188E-06_JPRB, 2.35845E-06_JPRB, 2.32549E-06_JPRB, &
+     & 2.29299E-06_JPRB, 2.26094E-06_JPRB, 2.22934E-06_JPRB, 2.19819E-06_JPRB, 2.16747E-06_JPRB, &
+     & 2.13717E-06_JPRB, 2.10731E-06_JPRB, 2.07786E-06_JPRB, 2.04882E-06_JPRB/)
+      KBO_MN2(:,12) = (/ &
+     & 2.94106E-06_JPRB, 2.82819E-06_JPRB, 2.71966E-06_JPRB, 2.61528E-06_JPRB, 2.51492E-06_JPRB, &
+     & 2.41841E-06_JPRB, 2.32560E-06_JPRB, 2.23635E-06_JPRB, 2.15053E-06_JPRB, 2.06800E-06_JPRB, &
+     & 1.98863E-06_JPRB, 1.91232E-06_JPRB, 1.83893E-06_JPRB, 1.76836E-06_JPRB, 1.70049E-06_JPRB, &
+     & 1.63524E-06_JPRB, 1.57248E-06_JPRB, 1.51214E-06_JPRB, 1.45411E-06_JPRB/)
+      KBO_MN2(:,13) = (/ &
+     & 2.94607E-06_JPRB, 2.87369E-06_JPRB, 2.80309E-06_JPRB, 2.73422E-06_JPRB, 2.66705E-06_JPRB, &
+     & 2.60152E-06_JPRB, 2.53760E-06_JPRB, 2.47526E-06_JPRB, 2.41445E-06_JPRB, 2.35513E-06_JPRB, &
+     & 2.29726E-06_JPRB, 2.24082E-06_JPRB, 2.18577E-06_JPRB, 2.13207E-06_JPRB, 2.07969E-06_JPRB, &
+     & 2.02859E-06_JPRB, 1.97875E-06_JPRB, 1.93014E-06_JPRB, 1.88272E-06_JPRB/)
+      KBO_MN2(:,14) = (/ &
+     & 2.58051E-06_JPRB, 2.48749E-06_JPRB, 2.39782E-06_JPRB, 2.31139E-06_JPRB, 2.22807E-06_JPRB, &
+     & 2.14775E-06_JPRB, 2.07033E-06_JPRB, 1.99570E-06_JPRB, 1.92376E-06_JPRB, 1.85441E-06_JPRB, &
+     & 1.78756E-06_JPRB, 1.72313E-06_JPRB, 1.66101E-06_JPRB, 1.60114E-06_JPRB, 1.54342E-06_JPRB, &
+     & 1.48778E-06_JPRB, 1.43415E-06_JPRB, 1.38245E-06_JPRB, 1.33262E-06_JPRB/)
+      KBO_MN2(:,15) = (/ &
+     & 3.03447E-06_JPRB, 2.88559E-06_JPRB, 2.74401E-06_JPRB, 2.60938E-06_JPRB, 2.48135E-06_JPRB, &
+     & 2.35961E-06_JPRB, 2.24384E-06_JPRB, 2.13375E-06_JPRB, 2.02906E-06_JPRB, 1.92951E-06_JPRB, &
+     & 1.83484E-06_JPRB, 1.74481E-06_JPRB, 1.65921E-06_JPRB, 1.57780E-06_JPRB, 1.50039E-06_JPRB, &
+     & 1.42677E-06_JPRB, 1.35677E-06_JPRB, 1.29020E-06_JPRB, 1.22690E-06_JPRB/)
+      KBO_MN2(:,16) = (/ &
+     & 1.48655E-06_JPRB, 1.48283E-06_JPRB, 1.47913E-06_JPRB, 1.47543E-06_JPRB, 1.47174E-06_JPRB, &
+     & 1.46806E-06_JPRB, 1.46439E-06_JPRB, 1.46072E-06_JPRB, 1.45707E-06_JPRB, 1.45343E-06_JPRB, &
+     & 1.44979E-06_JPRB, 1.44617E-06_JPRB, 1.44255E-06_JPRB, 1.43894E-06_JPRB, 1.43534E-06_JPRB, &
+     & 1.43176E-06_JPRB, 1.42817E-06_JPRB, 1.42460E-06_JPRB, 1.42104E-06_JPRB/)
+
+
+!     The array SELFREFO contains the coefficient of the water vapor
+!     self-continuum (including the energy term).  The first index
+!     refers to temperature in 7.2 degree increments.  For instance,
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+!     etc.  The second index runs over the g-channel (1 to 16).
+
+      SELFREFO(:, 1) = (/ &
+     & 2.16803e+00_JPRB, 1.98236e+00_JPRB, 1.81260e+00_JPRB, 1.65737e+00_JPRB, 1.51544e+00_JPRB, &
+     & 1.38567e+00_JPRB, 1.26700e+00_JPRB, 1.15850e+00_JPRB, 1.05929e+00_JPRB, 9.68576e-01_JPRB/)
+      SELFREFO(:, 2) = (/ &
+     & 3.70149e+00_JPRB, 3.43145e+00_JPRB, 3.18110e+00_JPRB, 2.94902e+00_JPRB, 2.73387e+00_JPRB, &
+     & 2.53441e+00_JPRB, 2.34951e+00_JPRB, 2.17810e+00_JPRB, 2.01919e+00_JPRB, 1.87188e+00_JPRB/)
+      SELFREFO(:, 3) = (/ &
+     & 6.17433e+00_JPRB, 5.62207e+00_JPRB, 5.11920e+00_JPRB, 4.66131e+00_JPRB, 4.24438e+00_JPRB, &
+     & 3.86474e+00_JPRB, 3.51906e+00_JPRB, 3.20430e+00_JPRB, 2.91769e+00_JPRB, 2.65672e+00_JPRB/)
+      SELFREFO(:, 4) = (/ &
+     & 6.56459e+00_JPRB, 5.94787e+00_JPRB, 5.38910e+00_JPRB, 4.88282e+00_JPRB, 4.42410e+00_JPRB, &
+     & 4.00848e+00_JPRB, 3.63190e+00_JPRB, 3.29070e+00_JPRB, 2.98155e+00_JPRB, 2.70145e+00_JPRB/)
+      SELFREFO(:, 5) = (/ &
+     & 6.49581e+00_JPRB, 5.91114e+00_JPRB, 5.37910e+00_JPRB, 4.89494e+00_JPRB, 4.45436e+00_JPRB, &
+     & 4.05344e+00_JPRB, 3.68860e+00_JPRB, 3.35660e+00_JPRB, 3.05448e+00_JPRB, 2.77956e+00_JPRB/)
+      SELFREFO(:, 6) = (/ &
+     & 6.50189e+00_JPRB, 5.89381e+00_JPRB, 5.34260e+00_JPRB, 4.84294e+00_JPRB, 4.39001e+00_JPRB, &
+     & 3.97944e+00_JPRB, 3.60727e+00_JPRB, 3.26990e+00_JPRB, 2.96409e+00_JPRB, 2.68687e+00_JPRB/)
+      SELFREFO(:, 7) = (/ &
+     & 6.64768e+00_JPRB, 6.01719e+00_JPRB, 5.44650e+00_JPRB, 4.92993e+00_JPRB, 4.46236e+00_JPRB, &
+     & 4.03914e+00_JPRB, 3.65605e+00_JPRB, 3.30930e+00_JPRB, 2.99543e+00_JPRB, 2.71134e+00_JPRB/)
+      SELFREFO(:, 8) = (/ &
+     & 6.43744e+00_JPRB, 5.87166e+00_JPRB, 5.35560e+00_JPRB, 4.88490e+00_JPRB, 4.45557e+00_JPRB, &
+     & 4.06397e+00_JPRB, 3.70679e+00_JPRB, 3.38100e+00_JPRB, 3.08384e+00_JPRB, 2.81281e+00_JPRB/)
+      SELFREFO(:, 9) = (/ &
+     & 6.55466e+00_JPRB, 5.99777e+00_JPRB, 5.48820e+00_JPRB, 5.02192e+00_JPRB, 4.59525e+00_JPRB, &
+     & 4.20484e+00_JPRB, 3.84759e+00_JPRB, 3.52070e+00_JPRB, 3.22158e+00_JPRB, 2.94787e+00_JPRB/)
+      SELFREFO(:,10) = (/ &
+     & 6.84510e+00_JPRB, 6.26933e+00_JPRB, 5.74200e+00_JPRB, 5.25902e+00_JPRB, 4.81667e+00_JPRB, &
+     & 4.41152e+00_JPRB, 4.04046e+00_JPRB, 3.70060e+00_JPRB, 3.38933e+00_JPRB, 3.10424e+00_JPRB/)
+      SELFREFO(:,11) = (/ &
+     & 6.83128e+00_JPRB, 6.25536e+00_JPRB, 5.72800e+00_JPRB, 5.24510e+00_JPRB, 4.80291e+00_JPRB, &
+     & 4.39799e+00_JPRB, 4.02722e+00_JPRB, 3.68770e+00_JPRB, 3.37681e+00_JPRB, 3.09212e+00_JPRB/)
+      SELFREFO(:,12) = (/ &
+     & 7.35969e+00_JPRB, 6.61719e+00_JPRB, 5.94960e+00_JPRB, 5.34936e+00_JPRB, 4.80968e+00_JPRB, &
+     & 4.32445e+00_JPRB, 3.88817e+00_JPRB, 3.49590e+00_JPRB, 3.14321e+00_JPRB, 2.82610e+00_JPRB/)
+      SELFREFO(:,13) = (/ &
+     & 7.50064e+00_JPRB, 6.80749e+00_JPRB, 6.17840e+00_JPRB, 5.60744e+00_JPRB, 5.08925e+00_JPRB, &
+     & 4.61894e+00_JPRB, 4.19210e+00_JPRB, 3.80470e+00_JPRB, 3.45310e+00_JPRB, 3.13399e+00_JPRB/)
+      SELFREFO(:,14) = (/ &
+     & 7.40801e+00_JPRB, 6.71328e+00_JPRB, 6.08370e+00_JPRB, 5.51316e+00_JPRB, 4.99613e+00_JPRB, &
+     & 4.52759e+00_JPRB, 4.10298e+00_JPRB, 3.71820e+00_JPRB, 3.36950e+00_JPRB, 3.05351e+00_JPRB/)
+      SELFREFO(:,15) = (/ &
+     & 7.51895e+00_JPRB, 6.68846e+00_JPRB, 5.94970e+00_JPRB, 5.29254e+00_JPRB, 4.70796e+00_JPRB, &
+     & 4.18795e+00_JPRB, 3.72538e+00_JPRB, 3.31390e+00_JPRB, 2.94787e+00_JPRB, 2.62227e+00_JPRB/)
+      SELFREFO(:,16) = (/ &
+     & 7.84774e+00_JPRB, 6.80673e+00_JPRB, 5.90380e+00_JPRB, 5.12065e+00_JPRB, 4.44138e+00_JPRB, &
+     & 3.85223e+00_JPRB, 3.34122e+00_JPRB, 2.89800e+00_JPRB, 2.51357e+00_JPRB, 2.18014e+00_JPRB/)
+
+
+
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB1',1,ZHOOK_HANDLE)
+RETURN
+
+1000 CONTINUE
+CALL ABOR1("RRTM_KGB1:ERROR OPENING FILE RADRRTM")
+1001 CONTINUE
+CALL ABOR1("RRTM_KGB1:ERROR READING FILE RADRRTM")
+
+!     -----------------------------------------------------------------
+END SUBROUTINE RRTM_KGB1
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb1.F90.or
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb1.F90.or	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb1.F90.or	(revision 3908)
@@ -0,0 +1,355 @@
+SUBROUTINE RRTM_KGB1(DIRECTORY)
+
+!     Originally by Eli J. Mlawer, Atmospheric & Environmental Research.
+!     BAND 1:  10-250 cm-1 (low - H2O; high - H2O)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+!     G.Mozdzynski March 2011 read constants from files
+!     ABozzo May 2013 update to RRTMG v4.85
+!     band 1:  10-350 cm-1
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+USE YOMLUN    ,ONLY : NULRAD
+USE MPL_MODULE,ONLY : MPL_BROADCAST
+USE YOMTAG    ,ONLY : MTAGRAD
+USE YOMMP0    , ONLY : NPROC, MYPROC
+
+USE YOERRTO1 , ONLY : KAO     ,KBO     ,KAO_D,KBO_D,SELFREFO   ,FRACREFAO ,&
+ & FRACREFBO  ,FORREFO, KAO_MN2, KBO_MN2
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+
+CHARACTER(LEN=*), INTENT(IN) :: DIRECTORY
+
+!CHARACTER(LEN = 80) :: CLZZZ
+CHARACTER(LEN = 255) :: CLF1
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB1',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+  !CALL GETENV("DATA",CLZZZ)
+  !IF(CLZZZ /= " ") THEN
+  !  CLF1=TRIM(CLZZZ) // "/RADRRTM"
+  CLF1 = DIRECTORY // "/RADRRTM"
+  WRITE(0,'(A,A)') 'Reading ',TRIM(CLF1)
+  OPEN(NULRAD,FILE=TRIM(CLF1),FORM="UNFORMATTED",ACTION="READ",ERR=1000)
+  !ELSE
+  !  OPEN(NULRAD,FILE='RADRRTM',FORM="UNFORMATTED",ACTION="READ",ERR=1000)
+  !ENDIF
+  READ(NULRAD,ERR=1001) KAO_D,KBO_D
+ ! Convert the data into model actual precision.
+  KAO = REAL(KAO_D,JPRB)
+  KBO = REAL(KBO_D,JPRB)
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KAO,MTAGRAD,1,CDSTRING='RRTM_KGB1:')
+  CALL MPL_BROADCAST (KBO,MTAGRAD,1,CDSTRING='RRTM_KGB1:')
+ENDIF
+
+! Planck fraction mapping level: P = 212.7250 mbar, T = 223.06 K
+FRACREFAO(:) = (/ &
+ & 2.1227E-01_JPRB,1.8897E-01_JPRB,1.3934E-01_JPRB,1.1557E-01_JPRB,9.5282E-02_JPRB,8.3359E-02_JPRB, &
+ & 6.5333E-02_JPRB,5.2016E-02_JPRB,3.4272E-02_JPRB,4.0257E-03_JPRB,3.1857E-03_JPRB,2.6014E-03_JPRB, &
+ & 1.9141E-03_JPRB,1.2612E-03_JPRB,5.3169E-04_JPRB,7.6476E-05_JPRB/)
+
+! Planck fraction mapping level: P = 212.7250 mbar, T = 223.06 K
+! These Planck fractions were calculated using lower atmosphere
+! parameters.
+FRACREFBO(:) = (/ &
+ & 2.1227E-01_JPRB,1.8897E-01_JPRB,1.3934E-01_JPRB,1.1557E-01_JPRB,9.5282E-02_JPRB,8.3359E-02_JPRB, &
+ & 6.5333E-02_JPRB,5.2016E-02_JPRB,3.4272E-02_JPRB,4.0257E-03_JPRB,3.1857E-03_JPRB,2.6014E-03_JPRB, &
+ & 1.9141E-03_JPRB,1.2612E-03_JPRB,5.3169E-04_JPRB,7.6476E-05_JPRB/)
+
+!     The array FORREFO contains the coefficient of the water vapor
+!     foreign-continuum (including the energy term).  The first 
+!     index refers to reference temperature (296,260,224,260) and 
+!     pressure (970,475,219,3 mbar) levels.  The second index 
+!     runs over the g-channel (1 to 16).
+
+      FORREFO(1,:) = (/ &
+     & 3.6742e-02_JPRB,1.0664e-01_JPRB,2.6132e-01_JPRB,2.7906e-01_JPRB,2.8151e-01_JPRB,2.7465e-01_JPRB, &
+     & 2.8530e-01_JPRB,2.9123e-01_JPRB,3.0697e-01_JPRB,3.1801e-01_JPRB,3.2444e-01_JPRB,2.7746e-01_JPRB, &
+     & 3.1994e-01_JPRB,2.9750e-01_JPRB,2.1226e-01_JPRB,1.2847e-01_JPRB/)
+      FORREFO(2,:) = (/ &
+     & 4.0450e-02_JPRB,1.1085e-01_JPRB,2.9205e-01_JPRB,3.1934e-01_JPRB,3.1739e-01_JPRB,3.1450e-01_JPRB, &
+     & 3.2797e-01_JPRB,3.2223e-01_JPRB,3.3099e-01_JPRB,3.4800e-01_JPRB,3.4046e-01_JPRB,3.5700e-01_JPRB, &
+     & 3.8264e-01_JPRB,3.6679e-01_JPRB,3.3481e-01_JPRB,3.2113e-01_JPRB/)
+      FORREFO(3,:) = (/ &
+     & 4.6952e-02_JPRB,1.1999e-01_JPRB,3.1473e-01_JPRB,3.7015e-01_JPRB,3.6913e-01_JPRB,3.6352e-01_JPRB, &
+     & 3.7754e-01_JPRB,3.7402e-01_JPRB,3.7113e-01_JPRB,3.7720e-01_JPRB,3.8365e-01_JPRB,4.0876e-01_JPRB, &
+     & 4.2968e-01_JPRB,4.4186e-01_JPRB,4.3468e-01_JPRB,4.7083e-01_JPRB/)
+      FORREFO(4,:) = (/ &
+     & 7.0645e-02_JPRB,1.6618e-01_JPRB,2.8516e-01_JPRB,3.1819e-01_JPRB,3.0131e-01_JPRB,2.9552e-01_JPRB, &
+     & 2.8972e-01_JPRB,2.9348e-01_JPRB,2.8668e-01_JPRB,2.8483e-01_JPRB,2.8130e-01_JPRB,2.7757e-01_JPRB, &
+     & 2.9735e-01_JPRB,3.1684e-01_JPRB,3.0681e-01_JPRB,3.6778e-01_JPRB/)
+
+
+!     ------------------------------------------------------------------
+
+!     The array KAO contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels > ~100mb and temperatures.  The first
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the corresponding TREF for this  pressure level, 
+!     JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, 
+!     JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  The second 
+!     index, JP, runs from 1 to 13 and refers to the corresponding 
+!     pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).  
+!     The third index, IG, goes from 1 to 16, and tells us which 
+!     g-interval the absorption coefficients are for.
+
+
+
+!     The array KBO contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels < ~100mb and temperatures. The first 
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the reference temperature TREF for this pressure 
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
+!     The second index, JP, runs from 13 to 59 and refers to the JPth
+!     reference pressure level (see taumol.f for the value of these
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
+!     and tells us which g-interval the absorption coefficients are for.
+
+
+
+     KAO_MN2(:, 1) = (/ &
+     & 5.12042E-08_JPRB, 5.51239E-08_JPRB, 5.93436E-08_JPRB, 6.38863E-08_JPRB, 6.87767E-08_JPRB, &
+     & 7.40415E-08_JPRB, 7.97093E-08_JPRB, 8.58110E-08_JPRB, 9.23797E-08_JPRB, 9.94513E-08_JPRB, &
+     & 1.07064E-07_JPRB, 1.15260E-07_JPRB, 1.24083E-07_JPRB, 1.33581E-07_JPRB, 1.43807E-07_JPRB, &
+     & 1.54815E-07_JPRB, 1.66666E-07_JPRB, 1.79424E-07_JPRB, 1.93159E-07_JPRB/)
+      KAO_MN2(:, 2) = (/ &
+     & 2.30938E-07_JPRB, 2.41696E-07_JPRB, 2.52955E-07_JPRB, 2.64738E-07_JPRB, 2.77071E-07_JPRB, &
+     & 2.89978E-07_JPRB, 3.03486E-07_JPRB, 3.17623E-07_JPRB, 3.32419E-07_JPRB, 3.47904E-07_JPRB, &
+     & 3.64111E-07_JPRB, 3.81072E-07_JPRB, 3.98824E-07_JPRB, 4.17402E-07_JPRB, 4.36846E-07_JPRB, &
+     & 4.57196E-07_JPRB, 4.78494E-07_JPRB, 5.00784E-07_JPRB, 5.24112E-07_JPRB/)
+      KAO_MN2(:, 3) = (/ &
+     & 6.70458E-07_JPRB, 7.04274E-07_JPRB, 7.39795E-07_JPRB, 7.77109E-07_JPRB, 8.16304E-07_JPRB, &
+     & 8.57476E-07_JPRB, 9.00724E-07_JPRB, 9.46154E-07_JPRB, 9.93876E-07_JPRB, 1.04400E-06_JPRB, &
+     & 1.09666E-06_JPRB, 1.15197E-06_JPRB, 1.21008E-06_JPRB, 1.27111E-06_JPRB, 1.33522E-06_JPRB, &
+     & 1.40256E-06_JPRB, 1.47331E-06_JPRB, 1.54761E-06_JPRB, 1.62567E-06_JPRB/)
+      KAO_MN2(:, 4) = (/ &
+     & 1.84182E-06_JPRB, 1.89203E-06_JPRB, 1.94360E-06_JPRB, 1.99658E-06_JPRB, 2.05101E-06_JPRB, &
+     & 2.10692E-06_JPRB, 2.16435E-06_JPRB, 2.22335E-06_JPRB, 2.28396E-06_JPRB, 2.34622E-06_JPRB, &
+     & 2.41017E-06_JPRB, 2.47587E-06_JPRB, 2.54337E-06_JPRB, 2.61270E-06_JPRB, 2.68392E-06_JPRB, &
+     & 2.75708E-06_JPRB, 2.83224E-06_JPRB, 2.90944E-06_JPRB, 2.98875E-06_JPRB/)
+      KAO_MN2(:, 5) = (/ &
+     & 3.41996E-06_JPRB, 3.32758E-06_JPRB, 3.23770E-06_JPRB, 3.15024E-06_JPRB, 3.06515E-06_JPRB, &
+     & 2.98235E-06_JPRB, 2.90180E-06_JPRB, 2.82341E-06_JPRB, 2.74715E-06_JPRB, 2.67294E-06_JPRB, &
+     & 2.60074E-06_JPRB, 2.53049E-06_JPRB, 2.46214E-06_JPRB, 2.39563E-06_JPRB, 2.33092E-06_JPRB, &
+     & 2.26796E-06_JPRB, 2.20670E-06_JPRB, 2.14709E-06_JPRB, 2.08910E-06_JPRB/)
+      KAO_MN2(:, 6) = (/ &
+     & 3.38746E-06_JPRB, 3.25966E-06_JPRB, 3.13669E-06_JPRB, 3.01836E-06_JPRB, 2.90449E-06_JPRB, &
+     & 2.79491E-06_JPRB, 2.68947E-06_JPRB, 2.58801E-06_JPRB, 2.49037E-06_JPRB, 2.39642E-06_JPRB, &
+     & 2.30601E-06_JPRB, 2.21902E-06_JPRB, 2.13530E-06_JPRB, 2.05475E-06_JPRB, 1.97723E-06_JPRB, &
+     & 1.90264E-06_JPRB, 1.83086E-06_JPRB, 1.76179E-06_JPRB, 1.69532E-06_JPRB/)
+      KAO_MN2(:, 7) = (/ &
+     & 3.17530E-06_JPRB, 3.07196E-06_JPRB, 2.97199E-06_JPRB, 2.87527E-06_JPRB, 2.78170E-06_JPRB, &
+     & 2.69118E-06_JPRB, 2.60360E-06_JPRB, 2.51887E-06_JPRB, 2.43690E-06_JPRB, 2.35759E-06_JPRB, &
+     & 2.28087E-06_JPRB, 2.20664E-06_JPRB, 2.13483E-06_JPRB, 2.06536E-06_JPRB, 1.99814E-06_JPRB, &
+     & 1.93312E-06_JPRB, 1.87021E-06_JPRB, 1.80934E-06_JPRB, 1.75046E-06_JPRB/)
+      KAO_MN2(:, 8) = (/ &
+     & 2.84701E-06_JPRB, 2.77007E-06_JPRB, 2.69521E-06_JPRB, 2.62237E-06_JPRB, 2.55150E-06_JPRB, &
+     & 2.48254E-06_JPRB, 2.41545E-06_JPRB, 2.35017E-06_JPRB, 2.28666E-06_JPRB, 2.22486E-06_JPRB, &
+     & 2.16473E-06_JPRB, 2.10623E-06_JPRB, 2.04930E-06_JPRB, 1.99392E-06_JPRB, 1.94003E-06_JPRB, &
+     & 1.88760E-06_JPRB, 1.83659E-06_JPRB, 1.78695E-06_JPRB, 1.73866E-06_JPRB/)
+      KAO_MN2(:, 9) = (/ &
+     & 2.79917E-06_JPRB, 2.73207E-06_JPRB, 2.66658E-06_JPRB, 2.60266E-06_JPRB, 2.54027E-06_JPRB, &
+     & 2.47937E-06_JPRB, 2.41994E-06_JPRB, 2.36192E-06_JPRB, 2.30530E-06_JPRB, 2.25004E-06_JPRB, &
+     & 2.19610E-06_JPRB, 2.14346E-06_JPRB, 2.09208E-06_JPRB, 2.04193E-06_JPRB, 1.99298E-06_JPRB, &
+     & 1.94520E-06_JPRB, 1.89857E-06_JPRB, 1.85306E-06_JPRB, 1.80864E-06_JPRB/)
+      KAO_MN2(:,10) = (/ &
+     & 2.74910E-06_JPRB, 2.64462E-06_JPRB, 2.54412E-06_JPRB, 2.44743E-06_JPRB, 2.35442E-06_JPRB, &
+     & 2.26495E-06_JPRB, 2.17887E-06_JPRB, 2.09606E-06_JPRB, 2.01641E-06_JPRB, 1.93978E-06_JPRB, &
+     & 1.86606E-06_JPRB, 1.79514E-06_JPRB, 1.72692E-06_JPRB, 1.66129E-06_JPRB, 1.59815E-06_JPRB, &
+     & 1.53742E-06_JPRB, 1.47899E-06_JPRB, 1.42278E-06_JPRB, 1.36871E-06_JPRB/)
+      KAO_MN2(:,11) = (/ &
+     & 2.63952E-06_JPRB, 2.60263E-06_JPRB, 2.56626E-06_JPRB, 2.53039E-06_JPRB, 2.49503E-06_JPRB, &
+     & 2.46016E-06_JPRB, 2.42578E-06_JPRB, 2.39188E-06_JPRB, 2.35845E-06_JPRB, 2.32549E-06_JPRB, &
+     & 2.29299E-06_JPRB, 2.26094E-06_JPRB, 2.22934E-06_JPRB, 2.19819E-06_JPRB, 2.16747E-06_JPRB, &
+     & 2.13717E-06_JPRB, 2.10731E-06_JPRB, 2.07786E-06_JPRB, 2.04882E-06_JPRB/)
+      KAO_MN2(:,12) = (/ &
+     & 2.94106E-06_JPRB, 2.82819E-06_JPRB, 2.71966E-06_JPRB, 2.61528E-06_JPRB, 2.51492E-06_JPRB, &
+     & 2.41841E-06_JPRB, 2.32560E-06_JPRB, 2.23635E-06_JPRB, 2.15053E-06_JPRB, 2.06800E-06_JPRB, &
+     & 1.98863E-06_JPRB, 1.91232E-06_JPRB, 1.83893E-06_JPRB, 1.76836E-06_JPRB, 1.70049E-06_JPRB, &
+     & 1.63524E-06_JPRB, 1.57248E-06_JPRB, 1.51214E-06_JPRB, 1.45411E-06_JPRB/)
+      KAO_MN2(:,13) = (/ &
+     & 2.94607E-06_JPRB, 2.87369E-06_JPRB, 2.80309E-06_JPRB, 2.73422E-06_JPRB, 2.66705E-06_JPRB, &
+     & 2.60152E-06_JPRB, 2.53760E-06_JPRB, 2.47526E-06_JPRB, 2.41445E-06_JPRB, 2.35513E-06_JPRB, &
+     & 2.29726E-06_JPRB, 2.24082E-06_JPRB, 2.18577E-06_JPRB, 2.13207E-06_JPRB, 2.07969E-06_JPRB, &
+     & 2.02859E-06_JPRB, 1.97875E-06_JPRB, 1.93014E-06_JPRB, 1.88272E-06_JPRB/)
+      KAO_MN2(:,14) = (/ &
+     & 2.58051E-06_JPRB, 2.48749E-06_JPRB, 2.39782E-06_JPRB, 2.31139E-06_JPRB, 2.22807E-06_JPRB, &
+     & 2.14775E-06_JPRB, 2.07033E-06_JPRB, 1.99570E-06_JPRB, 1.92376E-06_JPRB, 1.85441E-06_JPRB, &
+     & 1.78756E-06_JPRB, 1.72313E-06_JPRB, 1.66101E-06_JPRB, 1.60114E-06_JPRB, 1.54342E-06_JPRB, &
+     & 1.48778E-06_JPRB, 1.43415E-06_JPRB, 1.38245E-06_JPRB, 1.33262E-06_JPRB/)
+      KAO_MN2(:,15) = (/ &
+     & 3.03447E-06_JPRB, 2.88559E-06_JPRB, 2.74401E-06_JPRB, 2.60938E-06_JPRB, 2.48135E-06_JPRB, &
+     & 2.35961E-06_JPRB, 2.24384E-06_JPRB, 2.13375E-06_JPRB, 2.02906E-06_JPRB, 1.92951E-06_JPRB, &
+     & 1.83484E-06_JPRB, 1.74481E-06_JPRB, 1.65921E-06_JPRB, 1.57780E-06_JPRB, 1.50039E-06_JPRB, &
+     & 1.42677E-06_JPRB, 1.35677E-06_JPRB, 1.29020E-06_JPRB, 1.22690E-06_JPRB/)
+      KAO_MN2(:,16) = (/ &
+     & 1.48655E-06_JPRB, 1.48283E-06_JPRB, 1.47913E-06_JPRB, 1.47543E-06_JPRB, 1.47174E-06_JPRB, &
+     & 1.46806E-06_JPRB, 1.46439E-06_JPRB, 1.46072E-06_JPRB, 1.45707E-06_JPRB, 1.45343E-06_JPRB, &
+     & 1.44979E-06_JPRB, 1.44617E-06_JPRB, 1.44255E-06_JPRB, 1.43894E-06_JPRB, 1.43534E-06_JPRB, &
+     & 1.43176E-06_JPRB, 1.42817E-06_JPRB, 1.42460E-06_JPRB, 1.42104E-06_JPRB/)
+      KBO_MN2(:, 1) = (/ &
+     & 5.12042E-08_JPRB, 5.51239E-08_JPRB, 5.93436E-08_JPRB, 6.38863E-08_JPRB, 6.87767E-08_JPRB, &
+     & 7.40415E-08_JPRB, 7.97093E-08_JPRB, 8.58110E-08_JPRB, 9.23797E-08_JPRB, 9.94513E-08_JPRB, &
+     & 1.07064E-07_JPRB, 1.15260E-07_JPRB, 1.24083E-07_JPRB, 1.33581E-07_JPRB, 1.43807E-07_JPRB, &
+     & 1.54815E-07_JPRB, 1.66666E-07_JPRB, 1.79424E-07_JPRB, 1.93159E-07_JPRB/)
+      KBO_MN2(:, 2) = (/ &
+     & 2.30938E-07_JPRB, 2.41696E-07_JPRB, 2.52955E-07_JPRB, 2.64738E-07_JPRB, 2.77071E-07_JPRB, &
+     & 2.89978E-07_JPRB, 3.03486E-07_JPRB, 3.17623E-07_JPRB, 3.32419E-07_JPRB, 3.47904E-07_JPRB, &
+     & 3.64111E-07_JPRB, 3.81072E-07_JPRB, 3.98824E-07_JPRB, 4.17402E-07_JPRB, 4.36846E-07_JPRB, &
+     & 4.57196E-07_JPRB, 4.78494E-07_JPRB, 5.00784E-07_JPRB, 5.24112E-07_JPRB/)
+      KBO_MN2(:, 3) = (/ &
+     & 6.70458E-07_JPRB, 7.04274E-07_JPRB, 7.39795E-07_JPRB, 7.77109E-07_JPRB, 8.16304E-07_JPRB, &
+     & 8.57476E-07_JPRB, 9.00724E-07_JPRB, 9.46154E-07_JPRB, 9.93876E-07_JPRB, 1.04400E-06_JPRB, &
+     & 1.09666E-06_JPRB, 1.15197E-06_JPRB, 1.21008E-06_JPRB, 1.27111E-06_JPRB, 1.33522E-06_JPRB, &
+     & 1.40256E-06_JPRB, 1.47331E-06_JPRB, 1.54761E-06_JPRB, 1.62567E-06_JPRB/)
+      KBO_MN2(:, 4) = (/ &
+     & 1.84182E-06_JPRB, 1.89203E-06_JPRB, 1.94360E-06_JPRB, 1.99658E-06_JPRB, 2.05101E-06_JPRB, &
+     & 2.10692E-06_JPRB, 2.16435E-06_JPRB, 2.22335E-06_JPRB, 2.28396E-06_JPRB, 2.34622E-06_JPRB, &
+     & 2.41017E-06_JPRB, 2.47587E-06_JPRB, 2.54337E-06_JPRB, 2.61270E-06_JPRB, 2.68392E-06_JPRB, &
+     & 2.75708E-06_JPRB, 2.83224E-06_JPRB, 2.90944E-06_JPRB, 2.98875E-06_JPRB/)
+      KBO_MN2(:, 5) = (/ &
+     & 3.41996E-06_JPRB, 3.32758E-06_JPRB, 3.23770E-06_JPRB, 3.15024E-06_JPRB, 3.06515E-06_JPRB, &
+     & 2.98235E-06_JPRB, 2.90180E-06_JPRB, 2.82341E-06_JPRB, 2.74715E-06_JPRB, 2.67294E-06_JPRB, &
+     & 2.60074E-06_JPRB, 2.53049E-06_JPRB, 2.46214E-06_JPRB, 2.39563E-06_JPRB, 2.33092E-06_JPRB, &
+     & 2.26796E-06_JPRB, 2.20670E-06_JPRB, 2.14709E-06_JPRB, 2.08910E-06_JPRB/)
+      KBO_MN2(:, 6) = (/ &
+     & 3.38746E-06_JPRB, 3.25966E-06_JPRB, 3.13669E-06_JPRB, 3.01836E-06_JPRB, 2.90449E-06_JPRB, &
+     & 2.79491E-06_JPRB, 2.68947E-06_JPRB, 2.58801E-06_JPRB, 2.49037E-06_JPRB, 2.39642E-06_JPRB, &
+     & 2.30601E-06_JPRB, 2.21902E-06_JPRB, 2.13530E-06_JPRB, 2.05475E-06_JPRB, 1.97723E-06_JPRB, &
+     & 1.90264E-06_JPRB, 1.83086E-06_JPRB, 1.76179E-06_JPRB, 1.69532E-06_JPRB/)
+      KBO_MN2(:, 7) = (/ &
+     & 3.17530E-06_JPRB, 3.07196E-06_JPRB, 2.97199E-06_JPRB, 2.87527E-06_JPRB, 2.78170E-06_JPRB, &
+     & 2.69118E-06_JPRB, 2.60360E-06_JPRB, 2.51887E-06_JPRB, 2.43690E-06_JPRB, 2.35759E-06_JPRB, &
+     & 2.28087E-06_JPRB, 2.20664E-06_JPRB, 2.13483E-06_JPRB, 2.06536E-06_JPRB, 1.99814E-06_JPRB, &
+     & 1.93312E-06_JPRB, 1.87021E-06_JPRB, 1.80934E-06_JPRB, 1.75046E-06_JPRB/)
+      KBO_MN2(:, 8) = (/ &
+     & 2.84701E-06_JPRB, 2.77007E-06_JPRB, 2.69521E-06_JPRB, 2.62237E-06_JPRB, 2.55150E-06_JPRB, &
+     & 2.48254E-06_JPRB, 2.41545E-06_JPRB, 2.35017E-06_JPRB, 2.28666E-06_JPRB, 2.22486E-06_JPRB, &
+     & 2.16473E-06_JPRB, 2.10623E-06_JPRB, 2.04930E-06_JPRB, 1.99392E-06_JPRB, 1.94003E-06_JPRB, &
+     & 1.88760E-06_JPRB, 1.83659E-06_JPRB, 1.78695E-06_JPRB, 1.73866E-06_JPRB/)
+      KBO_MN2(:, 9) = (/ &
+     & 2.79917E-06_JPRB, 2.73207E-06_JPRB, 2.66658E-06_JPRB, 2.60266E-06_JPRB, 2.54027E-06_JPRB, &
+     & 2.47937E-06_JPRB, 2.41994E-06_JPRB, 2.36192E-06_JPRB, 2.30530E-06_JPRB, 2.25004E-06_JPRB, &
+     & 2.19610E-06_JPRB, 2.14346E-06_JPRB, 2.09208E-06_JPRB, 2.04193E-06_JPRB, 1.99298E-06_JPRB, &
+     & 1.94520E-06_JPRB, 1.89857E-06_JPRB, 1.85306E-06_JPRB, 1.80864E-06_JPRB/)
+      KBO_MN2(:,10) = (/ &
+     & 2.74910E-06_JPRB, 2.64462E-06_JPRB, 2.54412E-06_JPRB, 2.44743E-06_JPRB, 2.35442E-06_JPRB, &
+     & 2.26495E-06_JPRB, 2.17887E-06_JPRB, 2.09606E-06_JPRB, 2.01641E-06_JPRB, 1.93978E-06_JPRB, &
+     & 1.86606E-06_JPRB, 1.79514E-06_JPRB, 1.72692E-06_JPRB, 1.66129E-06_JPRB, 1.59815E-06_JPRB, &
+     & 1.53742E-06_JPRB, 1.47899E-06_JPRB, 1.42278E-06_JPRB, 1.36871E-06_JPRB/)
+      KBO_MN2(:,11) = (/ &
+     & 2.63952E-06_JPRB, 2.60263E-06_JPRB, 2.56626E-06_JPRB, 2.53039E-06_JPRB, 2.49503E-06_JPRB, &
+     & 2.46016E-06_JPRB, 2.42578E-06_JPRB, 2.39188E-06_JPRB, 2.35845E-06_JPRB, 2.32549E-06_JPRB, &
+     & 2.29299E-06_JPRB, 2.26094E-06_JPRB, 2.22934E-06_JPRB, 2.19819E-06_JPRB, 2.16747E-06_JPRB, &
+     & 2.13717E-06_JPRB, 2.10731E-06_JPRB, 2.07786E-06_JPRB, 2.04882E-06_JPRB/)
+      KBO_MN2(:,12) = (/ &
+     & 2.94106E-06_JPRB, 2.82819E-06_JPRB, 2.71966E-06_JPRB, 2.61528E-06_JPRB, 2.51492E-06_JPRB, &
+     & 2.41841E-06_JPRB, 2.32560E-06_JPRB, 2.23635E-06_JPRB, 2.15053E-06_JPRB, 2.06800E-06_JPRB, &
+     & 1.98863E-06_JPRB, 1.91232E-06_JPRB, 1.83893E-06_JPRB, 1.76836E-06_JPRB, 1.70049E-06_JPRB, &
+     & 1.63524E-06_JPRB, 1.57248E-06_JPRB, 1.51214E-06_JPRB, 1.45411E-06_JPRB/)
+      KBO_MN2(:,13) = (/ &
+     & 2.94607E-06_JPRB, 2.87369E-06_JPRB, 2.80309E-06_JPRB, 2.73422E-06_JPRB, 2.66705E-06_JPRB, &
+     & 2.60152E-06_JPRB, 2.53760E-06_JPRB, 2.47526E-06_JPRB, 2.41445E-06_JPRB, 2.35513E-06_JPRB, &
+     & 2.29726E-06_JPRB, 2.24082E-06_JPRB, 2.18577E-06_JPRB, 2.13207E-06_JPRB, 2.07969E-06_JPRB, &
+     & 2.02859E-06_JPRB, 1.97875E-06_JPRB, 1.93014E-06_JPRB, 1.88272E-06_JPRB/)
+      KBO_MN2(:,14) = (/ &
+     & 2.58051E-06_JPRB, 2.48749E-06_JPRB, 2.39782E-06_JPRB, 2.31139E-06_JPRB, 2.22807E-06_JPRB, &
+     & 2.14775E-06_JPRB, 2.07033E-06_JPRB, 1.99570E-06_JPRB, 1.92376E-06_JPRB, 1.85441E-06_JPRB, &
+     & 1.78756E-06_JPRB, 1.72313E-06_JPRB, 1.66101E-06_JPRB, 1.60114E-06_JPRB, 1.54342E-06_JPRB, &
+     & 1.48778E-06_JPRB, 1.43415E-06_JPRB, 1.38245E-06_JPRB, 1.33262E-06_JPRB/)
+      KBO_MN2(:,15) = (/ &
+     & 3.03447E-06_JPRB, 2.88559E-06_JPRB, 2.74401E-06_JPRB, 2.60938E-06_JPRB, 2.48135E-06_JPRB, &
+     & 2.35961E-06_JPRB, 2.24384E-06_JPRB, 2.13375E-06_JPRB, 2.02906E-06_JPRB, 1.92951E-06_JPRB, &
+     & 1.83484E-06_JPRB, 1.74481E-06_JPRB, 1.65921E-06_JPRB, 1.57780E-06_JPRB, 1.50039E-06_JPRB, &
+     & 1.42677E-06_JPRB, 1.35677E-06_JPRB, 1.29020E-06_JPRB, 1.22690E-06_JPRB/)
+      KBO_MN2(:,16) = (/ &
+     & 1.48655E-06_JPRB, 1.48283E-06_JPRB, 1.47913E-06_JPRB, 1.47543E-06_JPRB, 1.47174E-06_JPRB, &
+     & 1.46806E-06_JPRB, 1.46439E-06_JPRB, 1.46072E-06_JPRB, 1.45707E-06_JPRB, 1.45343E-06_JPRB, &
+     & 1.44979E-06_JPRB, 1.44617E-06_JPRB, 1.44255E-06_JPRB, 1.43894E-06_JPRB, 1.43534E-06_JPRB, &
+     & 1.43176E-06_JPRB, 1.42817E-06_JPRB, 1.42460E-06_JPRB, 1.42104E-06_JPRB/)
+
+
+!     The array SELFREFO contains the coefficient of the water vapor
+!     self-continuum (including the energy term).  The first index
+!     refers to temperature in 7.2 degree increments.  For instance,
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+!     etc.  The second index runs over the g-channel (1 to 16).
+
+      SELFREFO(:, 1) = (/ &
+     & 2.16803e+00_JPRB, 1.98236e+00_JPRB, 1.81260e+00_JPRB, 1.65737e+00_JPRB, 1.51544e+00_JPRB, &
+     & 1.38567e+00_JPRB, 1.26700e+00_JPRB, 1.15850e+00_JPRB, 1.05929e+00_JPRB, 9.68576e-01_JPRB/)
+      SELFREFO(:, 2) = (/ &
+     & 3.70149e+00_JPRB, 3.43145e+00_JPRB, 3.18110e+00_JPRB, 2.94902e+00_JPRB, 2.73387e+00_JPRB, &
+     & 2.53441e+00_JPRB, 2.34951e+00_JPRB, 2.17810e+00_JPRB, 2.01919e+00_JPRB, 1.87188e+00_JPRB/)
+      SELFREFO(:, 3) = (/ &
+     & 6.17433e+00_JPRB, 5.62207e+00_JPRB, 5.11920e+00_JPRB, 4.66131e+00_JPRB, 4.24438e+00_JPRB, &
+     & 3.86474e+00_JPRB, 3.51906e+00_JPRB, 3.20430e+00_JPRB, 2.91769e+00_JPRB, 2.65672e+00_JPRB/)
+      SELFREFO(:, 4) = (/ &
+     & 6.56459e+00_JPRB, 5.94787e+00_JPRB, 5.38910e+00_JPRB, 4.88282e+00_JPRB, 4.42410e+00_JPRB, &
+     & 4.00848e+00_JPRB, 3.63190e+00_JPRB, 3.29070e+00_JPRB, 2.98155e+00_JPRB, 2.70145e+00_JPRB/)
+      SELFREFO(:, 5) = (/ &
+     & 6.49581e+00_JPRB, 5.91114e+00_JPRB, 5.37910e+00_JPRB, 4.89494e+00_JPRB, 4.45436e+00_JPRB, &
+     & 4.05344e+00_JPRB, 3.68860e+00_JPRB, 3.35660e+00_JPRB, 3.05448e+00_JPRB, 2.77956e+00_JPRB/)
+      SELFREFO(:, 6) = (/ &
+     & 6.50189e+00_JPRB, 5.89381e+00_JPRB, 5.34260e+00_JPRB, 4.84294e+00_JPRB, 4.39001e+00_JPRB, &
+     & 3.97944e+00_JPRB, 3.60727e+00_JPRB, 3.26990e+00_JPRB, 2.96409e+00_JPRB, 2.68687e+00_JPRB/)
+      SELFREFO(:, 7) = (/ &
+     & 6.64768e+00_JPRB, 6.01719e+00_JPRB, 5.44650e+00_JPRB, 4.92993e+00_JPRB, 4.46236e+00_JPRB, &
+     & 4.03914e+00_JPRB, 3.65605e+00_JPRB, 3.30930e+00_JPRB, 2.99543e+00_JPRB, 2.71134e+00_JPRB/)
+      SELFREFO(:, 8) = (/ &
+     & 6.43744e+00_JPRB, 5.87166e+00_JPRB, 5.35560e+00_JPRB, 4.88490e+00_JPRB, 4.45557e+00_JPRB, &
+     & 4.06397e+00_JPRB, 3.70679e+00_JPRB, 3.38100e+00_JPRB, 3.08384e+00_JPRB, 2.81281e+00_JPRB/)
+      SELFREFO(:, 9) = (/ &
+     & 6.55466e+00_JPRB, 5.99777e+00_JPRB, 5.48820e+00_JPRB, 5.02192e+00_JPRB, 4.59525e+00_JPRB, &
+     & 4.20484e+00_JPRB, 3.84759e+00_JPRB, 3.52070e+00_JPRB, 3.22158e+00_JPRB, 2.94787e+00_JPRB/)
+      SELFREFO(:,10) = (/ &
+     & 6.84510e+00_JPRB, 6.26933e+00_JPRB, 5.74200e+00_JPRB, 5.25902e+00_JPRB, 4.81667e+00_JPRB, &
+     & 4.41152e+00_JPRB, 4.04046e+00_JPRB, 3.70060e+00_JPRB, 3.38933e+00_JPRB, 3.10424e+00_JPRB/)
+      SELFREFO(:,11) = (/ &
+     & 6.83128e+00_JPRB, 6.25536e+00_JPRB, 5.72800e+00_JPRB, 5.24510e+00_JPRB, 4.80291e+00_JPRB, &
+     & 4.39799e+00_JPRB, 4.02722e+00_JPRB, 3.68770e+00_JPRB, 3.37681e+00_JPRB, 3.09212e+00_JPRB/)
+      SELFREFO(:,12) = (/ &
+     & 7.35969e+00_JPRB, 6.61719e+00_JPRB, 5.94960e+00_JPRB, 5.34936e+00_JPRB, 4.80968e+00_JPRB, &
+     & 4.32445e+00_JPRB, 3.88817e+00_JPRB, 3.49590e+00_JPRB, 3.14321e+00_JPRB, 2.82610e+00_JPRB/)
+      SELFREFO(:,13) = (/ &
+     & 7.50064e+00_JPRB, 6.80749e+00_JPRB, 6.17840e+00_JPRB, 5.60744e+00_JPRB, 5.08925e+00_JPRB, &
+     & 4.61894e+00_JPRB, 4.19210e+00_JPRB, 3.80470e+00_JPRB, 3.45310e+00_JPRB, 3.13399e+00_JPRB/)
+      SELFREFO(:,14) = (/ &
+     & 7.40801e+00_JPRB, 6.71328e+00_JPRB, 6.08370e+00_JPRB, 5.51316e+00_JPRB, 4.99613e+00_JPRB, &
+     & 4.52759e+00_JPRB, 4.10298e+00_JPRB, 3.71820e+00_JPRB, 3.36950e+00_JPRB, 3.05351e+00_JPRB/)
+      SELFREFO(:,15) = (/ &
+     & 7.51895e+00_JPRB, 6.68846e+00_JPRB, 5.94970e+00_JPRB, 5.29254e+00_JPRB, 4.70796e+00_JPRB, &
+     & 4.18795e+00_JPRB, 3.72538e+00_JPRB, 3.31390e+00_JPRB, 2.94787e+00_JPRB, 2.62227e+00_JPRB/)
+      SELFREFO(:,16) = (/ &
+     & 7.84774e+00_JPRB, 6.80673e+00_JPRB, 5.90380e+00_JPRB, 5.12065e+00_JPRB, 4.44138e+00_JPRB, &
+     & 3.85223e+00_JPRB, 3.34122e+00_JPRB, 2.89800e+00_JPRB, 2.51357e+00_JPRB, 2.18014e+00_JPRB/)
+
+
+
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB1',1,ZHOOK_HANDLE)
+RETURN
+
+1000 CONTINUE
+CALL ABOR1("RRTM_KGB1:ERROR OPENING FILE RADRRTM")
+1001 CONTINUE
+CALL ABOR1("RRTM_KGB1:ERROR READING FILE RADRRTM")
+
+!     -----------------------------------------------------------------
+END SUBROUTINE RRTM_KGB1
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb1.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb1.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb1.intfb.h	(revision 3908)
@@ -0,0 +1,5 @@
+INTERFACE
+SUBROUTINE RRTM_KGB1(DIRECTORY)
+CHARACTER(LEN=*), INTENT(IN) :: DIRECTORY
+END SUBROUTINE RRTM_KGB1
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb10.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb10.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb10.F90	(revision 3908)
@@ -0,0 +1,171 @@
+SUBROUTINE RRTM_KGB10
+
+!     Originally by Eli J. Mlawer, Atmospheric & Environmental Research.
+!     BAND 10:  1390-1480 cm-1 (low - H2O; high - H2O)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+!     G.Mozdzynski March 2011 read constants from files
+!     ABozzo 101306 updated to rrtmg v4.85
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+USE YOMLUN    ,ONLY : NULRAD
+USE YOMMP0    , ONLY : NPROC, MYPROC
+USE MPL_MODULE,ONLY : MPL_BROADCAST
+USE YOMTAG    ,ONLY : MTAGRAD
+
+USE YOERRTO10, ONLY : KAO     ,KBO      ,KAO_D,KBO_D,FRACREFAO   ,FRACREFBO, SELFREFO, FORREFO
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB10',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+  READ(NULRAD,ERR=1001) KAO_D,KBO_D
+ ! Convert the data into model actual precision.
+  KAO = REAL(KAO_D,JPRB)
+  KBO = REAL(KBO_D,JPRB) 
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KAO,MTAGRAD,1,CDSTRING='RRTM_KGB10:')
+  CALL MPL_BROADCAST (KBO,MTAGRAD,1,CDSTRING='RRTM_KGB10:')
+ENDIF
+
+! Planck fraction mapping level : P = 212.7250, T = 223.06 K
+      FRACREFAO(:) = (/ &
+     &  1.6909E-01_JPRB, 1.5419E-01_JPRB, 1.3999E-01_JPRB, 1.2637E-01_JPRB, &
+     &  1.1429E-01_JPRB, 9.9676E-02_JPRB, 8.0093E-02_JPRB, 6.0283E-02_JPRB, &
+     &  4.1077E-02_JPRB, 4.4857E-03_JPRB, 3.6545E-03_JPRB, 2.9243E-03_JPRB, &
+     &  2.0407E-03_JPRB, 1.2891E-03_JPRB, 4.8767E-04_JPRB, 6.7748E-05_JPRB/)
+
+! Planck fraction mapping level : P = 95.58350 mb, T = 215.70 K
+      FRACREFBO(:) = (/ &
+     &  1.7391E-01_JPRB, 1.5680E-01_JPRB, 1.4419E-01_JPRB, 1.2672E-01_JPRB, &
+     &  1.0708E-01_JPRB, 9.7034E-02_JPRB, 7.8545E-02_JPRB, 5.9784E-02_JPRB, &
+     &  4.0879E-02_JPRB, 4.4704E-03_JPRB, 3.7150E-03_JPRB, 2.9038E-03_JPRB, &
+     &  2.1454E-03_JPRB, 1.2802E-03_JPRB, 4.8328E-04_JPRB, 6.7378E-05_JPRB/)
+
+
+!     ------------------------------------------------------------------
+
+!     The array KAO contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels > ~100mb and temperatures.  The first
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the corresponding TREF for this  pressure level, 
+!     JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, 
+!     JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  The second 
+!     index, JP, runs from 1 to 13 and refers to the corresponding 
+!     pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).  
+!     The third index, IG, goes from 1 to 16, and tells us which 
+!     g-interval the absorption coefficients are for.
+
+
+
+!     The array KBO contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels < ~100mb and temperatures. The first 
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the reference temperature TREF for this pressure 
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
+!     The second index, JP, runs from 13 to 59 and refers to the JPth
+!     reference pressure level (see taumol.f for the value of these
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
+!     and tells us which g-interval the absorption coefficients are for.
+
+
+!     The array FORREFO contains the coefficient of the water vapor
+!     foreign-continuum (including the energy term).  The first 
+!     index refers to reference temperature (296,260,224,260) and 
+!     pressure (970,475,219,3 mbar) levels.  The second index 
+!     runs over the g-channel (1 to 16).
+
+      FORREFO(1,:) = (/ &
+     &1.0515E-02_JPRB,1.4860E-02_JPRB,1.7181E-02_JPRB,1.6642E-02_JPRB,1.6644E-02_JPRB,1.5649E-02_JPRB, &
+     &1.7734E-02_JPRB,1.7521E-02_JPRB,1.7868E-02_JPRB,1.8400E-02_JPRB,1.9361E-02_JPRB,2.1487E-02_JPRB, &
+     &2.0192E-02_JPRB,1.6545E-02_JPRB,2.0922E-02_JPRB,2.0922E-02_JPRB/)
+      FORREFO(2,:) = (/ &
+     &1.0423E-02_JPRB,1.4593E-02_JPRB,1.6329E-02_JPRB,1.7071E-02_JPRB,1.7252E-02_JPRB,1.6188E-02_JPRB, &
+     &1.7752E-02_JPRB,1.7913E-02_JPRB,1.7551E-02_JPRB,1.8203E-02_JPRB,1.7946E-02_JPRB,1.9828E-02_JPRB, &
+     &2.1566E-02_JPRB,1.9707E-02_JPRB,2.0944E-02_JPRB,2.0944E-02_JPRB/)
+      FORREFO(3,:) = (/ &
+     &9.2770E-03_JPRB,1.2818E-02_JPRB,1.7181E-02_JPRB,1.7858E-02_JPRB,1.7888E-02_JPRB,1.7121E-02_JPRB, &
+     &1.8116E-02_JPRB,1.8230E-02_JPRB,1.7719E-02_JPRB,1.7833E-02_JPRB,1.8438E-02_JPRB,1.7995E-02_JPRB, &
+     &2.0895E-02_JPRB,2.1525E-02_JPRB,2.0517E-02_JPRB,2.0954E-02_JPRB/)
+      FORREFO(4,:) = (/ &
+     &8.3290E-03_JPRB,1.3483E-02_JPRB,1.5432E-02_JPRB,2.0793E-02_JPRB,1.8404E-02_JPRB,1.7470E-02_JPRB, &
+     &1.7253E-02_JPRB,1.7132E-02_JPRB,1.7119E-02_JPRB,1.7376E-02_JPRB,1.7030E-02_JPRB,1.6847E-02_JPRB, &
+     &1.5562E-02_JPRB,1.6836E-02_JPRB,1.8746E-02_JPRB,2.1233E-02_JPRB/)
+
+!     The array SELFREFO contains the coefficient of the water vapor
+!     self-continuum (including the energy term).  The first index
+!     refers to temperature in 7.2 degree increments.  For instance,
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+!     etc.  The second index runs over the g-channel (1 to 16).
+
+      SELFREFO(:, 1) = (/ &
+     & 2.41120E-01_JPRB, 2.27071E-01_JPRB, 2.13840E-01_JPRB, 2.01380E-01_JPRB, 1.89646E-01_JPRB, &
+     & 1.78596E-01_JPRB, 1.68190E-01_JPRB, 1.58390E-01_JPRB, 1.49161E-01_JPRB, 1.40470E-01_JPRB/)
+      SELFREFO(:, 2) = (/ &
+     & 3.11156E-01_JPRB, 2.92249E-01_JPRB, 2.74490E-01_JPRB, 2.57810E-01_JPRB, 2.42144E-01_JPRB, &
+     & 2.27430E-01_JPRB, 2.13610E-01_JPRB, 2.00630E-01_JPRB, 1.88439E-01_JPRB, 1.76988E-01_JPRB/)
+      SELFREFO(:, 3) = (/ &
+     & 3.37148E-01_JPRB, 3.17767E-01_JPRB, 2.99500E-01_JPRB, 2.82283E-01_JPRB, 2.66056E-01_JPRB, &
+     & 2.50762E-01_JPRB, 2.36347E-01_JPRB, 2.22760E-01_JPRB, 2.09955E-01_JPRB, 1.97885E-01_JPRB/)
+      SELFREFO(:, 4) = (/ &
+     & 3.57139E-01_JPRB, 3.32763E-01_JPRB, 3.10050E-01_JPRB, 2.88888E-01_JPRB, 2.69170E-01_JPRB, &
+     & 2.50798E-01_JPRB, 2.33680E-01_JPRB, 2.17730E-01_JPRB, 2.02869E-01_JPRB, 1.89022E-01_JPRB/)
+      SELFREFO(:, 5) = (/ &
+     & 3.60626E-01_JPRB, 3.35433E-01_JPRB, 3.12000E-01_JPRB, 2.90204E-01_JPRB, 2.69931E-01_JPRB, &
+     & 2.51074E-01_JPRB, 2.33534E-01_JPRB, 2.17220E-01_JPRB, 2.02045E-01_JPRB, 1.87931E-01_JPRB/)
+      SELFREFO(:, 6) = (/ &
+     & 3.42420E-01_JPRB, 3.18795E-01_JPRB, 2.96800E-01_JPRB, 2.76323E-01_JPRB, 2.57258E-01_JPRB, &
+     & 2.39509E-01_JPRB, 2.22985E-01_JPRB, 2.07600E-01_JPRB, 1.93277E-01_JPRB, 1.79942E-01_JPRB/)
+      SELFREFO(:, 7) = (/ &
+     & 3.65491E-01_JPRB, 3.41599E-01_JPRB, 3.19270E-01_JPRB, 2.98400E-01_JPRB, 2.78895E-01_JPRB, &
+     & 2.60664E-01_JPRB, 2.43625E-01_JPRB, 2.27700E-01_JPRB, 2.12816E-01_JPRB, 1.98905E-01_JPRB/)
+      SELFREFO(:, 8) = (/ &
+     & 3.70354E-01_JPRB, 3.45005E-01_JPRB, 3.21390E-01_JPRB, 2.99392E-01_JPRB, 2.78899E-01_JPRB, &
+     & 2.59809E-01_JPRB, 2.42026E-01_JPRB, 2.25460E-01_JPRB, 2.10028E-01_JPRB, 1.95652E-01_JPRB/)
+      SELFREFO(:, 9) = (/ &
+     & 3.60483E-01_JPRB, 3.37846E-01_JPRB, 3.16630E-01_JPRB, 2.96747E-01_JPRB, 2.78112E-01_JPRB, &
+     & 2.60648E-01_JPRB, 2.44280E-01_JPRB, 2.28940E-01_JPRB, 2.14563E-01_JPRB, 2.01090E-01_JPRB/)
+      SELFREFO(:,10) = (/ &
+     & 3.71845E-01_JPRB, 3.48164E-01_JPRB, 3.25990E-01_JPRB, 3.05229E-01_JPRB, 2.85790E-01_JPRB, &
+     & 2.67588E-01_JPRB, 2.50547E-01_JPRB, 2.34590E-01_JPRB, 2.19650E-01_JPRB, 2.05661E-01_JPRB/)
+      SELFREFO(:,11) = (/ &
+     & 3.60606E-01_JPRB, 3.40789E-01_JPRB, 3.22060E-01_JPRB, 3.04361E-01_JPRB, 2.87634E-01_JPRB, &
+     & 2.71826E-01_JPRB, 2.56888E-01_JPRB, 2.42770E-01_JPRB, 2.29428E-01_JPRB, 2.16819E-01_JPRB/)
+      SELFREFO(:,12) = (/ &
+     & 3.90046E-01_JPRB, 3.68879E-01_JPRB, 3.48860E-01_JPRB, 3.29928E-01_JPRB, 3.12023E-01_JPRB, &
+     & 2.95089E-01_JPRB, 2.79075E-01_JPRB, 2.63930E-01_JPRB, 2.49607E-01_JPRB, 2.36061E-01_JPRB/)
+      SELFREFO(:,13) = (/ &
+     & 4.38542E-01_JPRB, 4.05139E-01_JPRB, 3.74280E-01_JPRB, 3.45771E-01_JPRB, 3.19434E-01_JPRB, &
+     & 2.95103E-01_JPRB, 2.72626E-01_JPRB, 2.51860E-01_JPRB, 2.32676E-01_JPRB, 2.14953E-01_JPRB/)
+      SELFREFO(:,14) = (/ &
+     & 4.19448E-01_JPRB, 3.81920E-01_JPRB, 3.47750E-01_JPRB, 3.16637E-01_JPRB, 2.88307E-01_JPRB, &
+     & 2.62513E-01_JPRB, 2.39026E-01_JPRB, 2.17640E-01_JPRB, 1.98168E-01_JPRB, 1.80438E-01_JPRB/)
+      SELFREFO(:,15) = (/ &
+     & 4.20276E-01_JPRB, 3.92281E-01_JPRB, 3.66150E-01_JPRB, 3.41760E-01_JPRB, 3.18995E-01_JPRB, &
+     & 2.97746E-01_JPRB, 2.77912E-01_JPRB, 2.59400E-01_JPRB, 2.42121E-01_JPRB, 2.25993E-01_JPRB/)
+      SELFREFO(:,16) = (/ &
+     & 4.20276E-01_JPRB, 3.92281E-01_JPRB, 3.66150E-01_JPRB, 3.41760E-01_JPRB, 3.18995E-01_JPRB, &
+     & 2.97746E-01_JPRB, 2.77912E-01_JPRB, 2.59400E-01_JPRB, 2.42121E-01_JPRB, 2.25993E-01_JPRB/)
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB10',1,ZHOOK_HANDLE)
+RETURN
+
+1001 CONTINUE
+CALL ABOR1("RRTM_KGB10:ERROR READING FILE RADRRTM")
+
+END SUBROUTINE RRTM_KGB10
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb10.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb10.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb10.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_KGB10
+END SUBROUTINE RRTM_KGB10
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb11.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb11.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb11.F90	(revision 3908)
@@ -0,0 +1,345 @@
+SUBROUTINE RRTM_KGB11
+
+!     Originally by Eli J. Mlawer, Atmospheric & Environmental Research.
+!     BAND 11:  1480-1800 cm-1 (low - H2O; high - H2O)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+!     G.Mozdzynski March 2011 read constants from files
+!     abozzo 201306 updated to rrtmg v4.85
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+USE YOMLUN    ,ONLY : NULRAD
+USE YOMMP0    , ONLY : NPROC, MYPROC
+USE MPL_MODULE,ONLY : MPL_BROADCAST
+USE YOMTAG    ,ONLY : MTAGRAD
+
+USE YOERRTO11, ONLY : KAO     ,KBO     ,KAO_D,KBO_D,SELFREFO, FORREFO, FRACREFAO ,FRACREFBO, &
+                    & KAO_MO2,KBO_MO2
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB11',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+  READ(NULRAD,ERR=1001) KAO_D,KBO_D
+ ! Convert the data into model actual precision.
+  KAO = REAL(KAO_D,JPRB)
+  KBO = REAL(KBO_D,JPRB) 
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KAO,MTAGRAD,1,CDSTRING='RRTM_KGB11:')
+  CALL MPL_BROADCAST (KBO,MTAGRAD,1,CDSTRING='RRTM_KGB11:')
+ENDIF
+
+! Planck fraction mapping level : P=1053.63 mb, T= 294.2 K
+      FRACREFAO(:) = (/ &
+     &  1.4601E-01_JPRB,1.3824E-01_JPRB,1.4240E-01_JPRB,1.3463E-01_JPRB,1.1948E-01_JPRB,1.0440E-01_JPRB, &
+     &  8.8667E-02_JPRB,6.5792E-02_JPRB,4.3893E-02_JPRB,4.7941E-03_JPRB,4.0760E-03_JPRB,3.3207E-03_JPRB, &
+     &  2.4087E-03_JPRB,1.3912E-03_JPRB,4.3482E-04_JPRB,6.0932E-05_JPRB/)
+
+! Planck fraction mapping level : P=0.353 mb, T = 262.11 K
+      FRACREFBO(:) = (/ &
+     &  7.2928E-02_JPRB,1.4900E-01_JPRB,1.6156E-01_JPRB,1.5603E-01_JPRB,1.3934E-01_JPRB,1.1394E-01_JPRB, &
+     &  8.8783E-02_JPRB,6.2411E-02_JPRB,4.0191E-02_JPRB,4.4587E-03_JPRB,3.9533E-03_JPRB,3.0847E-03_JPRB, &
+     &  2.2317E-03_JPRB,1.4410E-03_JPRB,5.6722E-04_JPRB,7.7933E-05_JPRB/)
+
+!     ------------------------------------------------------------------
+
+!     The array KA contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels > ~100mb and temperatures.  The first
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the corresponding TREF for this  pressure level, 
+!     JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, 
+!     JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  The second 
+!     index, JP, runs from 1 to 13 and refers to the corresponding 
+!     pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).  
+!     The third index, IG, goes from 1 to 16, and tells us which 
+!     g-interval the absorption coefficients are for.
+
+
+
+!     The array KB contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels < ~100mb and temperatures. The first 
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the reference temperature TREF for this pressure 
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
+!     The second index, JP, runs from 13 to 59 and refers to the JPth
+!     reference pressure level (see taumol.f for the value of these
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
+!     and tells us which g-interval the absorption coefficients are for.
+
+
+!     The array KAO_Mxx contains the absorption coefficient for 
+!     a minor species at the 16 chosen g-values for a reference pressure
+!     level below 100~ mb.   The first index refers to temperature 
+!     in 7.2 degree increments.  For instance, JT = 1 refers to a 
+!     temperature of 188.0, JT = 2 refers to 195.2, etc. The second index 
+!     runs over the g-channel (1 to 16).
+
+      KAO_MO2(:, 1) = (/ &
+     & 2.31723E-06_JPRB, 2.28697E-06_JPRB, 2.25710E-06_JPRB, 2.22762E-06_JPRB, 2.19852E-06_JPRB, &
+     & 2.16981E-06_JPRB, 2.14147E-06_JPRB, 2.11350E-06_JPRB, 2.08590E-06_JPRB, 2.05865E-06_JPRB, &
+     & 2.03176E-06_JPRB, 2.00523E-06_JPRB, 1.97904E-06_JPRB, 1.95319E-06_JPRB, 1.92768E-06_JPRB, &
+     & 1.90250E-06_JPRB, 1.87765E-06_JPRB, 1.85313E-06_JPRB, 1.82893E-06_JPRB/)
+      KAO_MO2(:, 2) = (/ &
+     & 1.81980E-06_JPRB, 1.81352E-06_JPRB, 1.80726E-06_JPRB, 1.80101E-06_JPRB, 1.79479E-06_JPRB, &
+     & 1.78860E-06_JPRB, 1.78242E-06_JPRB, 1.77626E-06_JPRB, 1.77013E-06_JPRB, 1.76402E-06_JPRB, &
+     & 1.75792E-06_JPRB, 1.75185E-06_JPRB, 1.74580E-06_JPRB, 1.73977E-06_JPRB, 1.73377E-06_JPRB, &
+     & 1.72778E-06_JPRB, 1.72181E-06_JPRB, 1.71587E-06_JPRB, 1.70994E-06_JPRB/)
+      KAO_MO2(:, 3) = (/ &
+     & 2.26922E-06_JPRB, 2.25413E-06_JPRB, 2.23914E-06_JPRB, 2.22425E-06_JPRB, 2.20945E-06_JPRB, &
+     & 2.19476E-06_JPRB, 2.18016E-06_JPRB, 2.16566E-06_JPRB, 2.15126E-06_JPRB, 2.13695E-06_JPRB, &
+     & 2.12274E-06_JPRB, 2.10862E-06_JPRB, 2.09459E-06_JPRB, 2.08066E-06_JPRB, 2.06683E-06_JPRB, &
+     & 2.05308E-06_JPRB, 2.03942E-06_JPRB, 2.02586E-06_JPRB, 2.01239E-06_JPRB/)
+      KAO_MO2(:, 4) = (/ &
+     & 2.15555E-06_JPRB, 2.14539E-06_JPRB, 2.13527E-06_JPRB, 2.12520E-06_JPRB, 2.11517E-06_JPRB, &
+     & 2.10520E-06_JPRB, 2.09527E-06_JPRB, 2.08538E-06_JPRB, 2.07555E-06_JPRB, 2.06576E-06_JPRB, &
+     & 2.05601E-06_JPRB, 2.04631E-06_JPRB, 2.03666E-06_JPRB, 2.02706E-06_JPRB, 2.01749E-06_JPRB, &
+     & 2.00798E-06_JPRB, 1.99851E-06_JPRB, 1.98908E-06_JPRB, 1.97970E-06_JPRB/)
+      KAO_MO2(:, 5) = (/ &
+     & 2.05821E-06_JPRB, 2.04914E-06_JPRB, 2.04011E-06_JPRB, 2.03111E-06_JPRB, 2.02216E-06_JPRB, &
+     & 2.01324E-06_JPRB, 2.00437E-06_JPRB, 1.99553E-06_JPRB, 1.98673E-06_JPRB, 1.97798E-06_JPRB, &
+     & 1.96926E-06_JPRB, 1.96057E-06_JPRB, 1.95193E-06_JPRB, 1.94333E-06_JPRB, 1.93476E-06_JPRB, &
+     & 1.92623E-06_JPRB, 1.91774E-06_JPRB, 1.90928E-06_JPRB, 1.90087E-06_JPRB/)
+      KAO_MO2(:, 6) = (/ &
+     & 2.20148E-06_JPRB, 2.18998E-06_JPRB, 2.17854E-06_JPRB, 2.16717E-06_JPRB, 2.15585E-06_JPRB, &
+     & 2.14459E-06_JPRB, 2.13339E-06_JPRB, 2.12225E-06_JPRB, 2.11117E-06_JPRB, 2.10014E-06_JPRB, &
+     & 2.08918E-06_JPRB, 2.07827E-06_JPRB, 2.06741E-06_JPRB, 2.05662E-06_JPRB, 2.04588E-06_JPRB, &
+     & 2.03519E-06_JPRB, 2.02457E-06_JPRB, 2.01399E-06_JPRB, 2.00348E-06_JPRB/)
+      KAO_MO2(:, 7) = (/ &
+     & 2.28960E-06_JPRB, 2.27651E-06_JPRB, 2.26349E-06_JPRB, 2.25054E-06_JPRB, 2.23767E-06_JPRB, &
+     & 2.22487E-06_JPRB, 2.21215E-06_JPRB, 2.19950E-06_JPRB, 2.18692E-06_JPRB, 2.17441E-06_JPRB, &
+     & 2.16198E-06_JPRB, 2.14961E-06_JPRB, 2.13732E-06_JPRB, 2.12509E-06_JPRB, 2.11294E-06_JPRB, &
+     & 2.10085E-06_JPRB, 2.08884E-06_JPRB, 2.07689E-06_JPRB, 2.06501E-06_JPRB/)
+      KAO_MO2(:, 8) = (/ &
+     & 2.28564E-06_JPRB, 2.27363E-06_JPRB, 2.26168E-06_JPRB, 2.24980E-06_JPRB, 2.23798E-06_JPRB, &
+     & 2.22622E-06_JPRB, 2.21452E-06_JPRB, 2.20288E-06_JPRB, 2.19131E-06_JPRB, 2.17980E-06_JPRB, &
+     & 2.16834E-06_JPRB, 2.15695E-06_JPRB, 2.14562E-06_JPRB, 2.13434E-06_JPRB, 2.12313E-06_JPRB, &
+     & 2.11197E-06_JPRB, 2.10087E-06_JPRB, 2.08984E-06_JPRB, 2.07886E-06_JPRB/)
+      KAO_MO2(:, 9) = (/ &
+     & 2.28505E-06_JPRB, 2.27395E-06_JPRB, 2.26291E-06_JPRB, 2.25192E-06_JPRB, 2.24099E-06_JPRB, &
+     & 2.23011E-06_JPRB, 2.21928E-06_JPRB, 2.20850E-06_JPRB, 2.19778E-06_JPRB, 2.18711E-06_JPRB, &
+     & 2.17649E-06_JPRB, 2.16592E-06_JPRB, 2.15540E-06_JPRB, 2.14494E-06_JPRB, 2.13452E-06_JPRB, &
+     & 2.12416E-06_JPRB, 2.11385E-06_JPRB, 2.10358E-06_JPRB, 2.09337E-06_JPRB/)
+      KAO_MO2(:,10) = (/ &
+     & 2.25915E-06_JPRB, 2.24938E-06_JPRB, 2.23965E-06_JPRB, 2.22997E-06_JPRB, 2.22032E-06_JPRB, &
+     & 2.21072E-06_JPRB, 2.20116E-06_JPRB, 2.19164E-06_JPRB, 2.18216E-06_JPRB, 2.17272E-06_JPRB, &
+     & 2.16333E-06_JPRB, 2.15397E-06_JPRB, 2.14465E-06_JPRB, 2.13538E-06_JPRB, 2.12614E-06_JPRB, &
+     & 2.11695E-06_JPRB, 2.10779E-06_JPRB, 2.09868E-06_JPRB, 2.08960E-06_JPRB/)
+      KAO_MO2(:,11) = (/ &
+     & 2.52025E-06_JPRB, 2.50423E-06_JPRB, 2.48831E-06_JPRB, 2.47249E-06_JPRB, 2.45677E-06_JPRB, &
+     & 2.44115E-06_JPRB, 2.42563E-06_JPRB, 2.41021E-06_JPRB, 2.39489E-06_JPRB, 2.37967E-06_JPRB, &
+     & 2.36454E-06_JPRB, 2.34951E-06_JPRB, 2.33457E-06_JPRB, 2.31973E-06_JPRB, 2.30498E-06_JPRB, &
+     & 2.29033E-06_JPRB, 2.27577E-06_JPRB, 2.26130E-06_JPRB, 2.24692E-06_JPRB/)
+      KAO_MO2(:,12) = (/ &
+     & 2.52634E-06_JPRB, 2.51180E-06_JPRB, 2.49735E-06_JPRB, 2.48299E-06_JPRB, 2.46871E-06_JPRB, &
+     & 2.45451E-06_JPRB, 2.44039E-06_JPRB, 2.42635E-06_JPRB, 2.41239E-06_JPRB, 2.39851E-06_JPRB, &
+     & 2.38472E-06_JPRB, 2.37100E-06_JPRB, 2.35736E-06_JPRB, 2.34380E-06_JPRB, 2.33032E-06_JPRB, &
+     & 2.31691E-06_JPRB, 2.30358E-06_JPRB, 2.29033E-06_JPRB, 2.27716E-06_JPRB/)
+      KAO_MO2(:,13) = (/ &
+     & 2.66614E-06_JPRB, 2.64897E-06_JPRB, 2.63191E-06_JPRB, 2.61496E-06_JPRB, 2.59812E-06_JPRB, &
+     & 2.58138E-06_JPRB, 2.56476E-06_JPRB, 2.54824E-06_JPRB, 2.53183E-06_JPRB, 2.51552E-06_JPRB, &
+     & 2.49932E-06_JPRB, 2.48322E-06_JPRB, 2.46723E-06_JPRB, 2.45134E-06_JPRB, 2.43555E-06_JPRB, &
+     & 2.41987E-06_JPRB, 2.40428E-06_JPRB, 2.38880E-06_JPRB, 2.37341E-06_JPRB/)
+      KAO_MO2(:,14) = (/ &
+     & 2.96755E-06_JPRB, 2.94803E-06_JPRB, 2.92864E-06_JPRB, 2.90937E-06_JPRB, 2.89023E-06_JPRB, &
+     & 2.87122E-06_JPRB, 2.85233E-06_JPRB, 2.83357E-06_JPRB, 2.81493E-06_JPRB, 2.79641E-06_JPRB, &
+     & 2.77802E-06_JPRB, 2.75974E-06_JPRB, 2.74159E-06_JPRB, 2.72355E-06_JPRB, 2.70563E-06_JPRB, &
+     & 2.68784E-06_JPRB, 2.67015E-06_JPRB, 2.65259E-06_JPRB, 2.63514E-06_JPRB/)
+      KAO_MO2(:,15) = (/ &
+     & 1.30668E-06_JPRB, 1.31378E-06_JPRB, 1.32091E-06_JPRB, 1.32808E-06_JPRB, 1.33530E-06_JPRB, &
+     & 1.34255E-06_JPRB, 1.34984E-06_JPRB, 1.35717E-06_JPRB, 1.36454E-06_JPRB, 1.37195E-06_JPRB, &
+     & 1.37941E-06_JPRB, 1.38690E-06_JPRB, 1.39443E-06_JPRB, 1.40200E-06_JPRB, 1.40962E-06_JPRB, &
+     & 1.41727E-06_JPRB, 1.42497E-06_JPRB, 1.43271E-06_JPRB, 1.44049E-06_JPRB/)
+      KAO_MO2(:,16) = (/ &
+     & 5.99001E-07_JPRB, 6.16844E-07_JPRB, 6.35219E-07_JPRB, 6.54141E-07_JPRB, 6.73626E-07_JPRB, &
+     & 6.93692E-07_JPRB, 7.14356E-07_JPRB, 7.35635E-07_JPRB, 7.57548E-07_JPRB, 7.80114E-07_JPRB, &
+     & 8.03352E-07_JPRB, 8.27282E-07_JPRB, 8.51925E-07_JPRB, 8.77302E-07_JPRB, 9.03435E-07_JPRB, &
+     & 9.30347E-07_JPRB, 9.58060E-07_JPRB, 9.86599E-07_JPRB, 1.01599E-06_JPRB/)
+
+!     The array KBO_Mxx contains the absorption coefficient for 
+!     a minor species at the 16 chosen g-values for a reference pressure
+!     level above 100~ mb.   The first index refers to temperature 
+!     in 7.2 degree increments.  For instance, JT = 1 refers to a 
+!     temperature of 188.0, JT = 2 refers to 195.2, etc. The second index 
+!     runs over the g-channel (1 to 16).
+
+      KBO_MO2(:, 1) = (/ &
+     & 4.97626E-07_JPRB, 5.05955E-07_JPRB, 5.14424E-07_JPRB, 5.23034E-07_JPRB, 5.31789E-07_JPRB, &
+     & 5.40690E-07_JPRB, 5.49739E-07_JPRB, 5.58941E-07_JPRB, 5.68296E-07_JPRB, 5.77808E-07_JPRB, &
+     & 5.87479E-07_JPRB, 5.97312E-07_JPRB, 6.07310E-07_JPRB, 6.17475E-07_JPRB, 6.27810E-07_JPRB, &
+     & 6.38318E-07_JPRB, 6.49002E-07_JPRB, 6.59865E-07_JPRB, 6.70910E-07_JPRB/)
+      KBO_MO2(:, 2) = (/ &
+     & 3.10232E-06_JPRB, 3.06339E-06_JPRB, 3.02496E-06_JPRB, 2.98700E-06_JPRB, 2.94952E-06_JPRB, &
+     & 2.91252E-06_JPRB, 2.87597E-06_JPRB, 2.83989E-06_JPRB, 2.80426E-06_JPRB, 2.76907E-06_JPRB, &
+     & 2.73433E-06_JPRB, 2.70002E-06_JPRB, 2.66614E-06_JPRB, 2.63269E-06_JPRB, 2.59966E-06_JPRB, &
+     & 2.56704E-06_JPRB, 2.53483E-06_JPRB, 2.50303E-06_JPRB, 2.47162E-06_JPRB/)
+      KBO_MO2(:, 3) = (/ &
+     & 2.91635E-06_JPRB, 2.88637E-06_JPRB, 2.85669E-06_JPRB, 2.82733E-06_JPRB, 2.79826E-06_JPRB, &
+     & 2.76949E-06_JPRB, 2.74102E-06_JPRB, 2.71284E-06_JPRB, 2.68495E-06_JPRB, 2.65735E-06_JPRB, &
+     & 2.63003E-06_JPRB, 2.60299E-06_JPRB, 2.57623E-06_JPRB, 2.54975E-06_JPRB, 2.52353E-06_JPRB, &
+     & 2.49759E-06_JPRB, 2.47191E-06_JPRB, 2.44650E-06_JPRB, 2.42135E-06_JPRB/)
+      KBO_MO2(:, 4) = (/ &
+     & 3.15584E-06_JPRB, 3.11986E-06_JPRB, 3.08430E-06_JPRB, 3.04914E-06_JPRB, 3.01438E-06_JPRB, &
+     & 2.98002E-06_JPRB, 2.94605E-06_JPRB, 2.91247E-06_JPRB, 2.87927E-06_JPRB, 2.84645E-06_JPRB, &
+     & 2.81400E-06_JPRB, 2.78192E-06_JPRB, 2.75021E-06_JPRB, 2.71886E-06_JPRB, 2.68787E-06_JPRB, &
+     & 2.65723E-06_JPRB, 2.62694E-06_JPRB, 2.59699E-06_JPRB, 2.56739E-06_JPRB/)
+      KBO_MO2(:, 5) = (/ &
+     & 2.52067E-06_JPRB, 2.50127E-06_JPRB, 2.48202E-06_JPRB, 2.46291E-06_JPRB, 2.44396E-06_JPRB, &
+     & 2.42515E-06_JPRB, 2.40648E-06_JPRB, 2.38796E-06_JPRB, 2.36958E-06_JPRB, 2.35134E-06_JPRB, &
+     & 2.33324E-06_JPRB, 2.31529E-06_JPRB, 2.29747E-06_JPRB, 2.27978E-06_JPRB, 2.26224E-06_JPRB, &
+     & 2.24482E-06_JPRB, 2.22755E-06_JPRB, 2.21040E-06_JPRB, 2.19339E-06_JPRB/)
+      KBO_MO2(:, 6) = (/ &
+     & 2.37304E-06_JPRB, 2.36340E-06_JPRB, 2.35380E-06_JPRB, 2.34423E-06_JPRB, 2.33471E-06_JPRB, &
+     & 2.32522E-06_JPRB, 2.31578E-06_JPRB, 2.30637E-06_JPRB, 2.29700E-06_JPRB, 2.28766E-06_JPRB, &
+     & 2.27837E-06_JPRB, 2.26911E-06_JPRB, 2.25989E-06_JPRB, 2.25071E-06_JPRB, 2.24157E-06_JPRB, &
+     & 2.23246E-06_JPRB, 2.22339E-06_JPRB, 2.21436E-06_JPRB, 2.20536E-06_JPRB/)
+      KBO_MO2(:, 7) = (/ &
+     & 2.56366E-06_JPRB, 2.56395E-06_JPRB, 2.56424E-06_JPRB, 2.56453E-06_JPRB, 2.56482E-06_JPRB, &
+     & 2.56510E-06_JPRB, 2.56539E-06_JPRB, 2.56568E-06_JPRB, 2.56597E-06_JPRB, 2.56625E-06_JPRB, &
+     & 2.56654E-06_JPRB, 2.56683E-06_JPRB, 2.56712E-06_JPRB, 2.56741E-06_JPRB, 2.56769E-06_JPRB, &
+     & 2.56798E-06_JPRB, 2.56827E-06_JPRB, 2.56856E-06_JPRB, 2.56885E-06_JPRB/)
+      KBO_MO2(:, 8) = (/ &
+     & 2.54502E-06_JPRB, 2.55393E-06_JPRB, 2.56287E-06_JPRB, 2.57185E-06_JPRB, 2.58085E-06_JPRB, &
+     & 2.58989E-06_JPRB, 2.59896E-06_JPRB, 2.60806E-06_JPRB, 2.61719E-06_JPRB, 2.62636E-06_JPRB, &
+     & 2.63555E-06_JPRB, 2.64478E-06_JPRB, 2.65404E-06_JPRB, 2.66334E-06_JPRB, 2.67266E-06_JPRB, &
+     & 2.68202E-06_JPRB, 2.69141E-06_JPRB, 2.70084E-06_JPRB, 2.71030E-06_JPRB/)
+      KBO_MO2(:, 9) = (/ &
+     & 1.84106E-06_JPRB, 1.83922E-06_JPRB, 1.83737E-06_JPRB, 1.83553E-06_JPRB, 1.83369E-06_JPRB, &
+     & 1.83186E-06_JPRB, 1.83002E-06_JPRB, 1.82819E-06_JPRB, 1.82636E-06_JPRB, 1.82453E-06_JPRB, &
+     & 1.82270E-06_JPRB, 1.82087E-06_JPRB, 1.81905E-06_JPRB, 1.81723E-06_JPRB, 1.81541E-06_JPRB, &
+     & 1.81359E-06_JPRB, 1.81177E-06_JPRB, 1.80996E-06_JPRB, 1.80814E-06_JPRB/)
+      KBO_MO2(:,10) = (/ &
+     & 1.83886E-06_JPRB, 1.83632E-06_JPRB, 1.83379E-06_JPRB, 1.83126E-06_JPRB, 1.82874E-06_JPRB, &
+     & 1.82622E-06_JPRB, 1.82370E-06_JPRB, 1.82119E-06_JPRB, 1.81868E-06_JPRB, 1.81617E-06_JPRB, &
+     & 1.81367E-06_JPRB, 1.81117E-06_JPRB, 1.80867E-06_JPRB, 1.80618E-06_JPRB, 1.80369E-06_JPRB, &
+     & 1.80120E-06_JPRB, 1.79872E-06_JPRB, 1.79624E-06_JPRB, 1.79377E-06_JPRB/)
+      KBO_MO2(:,11) = (/ &
+     & 2.30390E-06_JPRB, 2.30269E-06_JPRB, 2.30148E-06_JPRB, 2.30028E-06_JPRB, 2.29907E-06_JPRB, &
+     & 2.29787E-06_JPRB, 2.29667E-06_JPRB, 2.29546E-06_JPRB, 2.29426E-06_JPRB, 2.29306E-06_JPRB, &
+     & 2.29186E-06_JPRB, 2.29066E-06_JPRB, 2.28946E-06_JPRB, 2.28826E-06_JPRB, 2.28706E-06_JPRB, &
+     & 2.28586E-06_JPRB, 2.28466E-06_JPRB, 2.28347E-06_JPRB, 2.28227E-06_JPRB/)
+      KBO_MO2(:,12) = (/ &
+     & 2.38201E-06_JPRB, 2.36536E-06_JPRB, 2.34882E-06_JPRB, 2.33240E-06_JPRB, 2.31609E-06_JPRB, &
+     & 2.29990E-06_JPRB, 2.28382E-06_JPRB, 2.26785E-06_JPRB, 2.25199E-06_JPRB, 2.23625E-06_JPRB, &
+     & 2.22061E-06_JPRB, 2.20508E-06_JPRB, 2.18967E-06_JPRB, 2.17436E-06_JPRB, 2.15915E-06_JPRB, &
+     & 2.14406E-06_JPRB, 2.12907E-06_JPRB, 2.11418E-06_JPRB, 2.09940E-06_JPRB/)
+      KBO_MO2(:,13) = (/ &
+     & 2.33326E-06_JPRB, 2.32549E-06_JPRB, 2.31775E-06_JPRB, 2.31003E-06_JPRB, 2.30234E-06_JPRB, &
+     & 2.29467E-06_JPRB, 2.28703E-06_JPRB, 2.27941E-06_JPRB, 2.27182E-06_JPRB, 2.26426E-06_JPRB, &
+     & 2.25672E-06_JPRB, 2.24920E-06_JPRB, 2.24171E-06_JPRB, 2.23424E-06_JPRB, 2.22680E-06_JPRB, &
+     & 2.21939E-06_JPRB, 2.21200E-06_JPRB, 2.20463E-06_JPRB, 2.19729E-06_JPRB/)
+      KBO_MO2(:,14) = (/ &
+     & 2.75292E-06_JPRB, 2.75210E-06_JPRB, 2.75129E-06_JPRB, 2.75047E-06_JPRB, 2.74965E-06_JPRB, &
+     & 2.74883E-06_JPRB, 2.74801E-06_JPRB, 2.74720E-06_JPRB, 2.74638E-06_JPRB, 2.74556E-06_JPRB, &
+     & 2.74475E-06_JPRB, 2.74393E-06_JPRB, 2.74311E-06_JPRB, 2.74230E-06_JPRB, 2.74148E-06_JPRB, &
+     & 2.74067E-06_JPRB, 2.73985E-06_JPRB, 2.73904E-06_JPRB, 2.73822E-06_JPRB/)
+      KBO_MO2(:,15) = (/ &
+     & 2.55262E-06_JPRB, 2.53364E-06_JPRB, 2.51480E-06_JPRB, 2.49611E-06_JPRB, 2.47755E-06_JPRB, &
+     & 2.45913E-06_JPRB, 2.44084E-06_JPRB, 2.42269E-06_JPRB, 2.40468E-06_JPRB, 2.38680E-06_JPRB, &
+     & 2.36906E-06_JPRB, 2.35144E-06_JPRB, 2.33396E-06_JPRB, 2.31660E-06_JPRB, 2.29938E-06_JPRB, &
+     & 2.28228E-06_JPRB, 2.26531E-06_JPRB, 2.24847E-06_JPRB, 2.23175E-06_JPRB/)
+      KBO_MO2(:,16) = (/ &
+     & 3.11382E-06_JPRB, 3.08751E-06_JPRB, 3.06141E-06_JPRB, 3.03554E-06_JPRB, 3.00989E-06_JPRB, &
+     & 2.98445E-06_JPRB, 2.95923E-06_JPRB, 2.93422E-06_JPRB, 2.90942E-06_JPRB, 2.88483E-06_JPRB, &
+     & 2.86045E-06_JPRB, 2.83628E-06_JPRB, 2.81231E-06_JPRB, 2.78854E-06_JPRB, 2.76498E-06_JPRB, &
+     & 2.74161E-06_JPRB, 2.71844E-06_JPRB, 2.69547E-06_JPRB, 2.67269E-06_JPRB/)
+
+!     The array FORREFO contains the coefficient of the water vapor
+!     foreign-continuum (including the energy term).  The first 
+!     index refers to reference temperature (296,260,224,260) and 
+!     pressure (970,475,219,3 mbar) levels.  The second index 
+!     runs over the g-channel (1 to 16).
+
+      FORREFO(1,:) = (/ &
+     &2.8858E-02_JPRB,3.6879E-02_JPRB,4.0746E-02_JPRB,4.2561E-02_JPRB,4.2740E-02_JPRB,4.2707E-02_JPRB, &
+     &4.4109E-02_JPRB,4.4540E-02_JPRB,4.5206E-02_JPRB,4.4679E-02_JPRB,4.5034E-02_JPRB,4.5364E-02_JPRB, &
+     &4.6790E-02_JPRB,4.7857E-02_JPRB,4.8328E-02_JPRB,4.8084E-02_JPRB/)
+      FORREFO(2,:) = (/ &
+     &2.7887E-02_JPRB,3.7376E-02_JPRB,4.0980E-02_JPRB,4.2986E-02_JPRB,4.3054E-02_JPRB,4.2975E-02_JPRB, &
+     &4.3754E-02_JPRB,4.4352E-02_JPRB,4.4723E-02_JPRB,4.6236E-02_JPRB,4.5273E-02_JPRB,4.5360E-02_JPRB, &
+     &4.5332E-02_JPRB,4.7587E-02_JPRB,4.7035E-02_JPRB,5.0267E-02_JPRB/)
+      FORREFO(3,:) = (/ &
+     &2.5846E-02_JPRB,3.6753E-02_JPRB,4.2334E-02_JPRB,4.3806E-02_JPRB,4.3848E-02_JPRB,4.3215E-02_JPRB, &
+     &4.3838E-02_JPRB,4.4278E-02_JPRB,4.4658E-02_JPRB,4.5403E-02_JPRB,4.5255E-02_JPRB,4.6347E-02_JPRB, &
+     &4.4722E-02_JPRB,4.6612E-02_JPRB,4.6836E-02_JPRB,4.8720E-02_JPRB/)
+      FORREFO(4,:) = (/ &
+     &2.8955E-02_JPRB,3.7608E-02_JPRB,4.1989E-02_JPRB,4.4919E-02_JPRB,4.2803E-02_JPRB,4.2842E-02_JPRB, &
+     &4.2632E-02_JPRB,4.1056E-02_JPRB,4.0086E-02_JPRB,4.1401E-02_JPRB,4.2746E-02_JPRB,4.2142E-02_JPRB, &
+     &4.1871E-02_JPRB,4.3917E-02_JPRB,4.5462E-02_JPRB,4.8359E-02_JPRB/)
+
+
+!     The array SELFREFO contains the coefficient of the water vapor
+!     self-continuum (including the energy term).  The first index
+!     refers to temperature in 7.2 degree increments.  For instance,
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+!     etc.  The second index runs over the g-channel (1 to 16).
+
+      SELFREFO(:, 1) = (/ &
+     & 5.96496E-01_JPRB, 5.49171E-01_JPRB, 5.05600E-01_JPRB, 4.65486E-01_JPRB, 4.28555E-01_JPRB, &
+     & 3.94554E-01_JPRB, 3.63250E-01_JPRB, 3.34430E-01_JPRB, 3.07897E-01_JPRB, 2.83468E-01_JPRB/)
+      SELFREFO(:, 2) = (/ &
+     & 7.46455E-01_JPRB, 6.82459E-01_JPRB, 6.23950E-01_JPRB, 5.70457E-01_JPRB, 5.21550E-01_JPRB, &
+     & 4.76836E-01_JPRB, 4.35956E-01_JPRB, 3.98580E-01_JPRB, 3.64409E-01_JPRB, 3.33167E-01_JPRB/)
+      SELFREFO(:, 3) = (/ &
+     & 7.86805E-01_JPRB, 7.21186E-01_JPRB, 6.61040E-01_JPRB, 6.05910E-01_JPRB, 5.55378E-01_JPRB, &
+     & 5.09059E-01_JPRB, 4.66605E-01_JPRB, 4.27690E-01_JPRB, 3.92021E-01_JPRB, 3.59327E-01_JPRB/)
+      SELFREFO(:, 4) = (/ &
+     & 8.11740E-01_JPRB, 7.44359E-01_JPRB, 6.82570E-01_JPRB, 6.25910E-01_JPRB, 5.73954E-01_JPRB, &
+     & 5.26311E-01_JPRB, 4.82622E-01_JPRB, 4.42560E-01_JPRB, 4.05823E-01_JPRB, 3.72136E-01_JPRB/)
+      SELFREFO(:, 5) = (/ &
+     & 8.14870E-01_JPRB, 7.47200E-01_JPRB, 6.85150E-01_JPRB, 6.28253E-01_JPRB, 5.76081E-01_JPRB, &
+     & 5.28241E-01_JPRB, 4.84374E-01_JPRB, 4.44150E-01_JPRB, 4.07266E-01_JPRB, 3.73446E-01_JPRB/)
+      SELFREFO(:, 6) = (/ &
+     & 8.10104E-01_JPRB, 7.43259E-01_JPRB, 6.81930E-01_JPRB, 6.25661E-01_JPRB, 5.74035E-01_JPRB, &
+     & 5.26669E-01_JPRB, 4.83212E-01_JPRB, 4.43340E-01_JPRB, 4.06758E-01_JPRB, 3.73195E-01_JPRB/)
+      SELFREFO(:, 7) = (/ &
+     & 8.13119E-01_JPRB, 7.48127E-01_JPRB, 6.88330E-01_JPRB, 6.33312E-01_JPRB, 5.82692E-01_JPRB, &
+     & 5.36118E-01_JPRB, 4.93267E-01_JPRB, 4.53840E-01_JPRB, 4.17565E-01_JPRB, 3.84189E-01_JPRB/)
+      SELFREFO(:, 8) = (/ &
+     & 8.26137E-01_JPRB, 7.58984E-01_JPRB, 6.97290E-01_JPRB, 6.40611E-01_JPRB, 5.88539E-01_JPRB, &
+     & 5.40699E-01_JPRB, 4.96748E-01_JPRB, 4.56370E-01_JPRB, 4.19274E-01_JPRB, 3.85193E-01_JPRB/)
+      SELFREFO(:, 9) = (/ &
+     & 8.30566E-01_JPRB, 7.63984E-01_JPRB, 7.02740E-01_JPRB, 6.46405E-01_JPRB, 5.94587E-01_JPRB, &
+     & 5.46922E-01_JPRB, 5.03079E-01_JPRB, 4.62750E-01_JPRB, 4.25654E-01_JPRB, 3.91532E-01_JPRB/)
+      SELFREFO(:,10) = (/ &
+     & 8.67471E-01_JPRB, 7.91575E-01_JPRB, 7.22320E-01_JPRB, 6.59124E-01_JPRB, 6.01457E-01_JPRB, &
+     & 5.48835E-01_JPRB, 5.00817E-01_JPRB, 4.57000E-01_JPRB, 4.17017E-01_JPRB, 3.80532E-01_JPRB/)
+      SELFREFO(:,11) = (/ &
+     & 8.51029E-01_JPRB, 7.79373E-01_JPRB, 7.13750E-01_JPRB, 6.53652E-01_JPRB, 5.98615E-01_JPRB, &
+     & 5.48212E-01_JPRB, 5.02053E-01_JPRB, 4.59780E-01_JPRB, 4.21067E-01_JPRB, 3.85613E-01_JPRB/)
+      SELFREFO(:,12) = (/ &
+     & 8.36772E-01_JPRB, 7.68751E-01_JPRB, 7.06260E-01_JPRB, 6.48848E-01_JPRB, 5.96104E-01_JPRB, &
+     & 5.47647E-01_JPRB, 5.03129E-01_JPRB, 4.62230E-01_JPRB, 4.24655E-01_JPRB, 3.90136E-01_JPRB/)
+      SELFREFO(:,13) = (/ &
+     & 8.36551E-01_JPRB, 7.71089E-01_JPRB, 7.10750E-01_JPRB, 6.55133E-01_JPRB, 6.03867E-01_JPRB, &
+     & 5.56614E-01_JPRB, 5.13058E-01_JPRB, 4.72910E-01_JPRB, 4.35904E-01_JPRB, 4.01794E-01_JPRB/)
+      SELFREFO(:,14) = (/ &
+     & 8.84307E-01_JPRB, 8.11175E-01_JPRB, 7.44090E-01_JPRB, 6.82553E-01_JPRB, 6.26106E-01_JPRB, &
+     & 5.74326E-01_JPRB, 5.26829E-01_JPRB, 4.83260E-01_JPRB, 4.43294E-01_JPRB, 4.06633E-01_JPRB/)
+      SELFREFO(:,15) = (/ &
+     & 8.90356E-01_JPRB, 8.19830E-01_JPRB, 7.54890E-01_JPRB, 6.95094E-01_JPRB, 6.40035E-01_JPRB, &
+     & 5.89337E-01_JPRB, 5.42655E-01_JPRB, 4.99670E-01_JPRB, 4.60090E-01_JPRB, 4.23646E-01_JPRB/)
+      SELFREFO(:,16) = (/ &
+     & 9.67549E-01_JPRB, 8.79393E-01_JPRB, 7.99270E-01_JPRB, 7.26447E-01_JPRB, 6.60259E-01_JPRB, &
+     & 6.00101E-01_JPRB, 5.45425E-01_JPRB, 4.95730E-01_JPRB, 4.50563E-01_JPRB, 4.09511E-01_JPRB/)
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB11',1,ZHOOK_HANDLE)
+RETURN
+
+1001 CONTINUE
+CALL ABOR1("RRTM_KGB11:ERROR READING FILE RADRRTM")
+
+END SUBROUTINE RRTM_KGB11
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb11.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb11.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb11.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_KGB11
+END SUBROUTINE RRTM_KGB11
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb12.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb12.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb12.F90	(revision 3908)
@@ -0,0 +1,181 @@
+SUBROUTINE RRTM_KGB12
+
+!     Originally by Eli J. Mlawer, Atmospheric & Environmental Research.
+!     BAND 12:  1800-2080 cm-1 (low - H2O,CO2; high - nothing)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+!     G.Mozdzynski March 2011 read constants from files
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+USE YOMLUN    ,ONLY : NULRAD
+USE YOMMP0    , ONLY : NPROC, MYPROC
+USE MPL_MODULE,ONLY : MPL_BROADCAST
+USE YOMTAG    ,ONLY : MTAGRAD
+
+USE YOERRTO12, ONLY : KAO     ,KAO_D,SELFREFO,FORREFO   ,FRACREFAO
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB12',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+  READ(NULRAD,ERR=1001) KAO_D
+  KAO = REAL(KAO_D,JPRB)
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KAO,MTAGRAD,1,CDSTRING='RRTM_KGB12:')
+ENDIF
+
+! Planck fraction mapping level : P = 174.1640 mbar, T= 215.78 K
+      FRACREFAO(:, 1) = (/ &
+     &  1.3984E-01_JPRB,1.6809E-01_JPRB,1.8072E-01_JPRB,1.5400E-01_JPRB,1.2613E-01_JPRB,9.6959E-02_JPRB, &
+     &  5.9713E-02_JPRB,3.8631E-02_JPRB,2.6937E-02_JPRB,3.1711E-03_JPRB,2.3458E-03_JPRB,1.4653E-03_JPRB, &
+     &  1.0567E-03_JPRB,6.6504E-04_JPRB,2.4957E-04_JPRB,3.5172E-05_JPRB/)
+      FRACREFAO(:, 2) = (/ &
+     &  1.2745E-01_JPRB,1.6107E-01_JPRB,1.6568E-01_JPRB,1.5436E-01_JPRB,1.3183E-01_JPRB,1.0166E-01_JPRB, &
+     &  6.4506E-02_JPRB,4.7756E-02_JPRB,3.4472E-02_JPRB,3.7189E-03_JPRB,2.9349E-03_JPRB,2.1469E-03_JPRB, &
+     &  1.3746E-03_JPRB,7.1691E-04_JPRB,2.8057E-04_JPRB,5.6242E-05_JPRB/)
+      FRACREFAO(:, 3) = (/ &
+     &  1.2181E-01_JPRB,1.5404E-01_JPRB,1.6540E-01_JPRB,1.5255E-01_JPRB,1.3736E-01_JPRB,9.8856E-02_JPRB, &
+     &  6.8927E-02_JPRB,5.1385E-02_JPRB,3.7046E-02_JPRB,4.0302E-03_JPRB,3.0949E-03_JPRB,2.3772E-03_JPRB, &
+     &  1.6538E-03_JPRB,8.9641E-04_JPRB,4.6991E-04_JPRB,1.1251E-04_JPRB/)
+      FRACREFAO(:, 4) = (/ &
+     &  1.1794E-01_JPRB,1.4864E-01_JPRB,1.6316E-01_JPRB,1.5341E-01_JPRB,1.3986E-01_JPRB,9.6656E-02_JPRB, &
+     &  7.2478E-02_JPRB,5.5061E-02_JPRB,3.8886E-02_JPRB,4.3398E-03_JPRB,3.3576E-03_JPRB,2.4891E-03_JPRB, &
+     &  1.7674E-03_JPRB,1.0764E-03_JPRB,7.7689E-04_JPRB,1.1251E-04_JPRB/)
+      FRACREFAO(:, 5) = (/ &
+     &  1.1635E-01_JPRB,1.4342E-01_JPRB,1.5924E-01_JPRB,1.5670E-01_JPRB,1.3740E-01_JPRB,9.7087E-02_JPRB, &
+     &  7.6250E-02_JPRB,5.7802E-02_JPRB,4.0808E-02_JPRB,4.4113E-03_JPRB,3.6035E-03_JPRB,2.6269E-03_JPRB, &
+     &  1.7586E-03_JPRB,1.6498E-03_JPRB,7.7689E-04_JPRB,1.1251E-04_JPRB/)
+      FRACREFAO(:, 6) = (/ &
+     &  1.1497E-01_JPRB,1.3751E-01_JPRB,1.5587E-01_JPRB,1.5904E-01_JPRB,1.3140E-01_JPRB,1.0159E-01_JPRB, &
+     &  7.9729E-02_JPRB,6.1475E-02_JPRB,4.2382E-02_JPRB,4.5291E-03_JPRB,3.8161E-03_JPRB,2.7683E-03_JPRB, &
+     &  1.9899E-03_JPRB,2.0395E-03_JPRB,7.7720E-04_JPRB,1.1251E-04_JPRB/)
+      FRACREFAO(:, 7) = (/ &
+     &  1.1331E-01_JPRB,1.3015E-01_JPRB,1.5574E-01_JPRB,1.5489E-01_JPRB,1.2697E-01_JPRB,1.0746E-01_JPRB, &
+     &  8.4777E-02_JPRB,6.5145E-02_JPRB,4.4293E-02_JPRB,4.7426E-03_JPRB,3.8383E-03_JPRB,2.9065E-03_JPRB, &
+     &  2.8430E-03_JPRB,2.0401E-03_JPRB,7.7689E-04_JPRB,1.1251E-04_JPRB/)
+      FRACREFAO(:, 8) = (/ &
+     &  1.0993E-01_JPRB,1.2320E-01_JPRB,1.4893E-01_JPRB,1.4573E-01_JPRB,1.3174E-01_JPRB,1.1149E-01_JPRB, &
+     &  9.3326E-02_JPRB,6.9942E-02_JPRB,4.6762E-02_JPRB,4.9309E-03_JPRB,3.8583E-03_JPRB,4.1889E-03_JPRB, &
+     &  3.0415E-03_JPRB,2.0406E-03_JPRB,7.7720E-04_JPRB,1.1251E-04_JPRB/)
+      FRACREFAO(:, 9) = (/ &
+     &  1.2028E-01_JPRB,1.2091E-01_JPRB,1.3098E-01_JPRB,1.3442E-01_JPRB,1.3574E-01_JPRB,1.1739E-01_JPRB, &
+     &  9.5343E-02_JPRB,7.0224E-02_JPRB,5.3456E-02_JPRB,6.0206E-03_JPRB,5.0758E-03_JPRB,4.1906E-03_JPRB, &
+     &  3.0431E-03_JPRB,2.0400E-03_JPRB,7.7689E-04_JPRB,1.1251E-04_JPRB/)
+
+
+!     ------------------------------------------------------------------
+
+!     The array KAO contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels> ~100mb, temperatures, and binary
+!     species parameters (see taumol.f for definition).  The first 
+!     index in the array, JS, runs from 1 to 9, and corresponds to 
+!     different values of the binary species parameter.  For instance, 
+!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
+!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
+!     in the array, JT, which runs from 1 to 5, corresponds to different
+!     temperatures.  More specifically, JT = 3 means that the data are for
+!     the reference temperature TREF for this  pressure level, JT = 2 refers
+!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
+!     to the JPth reference pressure level (see taumol.f for these levels
+!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
+!     which g-interval the absorption coefficients are for.
+
+
+!     The array FORREFO contains the coefficient of the water vapor
+!     foreign-continuum (including the energy term).  The first 
+!     index refers to reference temperature (296,260,224,260) and 
+!     pressure (970,475,219,3 mbar) levels.  The second index 
+!     runs over the g-channel (1 to 16).
+
+      FORREFO(1,:) = (/ &
+     &1.4739E-04_JPRB,3.1686E-04_JPRB,8.5973E-04_JPRB,1.9039E-03_JPRB,3.1820E-03_JPRB,3.6596E-03_JPRB, &
+     &3.8724E-03_JPRB,3.6785E-03_JPRB,3.7141E-03_JPRB,3.7646E-03_JPRB,4.2955E-03_JPRB,4.6343E-03_JPRB, &
+     &5.0612E-03_JPRB,4.0227E-03_JPRB,4.2966E-03_JPRB,4.6622E-03_JPRB/)
+      FORREFO(2,:) = (/ &
+     &1.9397E-04_JPRB,3.6322E-04_JPRB,8.9797E-04_JPRB,2.1001E-03_JPRB,3.0307E-03_JPRB,3.5563E-03_JPRB, &
+     &3.8498E-03_JPRB,3.5741E-03_JPRB,3.5914E-03_JPRB,3.7658E-03_JPRB,3.8895E-03_JPRB,4.4072E-03_JPRB, &
+     &4.7112E-03_JPRB,4.2230E-03_JPRB,4.2666E-03_JPRB,4.6634E-03_JPRB/)
+      FORREFO(3,:) = (/ &
+     &3.1506E-04_JPRB,7.3687E-04_JPRB,1.9678E-03_JPRB,2.5531E-03_JPRB,2.8345E-03_JPRB,2.7809E-03_JPRB, &
+     &2.9124E-03_JPRB,2.7125E-03_JPRB,2.6644E-03_JPRB,2.4907E-03_JPRB,2.7032E-03_JPRB,4.0967E-03_JPRB, &
+     &4.1971E-03_JPRB,4.4507E-03_JPRB,4.2293E-03_JPRB,4.6633E-03_JPRB/)
+      FORREFO(4,:) = (/ &
+     &8.8196E-04_JPRB,2.1125E-03_JPRB,2.8042E-03_JPRB,2.8891E-03_JPRB,2.4362E-03_JPRB,1.8733E-03_JPRB, &
+     &1.4078E-03_JPRB,1.1987E-03_JPRB,1.2808E-03_JPRB,8.9050E-04_JPRB,9.4375E-04_JPRB,7.8351E-04_JPRB, &
+     &1.0756E-03_JPRB,1.6586E-03_JPRB,1.7511E-03_JPRB,4.7803E-03_JPRB/)
+
+
+!     The array SELFREFO contains the coefficient of the water vapor
+!     self-continuum (including the energy term).  The first index
+!     refers to temperature in 7.2 degree increments.  For instance,
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+!     etc.  The second index runs over the g-channel (1 to 16).
+
+      SELFREFO(:, 1) = (/ &
+     & 2.37879E-02_JPRB, 2.10719E-02_JPRB, 1.86660E-02_JPRB, 1.65348E-02_JPRB, 1.46469E-02_JPRB, &
+     & 1.29746E-02_JPRB, 1.14932E-02_JPRB, 1.01810E-02_JPRB, 9.01858E-03_JPRB, 7.98888E-03_JPRB/)
+      SELFREFO(:, 2) = (/ &
+     & 3.10625E-02_JPRB, 2.82664E-02_JPRB, 2.57220E-02_JPRB, 2.34066E-02_JPRB, 2.12997E-02_JPRB, &
+     & 1.93824E-02_JPRB, 1.76377E-02_JPRB, 1.60500E-02_JPRB, 1.46053E-02_JPRB, 1.32906E-02_JPRB/)
+      SELFREFO(:, 3) = (/ &
+     & 5.19103E-02_JPRB, 4.80004E-02_JPRB, 4.43850E-02_JPRB, 4.10419E-02_JPRB, 3.79506E-02_JPRB, &
+     & 3.50922E-02_JPRB, 3.24491E-02_JPRB, 3.00050E-02_JPRB, 2.77450E-02_JPRB, 2.56553E-02_JPRB/)
+      SELFREFO(:, 4) = (/ &
+     & 9.12444E-02_JPRB, 8.38675E-02_JPRB, 7.70870E-02_JPRB, 7.08547E-02_JPRB, 6.51263E-02_JPRB, &
+     & 5.98610E-02_JPRB, 5.50214E-02_JPRB, 5.05730E-02_JPRB, 4.64843E-02_JPRB, 4.27262E-02_JPRB/)
+      SELFREFO(:, 5) = (/ &
+     & 1.11323E-01_JPRB, 1.04217E-01_JPRB, 9.75650E-02_JPRB, 9.13376E-02_JPRB, 8.55076E-02_JPRB, &
+     & 8.00498E-02_JPRB, 7.49403E-02_JPRB, 7.01570E-02_JPRB, 6.56790E-02_JPRB, 6.14868E-02_JPRB/)
+      SELFREFO(:, 6) = (/ &
+     & 1.25301E-01_JPRB, 1.16877E-01_JPRB, 1.09020E-01_JPRB, 1.01691E-01_JPRB, 9.48543E-02_JPRB, &
+     & 8.84774E-02_JPRB, 8.25293E-02_JPRB, 7.69810E-02_JPRB, 7.18057E-02_JPRB, 6.69784E-02_JPRB/)
+      SELFREFO(:, 7) = (/ &
+     & 1.34063E-01_JPRB, 1.24662E-01_JPRB, 1.15920E-01_JPRB, 1.07791E-01_JPRB, 1.00232E-01_JPRB, &
+     & 9.32035E-02_JPRB, 8.66676E-02_JPRB, 8.05900E-02_JPRB, 7.49386E-02_JPRB, 6.96836E-02_JPRB/)
+      SELFREFO(:, 8) = (/ &
+     & 1.26997E-01_JPRB, 1.18306E-01_JPRB, 1.10210E-01_JPRB, 1.02668E-01_JPRB, 9.56417E-02_JPRB, &
+     & 8.90964E-02_JPRB, 8.29991E-02_JPRB, 7.73190E-02_JPRB, 7.20276E-02_JPRB, 6.70984E-02_JPRB/)
+      SELFREFO(:, 9) = (/ &
+     & 1.28823E-01_JPRB, 1.20235E-01_JPRB, 1.12220E-01_JPRB, 1.04739E-01_JPRB, 9.77569E-02_JPRB, &
+     & 9.12402E-02_JPRB, 8.51579E-02_JPRB, 7.94810E-02_JPRB, 7.41826E-02_JPRB, 6.92374E-02_JPRB/)
+      SELFREFO(:,10) = (/ &
+     & 1.35802E-01_JPRB, 1.25981E-01_JPRB, 1.16870E-01_JPRB, 1.08418E-01_JPRB, 1.00577E-01_JPRB, &
+     & 9.33034E-02_JPRB, 8.65557E-02_JPRB, 8.02960E-02_JPRB, 7.44890E-02_JPRB, 6.91020E-02_JPRB/)
+      SELFREFO(:,11) = (/ &
+     & 1.35475E-01_JPRB, 1.27572E-01_JPRB, 1.20130E-01_JPRB, 1.13122E-01_JPRB, 1.06523E-01_JPRB, &
+     & 1.00309E-01_JPRB, 9.44573E-02_JPRB, 8.89470E-02_JPRB, 8.37582E-02_JPRB, 7.88721E-02_JPRB/)
+      SELFREFO(:,12) = (/ &
+     & 1.51195E-01_JPRB, 1.41159E-01_JPRB, 1.31790E-01_JPRB, 1.23043E-01_JPRB, 1.14876E-01_JPRB, &
+     & 1.07251E-01_JPRB, 1.00132E-01_JPRB, 9.34860E-02_JPRB, 8.72809E-02_JPRB, 8.14877E-02_JPRB/)
+      SELFREFO(:,13) = (/ &
+     & 1.57538E-01_JPRB, 1.47974E-01_JPRB, 1.38990E-01_JPRB, 1.30552E-01_JPRB, 1.22626E-01_JPRB, &
+     & 1.15181E-01_JPRB, 1.08188E-01_JPRB, 1.01620E-01_JPRB, 9.54505E-02_JPRB, 8.96556E-02_JPRB/)
+      SELFREFO(:,14) = (/ &
+     & 1.53567E-01_JPRB, 1.41564E-01_JPRB, 1.30500E-01_JPRB, 1.20300E-01_JPRB, 1.10898E-01_JPRB, &
+     & 1.02231E-01_JPRB, 9.42406E-02_JPRB, 8.68750E-02_JPRB, 8.00851E-02_JPRB, 7.38259E-02_JPRB/)
+      SELFREFO(:,15) = (/ &
+     & 1.53687E-01_JPRB, 1.42981E-01_JPRB, 1.33020E-01_JPRB, 1.23753E-01_JPRB, 1.15132E-01_JPRB, &
+     & 1.07112E-01_JPRB, 9.96500E-02_JPRB, 9.27080E-02_JPRB, 8.62496E-02_JPRB, 8.02412E-02_JPRB/)
+      SELFREFO(:,16) = (/ &
+     & 1.65129E-01_JPRB, 1.53285E-01_JPRB, 1.42290E-01_JPRB, 1.32084E-01_JPRB, 1.22610E-01_JPRB, &
+     & 1.13815E-01_JPRB, 1.05651E-01_JPRB, 9.80730E-02_JPRB, 9.10384E-02_JPRB, 8.45083E-02_JPRB/)
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB12',1,ZHOOK_HANDLE)
+RETURN
+
+1001 CONTINUE
+CALL ABOR1("RRTM_KGB12:ERROR READING FILE RADRRTM")
+
+END SUBROUTINE RRTM_KGB12
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb12.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb12.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb12.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_KGB12
+END SUBROUTINE RRTM_KGB12
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb13.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb13.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb13.F90	(revision 3908)
@@ -0,0 +1,1733 @@
+SUBROUTINE RRTM_KGB13
+
+!     Originally by Eli J. Mlawer, Atmospheric & Environmental Research.
+!     BAND 13:  2080-2250 cm-1 (low - H2O,N2O; high - nothing)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+!     G.Mozdzynski March 2011 read constants from files
+!     ABozzo 201306 updated to rrtmg v4.85
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+USE YOMLUN    ,ONLY : NULRAD
+USE YOMMP0    , ONLY : NPROC, MYPROC
+USE MPL_MODULE,ONLY : MPL_BROADCAST
+USE YOMTAG    ,ONLY : MTAGRAD
+
+USE YOERRTO13, ONLY : KAO     ,KAO_D,SELFREFO, FORREFO ,FRACREFAO, FRACREFBO, KAO_MCO2, KAO_MCO,KBO_MO3
+
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB13',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+  READ(NULRAD,ERR=1001) KAO_D
+  KAO = REAL(KAO_D,JPRB)
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KAO,MTAGRAD,1,CDSTRING='RRTM_KGB13:')
+ENDIF
+
+! Planck fraction mapping level : P=473.4280 mb, T = 259.83 K      
+      FRACREFAO(:, 1) = (/ &
+     &  1.7534E-01_JPRB,1.7394E-01_JPRB,1.6089E-01_JPRB,1.3782E-01_JPRB,1.0696E-01_JPRB,8.5853E-02_JPRB, &
+     &  6.6548E-02_JPRB,4.9053E-02_JPRB,3.2064E-02_JPRB,3.4820E-03_JPRB,2.8763E-03_JPRB,2.2204E-03_JPRB, &
+     &  1.5612E-03_JPRB,9.8572E-04_JPRB,3.6853E-04_JPRB,5.1612E-05_JPRB/)
+      FRACREFAO(:, 2) = (/ &
+     &  1.7489E-01_JPRB,1.7309E-01_JPRB,1.5981E-01_JPRB,1.3782E-01_JPRB,1.0797E-01_JPRB,8.6367E-02_JPRB, &
+     &  6.7042E-02_JPRB,4.9257E-02_JPRB,3.2207E-02_JPRB,3.4820E-03_JPRB,2.8767E-03_JPRB,2.2203E-03_JPRB, &
+     &  1.5613E-03_JPRB,9.8571E-04_JPRB,3.6853E-04_JPRB,5.1612E-05_JPRB/)
+      FRACREFAO(:, 3) = (/ &
+     &  1.7459E-01_JPRB,1.7259E-01_JPRB,1.5948E-01_JPRB,1.3694E-01_JPRB,1.0815E-01_JPRB,8.7376E-02_JPRB, &
+     &  6.7339E-02_JPRB,4.9541E-02_JPRB,3.2333E-02_JPRB,3.5019E-03_JPRB,2.8958E-03_JPRB,2.2527E-03_JPRB, &
+     &  1.6099E-03_JPRB,9.8574E-04_JPRB,3.6853E-04_JPRB,5.1612E-05_JPRB/)
+      FRACREFAO(:, 4) = (/ &
+     &  1.7391E-01_JPRB,1.7244E-01_JPRB,1.5921E-01_JPRB,1.3644E-01_JPRB,1.0787E-01_JPRB,8.7776E-02_JPRB, &
+     &  6.8361E-02_JPRB,4.9628E-02_JPRB,3.2578E-02_JPRB,3.5117E-03_JPRB,2.9064E-03_JPRB,2.2571E-03_JPRB, &
+     &  1.6887E-03_JPRB,1.0045E-03_JPRB,3.6853E-04_JPRB,5.1612E-05_JPRB/)
+      FRACREFAO(:, 5) = (/ &
+     &  1.7338E-01_JPRB,1.7157E-01_JPRB,1.5957E-01_JPRB,1.3571E-01_JPRB,1.0773E-01_JPRB,8.7966E-02_JPRB, &
+     &  6.9000E-02_JPRB,5.0300E-02_JPRB,3.2813E-02_JPRB,3.5470E-03_JPRB,2.9425E-03_JPRB,2.2552E-03_JPRB, &
+     &  1.7038E-03_JPRB,1.1025E-03_JPRB,3.6853E-04_JPRB,5.1612E-05_JPRB/)
+      FRACREFAO(:, 6) = (/ &
+     &  1.7230E-01_JPRB,1.7082E-01_JPRB,1.5917E-01_JPRB,1.3562E-01_JPRB,1.0806E-01_JPRB,8.7635E-02_JPRB, &
+     &  6.9815E-02_JPRB,5.1155E-02_JPRB,3.3139E-02_JPRB,3.6264E-03_JPRB,2.9436E-03_JPRB,2.3417E-03_JPRB, &
+     &  1.7731E-03_JPRB,1.1156E-03_JPRB,4.4533E-04_JPRB,5.1612E-05_JPRB/)
+      FRACREFAO(:, 7) = (/ &
+     &  1.7073E-01_JPRB,1.6961E-01_JPRB,1.5844E-01_JPRB,1.3594E-01_JPRB,1.0821E-01_JPRB,8.7791E-02_JPRB, &
+     &  7.0502E-02_JPRB,5.1904E-02_JPRB,3.4107E-02_JPRB,3.5888E-03_JPRB,2.9574E-03_JPRB,2.5851E-03_JPRB, &
+     &  1.9127E-03_JPRB,1.1537E-03_JPRB,4.7789E-04_JPRB,1.0016E-04_JPRB/)
+      FRACREFAO(:, 8) = (/ &
+     &  1.6700E-01_JPRB,1.6848E-01_JPRB,1.5628E-01_JPRB,1.3448E-01_JPRB,1.1011E-01_JPRB,8.9016E-02_JPRB, &
+     &  7.1973E-02_JPRB,5.2798E-02_JPRB,3.5650E-02_JPRB,3.8534E-03_JPRB,3.4142E-03_JPRB,2.7799E-03_JPRB, &
+     &  2.1288E-03_JPRB,1.3043E-03_JPRB,6.2858E-04_JPRB,1.0016E-04_JPRB/)
+      FRACREFAO(:, 9) = (/ &
+     &  1.6338E-01_JPRB,1.5565E-01_JPRB,1.4470E-01_JPRB,1.3500E-01_JPRB,1.1909E-01_JPRB,9.8312E-02_JPRB, &
+     &  7.9023E-02_JPRB,5.5728E-02_JPRB,3.6831E-02_JPRB,3.6569E-03_JPRB,3.0552E-03_JPRB,2.3431E-03_JPRB, &
+     &  1.7088E-03_JPRB,1.1082E-03_JPRB,3.6829E-04_JPRB,5.1612E-05_JPRB/)
+
+! Planck fraction mapping level : P=4.758820 mb, T = 250.85 K
+      FRACREFBO(:) = (/ &
+     &  1.5411E-01_JPRB,1.3573E-01_JPRB,1.2527E-01_JPRB,1.2698E-01_JPRB,1.2394E-01_JPRB,1.0876E-01_JPRB, &
+     &  8.9906E-02_JPRB,6.9551E-02_JPRB,4.8240E-02_JPRB,5.2434E-03_JPRB,4.3630E-03_JPRB,3.4262E-03_JPRB, &
+     &  2.5124E-03_JPRB,1.5479E-03_JPRB,3.7294E-04_JPRB,5.1050E-05_JPRB/)
+
+
+!     ------------------------------------------------------------------
+
+!     The array KAO contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels> ~100mb, temperatures, and binary
+!     species parameters (see taumol.f for definition).  The first 
+!     index in the array, JS, runs from 1 to 9, and corresponds to 
+!     different values of the binary species parameter.  For instance, 
+!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
+!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
+!     in the array, JT, which runs from 1 to 5, corresponds to different
+!     temperatures.  More specifically, JT = 3 means that the data are for
+!     the reference temperature TREF for this  pressure level, JT = 2 refers
+!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
+!     to the JPth reference pressure level (see taumol.f for these levels
+!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
+!     which g-interval the absorption coefficients are for.
+
+
+!     The array KAO_Mxx contains the absorption coefficient for 
+!     a minor species at the 16 chosen g-values for a reference pressure
+!     level below 100~ mb.   The first index in the array, JS, runs
+!     from 1 to 10, and corresponds to different gas column amount ratios,
+!     as expressed through the binary species parameter eta, defined as
+!     eta = gas1/(gas1 + (rat) * gas2), where rat is the 
+!     ratio of the reference MLS column amount value of gas 1 
+!     to that of gas2.  The second index refers to temperature 
+!     in 7.2 degree increments.  For instance, JT = 1 refers to a 
+!     temperature of 188.0, JT = 2 refers to 195.2, etc. The third index 
+!     runs over the g-channel (1 to 16).
+
+      KAO_MCO2( 1, :, 1) = (/ &
+     & 1.09539E-04_JPRB, 1.17067E-04_JPRB, 1.25113E-04_JPRB, 1.33712E-04_JPRB, 1.42902E-04_JPRB, &
+     & 1.52724E-04_JPRB, 1.63221E-04_JPRB, 1.74439E-04_JPRB, 1.86428E-04_JPRB, 1.99241E-04_JPRB, &
+     & 2.12934E-04_JPRB, 2.27569E-04_JPRB, 2.43210E-04_JPRB, 2.59926E-04_JPRB, 2.77790E-04_JPRB, &
+     & 2.96883E-04_JPRB, 3.17287E-04_JPRB, 3.39094E-04_JPRB, 3.62400E-04_JPRB/)
+      KAO_MCO2( 2, :, 1) = (/ &
+     & 1.25202E-04_JPRB, 1.34718E-04_JPRB, 1.44957E-04_JPRB, 1.55974E-04_JPRB, 1.67829E-04_JPRB, &
+     & 1.80585E-04_JPRB, 1.94311E-04_JPRB, 2.09079E-04_JPRB, 2.24971E-04_JPRB, 2.42069E-04_JPRB, &
+     & 2.60468E-04_JPRB, 2.80265E-04_JPRB, 3.01567E-04_JPRB, 3.24488E-04_JPRB, 3.49150E-04_JPRB, &
+     & 3.75688E-04_JPRB, 4.04242E-04_JPRB, 4.34966E-04_JPRB, 4.68026E-04_JPRB/)
+      KAO_MCO2( 3, :, 1) = (/ &
+     & 1.12112E-04_JPRB, 1.21090E-04_JPRB, 1.30786E-04_JPRB, 1.41259E-04_JPRB, 1.52571E-04_JPRB, &
+     & 1.64788E-04_JPRB, 1.77984E-04_JPRB, 1.92237E-04_JPRB, 2.07631E-04_JPRB, 2.24257E-04_JPRB, &
+     & 2.42215E-04_JPRB, 2.61611E-04_JPRB, 2.82560E-04_JPRB, 3.05187E-04_JPRB, 3.29625E-04_JPRB, &
+     & 3.56021E-04_JPRB, 3.84530E-04_JPRB, 4.15322E-04_JPRB, 4.48580E-04_JPRB/)
+      KAO_MCO2( 4, :, 1) = (/ &
+     & 9.74130E-05_JPRB, 1.05372E-04_JPRB, 1.13982E-04_JPRB, 1.23295E-04_JPRB, 1.33369E-04_JPRB, &
+     & 1.44265E-04_JPRB, 1.56053E-04_JPRB, 1.68803E-04_JPRB, 1.82595E-04_JPRB, 1.97514E-04_JPRB, &
+     & 2.13652E-04_JPRB, 2.31109E-04_JPRB, 2.49992E-04_JPRB, 2.70418E-04_JPRB, 2.92512E-04_JPRB, &
+     & 3.16412E-04_JPRB, 3.42265E-04_JPRB, 3.70230E-04_JPRB, 4.00479E-04_JPRB/)
+      KAO_MCO2( 5, :, 1) = (/ &
+     & 8.71018E-05_JPRB, 9.40759E-05_JPRB, 1.01608E-04_JPRB, 1.09744E-04_JPRB, 1.18531E-04_JPRB, &
+     & 1.28022E-04_JPRB, 1.38272E-04_JPRB, 1.49343E-04_JPRB, 1.61301E-04_JPRB, 1.74216E-04_JPRB, &
+     & 1.88166E-04_JPRB, 2.03232E-04_JPRB, 2.19504E-04_JPRB, 2.37079E-04_JPRB, 2.56062E-04_JPRB, &
+     & 2.76565E-04_JPRB, 2.98709E-04_JPRB, 3.22626E-04_JPRB, 3.48458E-04_JPRB/)
+      KAO_MCO2( 6, :, 1) = (/ &
+     & 7.55256E-05_JPRB, 8.17414E-05_JPRB, 8.84688E-05_JPRB, 9.57500E-05_JPRB, 1.03630E-04_JPRB, &
+     & 1.12159E-04_JPRB, 1.21390E-04_JPRB, 1.31381E-04_JPRB, 1.42193E-04_JPRB, 1.53896E-04_JPRB, &
+     & 1.66562E-04_JPRB, 1.80270E-04_JPRB, 1.95107E-04_JPRB, 2.11164E-04_JPRB, 2.28543E-04_JPRB, &
+     & 2.47353E-04_JPRB, 2.67710E-04_JPRB, 2.89743E-04_JPRB, 3.13589E-04_JPRB/)
+      KAO_MCO2( 7, :, 1) = (/ &
+     & 5.31515E-05_JPRB, 6.06869E-05_JPRB, 6.92907E-05_JPRB, 7.91143E-05_JPRB, 9.03306E-05_JPRB, &
+     & 1.03137E-04_JPRB, 1.17759E-04_JPRB, 1.34454E-04_JPRB, 1.53516E-04_JPRB, 1.75281E-04_JPRB, &
+     & 2.00131E-04_JPRB, 2.28504E-04_JPRB, 2.60900E-04_JPRB, 2.97888E-04_JPRB, 3.40121E-04_JPRB, &
+     & 3.88341E-04_JPRB, 4.43397E-04_JPRB, 5.06259E-04_JPRB, 5.78033E-04_JPRB/)
+      KAO_MCO2( 8, :, 1) = (/ &
+     & 2.52471E-04_JPRB, 2.96005E-04_JPRB, 3.47045E-04_JPRB, 4.06886E-04_JPRB, 4.77045E-04_JPRB, &
+     & 5.59302E-04_JPRB, 6.55742E-04_JPRB, 7.68811E-04_JPRB, 9.01377E-04_JPRB, 1.05680E-03_JPRB, &
+     & 1.23902E-03_JPRB, 1.45267E-03_JPRB, 1.70315E-03_JPRB, 1.99683E-03_JPRB, 2.34114E-03_JPRB, &
+     & 2.74482E-03_JPRB, 3.21811E-03_JPRB, 3.77300E-03_JPRB, 4.42358E-03_JPRB/)
+      KAO_MCO2( 9, :, 1) = (/ &
+     & 4.06711E-05_JPRB, 4.53161E-05_JPRB, 5.04917E-05_JPRB, 5.62583E-05_JPRB, 6.26836E-05_JPRB, &
+     & 6.98427E-05_JPRB, 7.78194E-05_JPRB, 8.67071E-05_JPRB, 9.66100E-05_JPRB, 1.07644E-04_JPRB, &
+     & 1.19938E-04_JPRB, 1.33636E-04_JPRB, 1.48898E-04_JPRB, 1.65904E-04_JPRB, 1.84852E-04_JPRB, &
+     & 2.05964E-04_JPRB, 2.29487E-04_JPRB, 2.55697E-04_JPRB, 2.84900E-04_JPRB/)
+      KAO_MCO2( 1, :, 2) = (/ &
+     & 2.01759E-04_JPRB, 2.15641E-04_JPRB, 2.30478E-04_JPRB, 2.46336E-04_JPRB, 2.63285E-04_JPRB, &
+     & 2.81400E-04_JPRB, 3.00761E-04_JPRB, 3.21455E-04_JPRB, 3.43573E-04_JPRB, 3.67212E-04_JPRB, &
+     & 3.92477E-04_JPRB, 4.19482E-04_JPRB, 4.48344E-04_JPRB, 4.79192E-04_JPRB, 5.12162E-04_JPRB, &
+     & 5.47401E-04_JPRB, 5.85064E-04_JPRB, 6.25319E-04_JPRB, 6.68343E-04_JPRB/)
+      KAO_MCO2( 2, :, 2) = (/ &
+     & 2.53461E-04_JPRB, 2.70916E-04_JPRB, 2.89574E-04_JPRB, 3.09516E-04_JPRB, 3.30832E-04_JPRB, &
+     & 3.53616E-04_JPRB, 3.77969E-04_JPRB, 4.03999E-04_JPRB, 4.31822E-04_JPRB, 4.61561E-04_JPRB, &
+     & 4.93348E-04_JPRB, 5.27324E-04_JPRB, 5.63640E-04_JPRB, 6.02457E-04_JPRB, 6.43948E-04_JPRB, &
+     & 6.88295E-04_JPRB, 7.35697E-04_JPRB, 7.86364E-04_JPRB, 8.40519E-04_JPRB/)
+      KAO_MCO2( 3, :, 2) = (/ &
+     & 2.58821E-04_JPRB, 2.76943E-04_JPRB, 2.96334E-04_JPRB, 3.17082E-04_JPRB, 3.39283E-04_JPRB, &
+     & 3.63038E-04_JPRB, 3.88457E-04_JPRB, 4.15655E-04_JPRB, 4.44758E-04_JPRB, 4.75899E-04_JPRB, &
+     & 5.09220E-04_JPRB, 5.44874E-04_JPRB, 5.83024E-04_JPRB, 6.23845E-04_JPRB, 6.67525E-04_JPRB, &
+     & 7.14263E-04_JPRB, 7.64273E-04_JPRB, 8.17785E-04_JPRB, 8.75043E-04_JPRB/)
+      KAO_MCO2( 4, :, 2) = (/ &
+     & 2.46588E-04_JPRB, 2.64630E-04_JPRB, 2.83993E-04_JPRB, 3.04771E-04_JPRB, 3.27071E-04_JPRB, &
+     & 3.51001E-04_JPRB, 3.76683E-04_JPRB, 4.04244E-04_JPRB, 4.33821E-04_JPRB, 4.65563E-04_JPRB, &
+     & 4.99627E-04_JPRB, 5.36183E-04_JPRB, 5.75414E-04_JPRB, 6.17515E-04_JPRB, 6.62697E-04_JPRB, &
+     & 7.11185E-04_JPRB, 7.63220E-04_JPRB, 8.19063E-04_JPRB, 8.78991E-04_JPRB/)
+      KAO_MCO2( 5, :, 2) = (/ &
+     & 2.19140E-04_JPRB, 2.36464E-04_JPRB, 2.55158E-04_JPRB, 2.75330E-04_JPRB, 2.97097E-04_JPRB, &
+     & 3.20585E-04_JPRB, 3.45929E-04_JPRB, 3.73277E-04_JPRB, 4.02787E-04_JPRB, 4.34630E-04_JPRB, &
+     & 4.68991E-04_JPRB, 5.06068E-04_JPRB, 5.46076E-04_JPRB, 5.89247E-04_JPRB, 6.35831E-04_JPRB, &
+     & 6.86097E-04_JPRB, 7.40338E-04_JPRB, 7.98867E-04_JPRB, 8.62022E-04_JPRB/)
+      KAO_MCO2( 6, :, 2) = (/ &
+     & 1.74073E-04_JPRB, 1.92221E-04_JPRB, 2.12260E-04_JPRB, 2.34388E-04_JPRB, 2.58824E-04_JPRB, &
+     & 2.85807E-04_JPRB, 3.15603E-04_JPRB, 3.48505E-04_JPRB, 3.84837E-04_JPRB, 4.24957E-04_JPRB, &
+     & 4.69260E-04_JPRB, 5.18181E-04_JPRB, 5.72202E-04_JPRB, 6.31855E-04_JPRB, 6.97727E-04_JPRB, &
+     & 7.70466E-04_JPRB, 8.50789E-04_JPRB, 9.39485E-04_JPRB, 1.03743E-03_JPRB/)
+      KAO_MCO2( 7, :, 2) = (/ &
+     & 1.74359E-04_JPRB, 1.99276E-04_JPRB, 2.27753E-04_JPRB, 2.60299E-04_JPRB, 2.97497E-04_JPRB, &
+     & 3.40010E-04_JPRB, 3.88599E-04_JPRB, 4.44130E-04_JPRB, 5.07598E-04_JPRB, 5.80135E-04_JPRB, &
+     & 6.63039E-04_JPRB, 7.57789E-04_JPRB, 8.66079E-04_JPRB, 9.89845E-04_JPRB, 1.13130E-03_JPRB, &
+     & 1.29296E-03_JPRB, 1.47773E-03_JPRB, 1.68890E-03_JPRB, 1.93025E-03_JPRB/)
+      KAO_MCO2( 8, :, 2) = (/ &
+     & 1.08215E-03_JPRB, 1.20760E-03_JPRB, 1.34759E-03_JPRB, 1.50382E-03_JPRB, 1.67815E-03_JPRB, &
+     & 1.87270E-03_JPRB, 2.08980E-03_JPRB, 2.33206E-03_JPRB, 2.60242E-03_JPRB, 2.90411E-03_JPRB, &
+     & 3.24078E-03_JPRB, 3.61648E-03_JPRB, 4.03573E-03_JPRB, 4.50359E-03_JPRB, 5.02568E-03_JPRB, &
+     & 5.60830E-03_JPRB, 6.25846E-03_JPRB, 6.98399E-03_JPRB, 7.79363E-03_JPRB/)
+      KAO_MCO2( 9, :, 2) = (/ &
+     & 1.04969E-04_JPRB, 1.20766E-04_JPRB, 1.38939E-04_JPRB, 1.59848E-04_JPRB, 1.83903E-04_JPRB, &
+     & 2.11578E-04_JPRB, 2.43418E-04_JPRB, 2.80049E-04_JPRB, 3.22193E-04_JPRB, 3.70678E-04_JPRB, &
+     & 4.26461E-04_JPRB, 4.90638E-04_JPRB, 5.64472E-04_JPRB, 6.49418E-04_JPRB, 7.47147E-04_JPRB, &
+     & 8.59583E-04_JPRB, 9.88940E-04_JPRB, 1.13776E-03_JPRB, 1.30898E-03_JPRB/)
+      KAO_MCO2( 1, :, 3) = (/ &
+     & 3.72106E-04_JPRB, 3.96252E-04_JPRB, 4.21966E-04_JPRB, 4.49347E-04_JPRB, 4.78506E-04_JPRB, &
+     & 5.09557E-04_JPRB, 5.42623E-04_JPRB, 5.77834E-04_JPRB, 6.15330E-04_JPRB, 6.55260E-04_JPRB, &
+     & 6.97781E-04_JPRB, 7.43060E-04_JPRB, 7.91278E-04_JPRB, 8.42626E-04_JPRB, 8.97304E-04_JPRB, &
+     & 9.55532E-04_JPRB, 1.01754E-03_JPRB, 1.08357E-03_JPRB, 1.15388E-03_JPRB/)
+      KAO_MCO2( 2, :, 3) = (/ &
+     & 4.20563E-04_JPRB, 4.46162E-04_JPRB, 4.73319E-04_JPRB, 5.02130E-04_JPRB, 5.32693E-04_JPRB, &
+     & 5.65118E-04_JPRB, 5.99516E-04_JPRB, 6.36007E-04_JPRB, 6.74720E-04_JPRB, 7.15789E-04_JPRB, &
+     & 7.59358E-04_JPRB, 8.05579E-04_JPRB, 8.54613E-04_JPRB, 9.06632E-04_JPRB, 9.61817E-04_JPRB, &
+     & 1.02036E-03_JPRB, 1.08247E-03_JPRB, 1.14836E-03_JPRB, 1.21826E-03_JPRB/)
+      KAO_MCO2( 3, :, 3) = (/ &
+     & 4.89664E-04_JPRB, 5.18321E-04_JPRB, 5.48654E-04_JPRB, 5.80764E-04_JPRB, 6.14752E-04_JPRB, &
+     & 6.50729E-04_JPRB, 6.88812E-04_JPRB, 7.29124E-04_JPRB, 7.71795E-04_JPRB, 8.16963E-04_JPRB, &
+     & 8.64774E-04_JPRB, 9.15384E-04_JPRB, 9.68955E-04_JPRB, 1.02566E-03_JPRB, 1.08569E-03_JPRB, &
+     & 1.14922E-03_JPRB, 1.21648E-03_JPRB, 1.28767E-03_JPRB, 1.36303E-03_JPRB/)
+      KAO_MCO2( 4, :, 3) = (/ &
+     & 4.61143E-04_JPRB, 4.92198E-04_JPRB, 5.25343E-04_JPRB, 5.60720E-04_JPRB, 5.98480E-04_JPRB, &
+     & 6.38783E-04_JPRB, 6.81799E-04_JPRB, 7.27713E-04_JPRB, 7.76718E-04_JPRB, 8.29023E-04_JPRB, &
+     & 8.84851E-04_JPRB, 9.44438E-04_JPRB, 1.00804E-03_JPRB, 1.07592E-03_JPRB, 1.14837E-03_JPRB, &
+     & 1.22571E-03_JPRB, 1.30825E-03_JPRB, 1.39635E-03_JPRB, 1.49038E-03_JPRB/)
+      KAO_MCO2( 5, :, 3) = (/ &
+     & 4.01988E-04_JPRB, 4.36672E-04_JPRB, 4.74349E-04_JPRB, 5.15278E-04_JPRB, 5.59737E-04_JPRB, &
+     & 6.08032E-04_JPRB, 6.60495E-04_JPRB, 7.17484E-04_JPRB, 7.79390E-04_JPRB, 8.46638E-04_JPRB, &
+     & 9.19688E-04_JPRB, 9.99041E-04_JPRB, 1.08524E-03_JPRB, 1.17888E-03_JPRB, 1.28059E-03_JPRB, &
+     & 1.39109E-03_JPRB, 1.51111E-03_JPRB, 1.64149E-03_JPRB, 1.78313E-03_JPRB/)
+      KAO_MCO2( 6, :, 3) = (/ &
+     & 3.35536E-04_JPRB, 3.74371E-04_JPRB, 4.17700E-04_JPRB, 4.66045E-04_JPRB, 5.19985E-04_JPRB, &
+     & 5.80169E-04_JPRB, 6.47318E-04_JPRB, 7.22238E-04_JPRB, 8.05831E-04_JPRB, 8.99098E-04_JPRB, &
+     & 1.00316E-03_JPRB, 1.11927E-03_JPRB, 1.24881E-03_JPRB, 1.39335E-03_JPRB, 1.55461E-03_JPRB, &
+     & 1.73455E-03_JPRB, 1.93530E-03_JPRB, 2.15930E-03_JPRB, 2.40921E-03_JPRB/)
+      KAO_MCO2( 7, :, 3) = (/ &
+     & 3.24677E-04_JPRB, 3.75160E-04_JPRB, 4.33491E-04_JPRB, 5.00893E-04_JPRB, 5.78774E-04_JPRB, &
+     & 6.68765E-04_JPRB, 7.72749E-04_JPRB, 8.92900E-04_JPRB, 1.03173E-03_JPRB, 1.19215E-03_JPRB, &
+     & 1.37751E-03_JPRB, 1.59170E-03_JPRB, 1.83918E-03_JPRB, 2.12515E-03_JPRB, 2.45558E-03_JPRB, &
+     & 2.83738E-03_JPRB, 3.27856E-03_JPRB, 3.78832E-03_JPRB, 4.37735E-03_JPRB/)
+      KAO_MCO2( 8, :, 3) = (/ &
+     & 2.24656E-03_JPRB, 2.45550E-03_JPRB, 2.68386E-03_JPRB, 2.93347E-03_JPRB, 3.20629E-03_JPRB, &
+     & 3.50448E-03_JPRB, 3.83041E-03_JPRB, 4.18665E-03_JPRB, 4.57602E-03_JPRB, 5.00160E-03_JPRB, &
+     & 5.46677E-03_JPRB, 5.97519E-03_JPRB, 6.53090E-03_JPRB, 7.13829E-03_JPRB, 7.80217E-03_JPRB, &
+     & 8.52780E-03_JPRB, 9.32091E-03_JPRB, 1.01878E-02_JPRB, 1.11353E-02_JPRB/)
+      KAO_MCO2( 9, :, 3) = (/ &
+     & 2.07746E-04_JPRB, 2.38909E-04_JPRB, 2.74746E-04_JPRB, 3.15959E-04_JPRB, 3.63355E-04_JPRB, &
+     & 4.17860E-04_JPRB, 4.80541E-04_JPRB, 5.52625E-04_JPRB, 6.35521E-04_JPRB, 7.30852E-04_JPRB, &
+     & 8.40484E-04_JPRB, 9.66561E-04_JPRB, 1.11155E-03_JPRB, 1.27829E-03_JPRB, 1.47004E-03_JPRB, &
+     & 1.69055E-03_JPRB, 1.94414E-03_JPRB, 2.23577E-03_JPRB, 2.57115E-03_JPRB/)
+      KAO_MCO2( 1, :, 4) = (/ &
+     & 7.26052E-04_JPRB, 7.62476E-04_JPRB, 8.00726E-04_JPRB, 8.40896E-04_JPRB, 8.83081E-04_JPRB, &
+     & 9.27382E-04_JPRB, 9.73905E-04_JPRB, 1.02276E-03_JPRB, 1.07407E-03_JPRB, 1.12795E-03_JPRB, &
+     & 1.18454E-03_JPRB, 1.24396E-03_JPRB, 1.30637E-03_JPRB, 1.37190E-03_JPRB, 1.44073E-03_JPRB, &
+     & 1.51300E-03_JPRB, 1.58890E-03_JPRB, 1.66861E-03_JPRB, 1.75232E-03_JPRB/)
+      KAO_MCO2( 2, :, 4) = (/ &
+     & 4.65815E-04_JPRB, 5.01167E-04_JPRB, 5.39203E-04_JPRB, 5.80126E-04_JPRB, 6.24154E-04_JPRB, &
+     & 6.71524E-04_JPRB, 7.22489E-04_JPRB, 7.77322E-04_JPRB, 8.36316E-04_JPRB, 8.99788E-04_JPRB, &
+     & 9.68077E-04_JPRB, 1.04155E-03_JPRB, 1.12060E-03_JPRB, 1.20564E-03_JPRB, 1.29714E-03_JPRB, &
+     & 1.39559E-03_JPRB, 1.50151E-03_JPRB, 1.61546E-03_JPRB, 1.73807E-03_JPRB/)
+      KAO_MCO2( 3, :, 4) = (/ &
+     & 3.56225E-04_JPRB, 3.93073E-04_JPRB, 4.33732E-04_JPRB, 4.78598E-04_JPRB, 5.28105E-04_JPRB, &
+     & 5.82732E-04_JPRB, 6.43010E-04_JPRB, 7.09524E-04_JPRB, 7.82918E-04_JPRB, 8.63903E-04_JPRB, &
+     & 9.53266E-04_JPRB, 1.05187E-03_JPRB, 1.16068E-03_JPRB, 1.28074E-03_JPRB, 1.41322E-03_JPRB, &
+     & 1.55941E-03_JPRB, 1.72071E-03_JPRB, 1.89870E-03_JPRB, 2.09511E-03_JPRB/)
+      KAO_MCO2( 4, :, 4) = (/ &
+     & 3.37845E-04_JPRB, 3.79675E-04_JPRB, 4.26684E-04_JPRB, 4.79514E-04_JPRB, 5.38884E-04_JPRB, &
+     & 6.05606E-04_JPRB, 6.80589E-04_JPRB, 7.64855E-04_JPRB, 8.59555E-04_JPRB, 9.65980E-04_JPRB, &
+     & 1.08558E-03_JPRB, 1.21999E-03_JPRB, 1.37105E-03_JPRB, 1.54080E-03_JPRB, 1.73157E-03_JPRB, &
+     & 1.94597E-03_JPRB, 2.18691E-03_JPRB, 2.45767E-03_JPRB, 2.76197E-03_JPRB/)
+      KAO_MCO2( 5, :, 4) = (/ &
+     & 3.52456E-04_JPRB, 4.02782E-04_JPRB, 4.60294E-04_JPRB, 5.26017E-04_JPRB, 6.01126E-04_JPRB, &
+     & 6.86958E-04_JPRB, 7.85046E-04_JPRB, 8.97140E-04_JPRB, 1.02524E-03_JPRB, 1.17163E-03_JPRB, &
+     & 1.33892E-03_JPRB, 1.53010E-03_JPRB, 1.74858E-03_JPRB, 1.99825E-03_JPRB, 2.28358E-03_JPRB, &
+     & 2.60964E-03_JPRB, 2.98226E-03_JPRB, 3.40809E-03_JPRB, 3.89471E-03_JPRB/)
+      KAO_MCO2( 6, :, 4) = (/ &
+     & 4.42884E-04_JPRB, 5.08187E-04_JPRB, 5.83119E-04_JPRB, 6.69100E-04_JPRB, 7.67758E-04_JPRB, &
+     & 8.80963E-04_JPRB, 1.01086E-03_JPRB, 1.15991E-03_JPRB, 1.33094E-03_JPRB, 1.52718E-03_JPRB, &
+     & 1.75237E-03_JPRB, 2.01075E-03_JPRB, 2.30724E-03_JPRB, 2.64744E-03_JPRB, 3.03780E-03_JPRB, &
+     & 3.48572E-03_JPRB, 3.99969E-03_JPRB, 4.58944E-03_JPRB, 5.26614E-03_JPRB/)
+      KAO_MCO2( 7, :, 4) = (/ &
+     & 8.09850E-04_JPRB, 9.09940E-04_JPRB, 1.02240E-03_JPRB, 1.14876E-03_JPRB, 1.29074E-03_JPRB, &
+     & 1.45026E-03_JPRB, 1.62950E-03_JPRB, 1.83089E-03_JPRB, 2.05718E-03_JPRB, 2.31143E-03_JPRB, &
+     & 2.59710E-03_JPRB, 2.91808E-03_JPRB, 3.27873E-03_JPRB, 3.68395E-03_JPRB, 4.13926E-03_JPRB, &
+     & 4.65083E-03_JPRB, 5.22564E-03_JPRB, 5.87148E-03_JPRB, 6.59715E-03_JPRB/)
+      KAO_MCO2( 8, :, 4) = (/ &
+     & 3.13265E-03_JPRB, 3.42454E-03_JPRB, 3.74362E-03_JPRB, 4.09243E-03_JPRB, 4.47375E-03_JPRB, &
+     & 4.89059E-03_JPRB, 5.34627E-03_JPRB, 5.84441E-03_JPRB, 6.38897E-03_JPRB, 6.98426E-03_JPRB, &
+     & 7.63502E-03_JPRB, 8.34642E-03_JPRB, 9.12409E-03_JPRB, 9.97423E-03_JPRB, 1.09036E-02_JPRB, &
+     & 1.19195E-02_JPRB, 1.30301E-02_JPRB, 1.42442E-02_JPRB, 1.55714E-02_JPRB/)
+      KAO_MCO2( 9, :, 4) = (/ &
+     & 5.71287E-04_JPRB, 6.51252E-04_JPRB, 7.42411E-04_JPRB, 8.46330E-04_JPRB, 9.64794E-04_JPRB, &
+     & 1.09984E-03_JPRB, 1.25379E-03_JPRB, 1.42929E-03_JPRB, 1.62935E-03_JPRB, 1.85742E-03_JPRB, &
+     & 2.11741E-03_JPRB, 2.41380E-03_JPRB, 2.75167E-03_JPRB, 3.13683E-03_JPRB, 3.57591E-03_JPRB, &
+     & 4.07645E-03_JPRB, 4.64705E-03_JPRB, 5.29751E-03_JPRB, 6.03903E-03_JPRB/)
+      KAO_MCO2( 1, :, 5) = (/ &
+     & 2.92395E-04_JPRB, 3.32719E-04_JPRB, 3.78604E-04_JPRB, 4.30818E-04_JPRB, 4.90232E-04_JPRB, &
+     & 5.57839E-04_JPRB, 6.34771E-04_JPRB, 7.22312E-04_JPRB, 8.21927E-04_JPRB, 9.35278E-04_JPRB, &
+     & 1.06426E-03_JPRB, 1.21104E-03_JPRB, 1.37805E-03_JPRB, 1.56810E-03_JPRB, 1.78435E-03_JPRB, &
+     & 2.03043E-03_JPRB, 2.31045E-03_JPRB, 2.62908E-03_JPRB, 2.99166E-03_JPRB/)
+      KAO_MCO2( 2, :, 5) = (/ &
+     & 3.13069E-04_JPRB, 3.61343E-04_JPRB, 4.17061E-04_JPRB, 4.81371E-04_JPRB, 5.55597E-04_JPRB, &
+     & 6.41269E-04_JPRB, 7.40151E-04_JPRB, 8.54280E-04_JPRB, 9.86008E-04_JPRB, 1.13805E-03_JPRB, &
+     & 1.31353E-03_JPRB, 1.51608E-03_JPRB, 1.74985E-03_JPRB, 2.01967E-03_JPRB, 2.33110E-03_JPRB, &
+     & 2.69055E-03_JPRB, 3.10543E-03_JPRB, 3.58427E-03_JPRB, 4.13696E-03_JPRB/)
+      KAO_MCO2( 3, :, 5) = (/ &
+     & 3.06937E-04_JPRB, 3.57841E-04_JPRB, 4.17187E-04_JPRB, 4.86375E-04_JPRB, 5.67038E-04_JPRB, &
+     & 6.61078E-04_JPRB, 7.70714E-04_JPRB, 8.98532E-04_JPRB, 1.04755E-03_JPRB, 1.22128E-03_JPRB, &
+     & 1.42382E-03_JPRB, 1.65996E-03_JPRB, 1.93525E-03_JPRB, 2.25620E-03_JPRB, 2.63038E-03_JPRB, &
+     & 3.06661E-03_JPRB, 3.57519E-03_JPRB, 4.16812E-03_JPRB, 4.85937E-03_JPRB/)
+      KAO_MCO2( 4, :, 5) = (/ &
+     & 4.06428E-04_JPRB, 4.72379E-04_JPRB, 5.49033E-04_JPRB, 6.38125E-04_JPRB, 7.41674E-04_JPRB, &
+     & 8.62026E-04_JPRB, 1.00191E-03_JPRB, 1.16449E-03_JPRB, 1.35345E-03_JPRB, 1.57308E-03_JPRB, &
+     & 1.82834E-03_JPRB, 2.12503E-03_JPRB, 2.46986E-03_JPRB, 2.87064E-03_JPRB, 3.33647E-03_JPRB, &
+     & 3.87788E-03_JPRB, 4.50715E-03_JPRB, 5.23852E-03_JPRB, 6.08858E-03_JPRB/)
+      KAO_MCO2( 5, :, 5) = (/ &
+     & 6.01967E-04_JPRB, 6.90414E-04_JPRB, 7.91856E-04_JPRB, 9.08204E-04_JPRB, 1.04165E-03_JPRB, &
+     & 1.19470E-03_JPRB, 1.37023E-03_JPRB, 1.57156E-03_JPRB, 1.80247E-03_JPRB, 2.06731E-03_JPRB, &
+     & 2.37106E-03_JPRB, 2.71944E-03_JPRB, 3.11901E-03_JPRB, 3.57729E-03_JPRB, 4.10290E-03_JPRB, &
+     & 4.70574E-03_JPRB, 5.39716E-03_JPRB, 6.19017E-03_JPRB, 7.09969E-03_JPRB/)
+      KAO_MCO2( 6, :, 5) = (/ &
+     & 1.11622E-03_JPRB, 1.25799E-03_JPRB, 1.41776E-03_JPRB, 1.59783E-03_JPRB, 1.80077E-03_JPRB, &
+     & 2.02947E-03_JPRB, 2.28723E-03_JPRB, 2.57773E-03_JPRB, 2.90512E-03_JPRB, 3.27408E-03_JPRB, &
+     & 3.68992E-03_JPRB, 4.15856E-03_JPRB, 4.68673E-03_JPRB, 5.28197E-03_JPRB, 5.95282E-03_JPRB, &
+     & 6.70887E-03_JPRB, 7.56094E-03_JPRB, 8.52123E-03_JPRB, 9.60348E-03_JPRB/)
+      KAO_MCO2( 7, :, 5) = (/ &
+     & 3.63860E-03_JPRB, 3.96164E-03_JPRB, 4.31337E-03_JPRB, 4.69632E-03_JPRB, 5.11327E-03_JPRB, &
+     & 5.56724E-03_JPRB, 6.06151E-03_JPRB, 6.59967E-03_JPRB, 7.18561E-03_JPRB, 7.82356E-03_JPRB, &
+     & 8.51816E-03_JPRB, 9.27443E-03_JPRB, 1.00978E-02_JPRB, 1.09943E-02_JPRB, 1.19705E-02_JPRB, &
+     & 1.30332E-02_JPRB, 1.41904E-02_JPRB, 1.54502E-02_JPRB, 1.68219E-02_JPRB/)
+      KAO_MCO2( 8, :, 5) = (/ &
+     & 5.96957E-03_JPRB, 6.53049E-03_JPRB, 7.14412E-03_JPRB, 7.81541E-03_JPRB, 8.54977E-03_JPRB, &
+     & 9.35314E-03_JPRB, 1.02320E-02_JPRB, 1.11934E-02_JPRB, 1.22452E-02_JPRB, 1.33958E-02_JPRB, &
+     & 1.46545E-02_JPRB, 1.60315E-02_JPRB, 1.75379E-02_JPRB, 1.91858E-02_JPRB, 2.09886E-02_JPRB, &
+     & 2.29608E-02_JPRB, 2.51182E-02_JPRB, 2.74784E-02_JPRB, 3.00604E-02_JPRB/)
+      KAO_MCO2( 9, :, 5) = (/ &
+     & 1.19381E-03_JPRB, 1.33882E-03_JPRB, 1.50143E-03_JPRB, 1.68379E-03_JPRB, 1.88831E-03_JPRB, &
+     & 2.11767E-03_JPRB, 2.37488E-03_JPRB, 2.66333E-03_JPRB, 2.98683E-03_JPRB, 3.34961E-03_JPRB, &
+     & 3.75646E-03_JPRB, 4.21272E-03_JPRB, 4.72440E-03_JPRB, 5.29823E-03_JPRB, 5.94176E-03_JPRB, &
+     & 6.66345E-03_JPRB, 7.47280E-03_JPRB, 8.38045E-03_JPRB, 9.39835E-03_JPRB/)
+      KAO_MCO2( 1, :, 6) = (/ &
+     & 4.12429E-04_JPRB, 4.84830E-04_JPRB, 5.69942E-04_JPRB, 6.69995E-04_JPRB, 7.87613E-04_JPRB, &
+     & 9.25878E-04_JPRB, 1.08842E-03_JPRB, 1.27949E-03_JPRB, 1.50410E-03_JPRB, 1.76814E-03_JPRB, &
+     & 2.07854E-03_JPRB, 2.44343E-03_JPRB, 2.87237E-03_JPRB, 3.37662E-03_JPRB, 3.96938E-03_JPRB, &
+     & 4.66621E-03_JPRB, 5.48536E-03_JPRB, 6.44831E-03_JPRB, 7.58031E-03_JPRB/)
+      KAO_MCO2( 2, :, 6) = (/ &
+     & 6.43498E-04_JPRB, 7.46132E-04_JPRB, 8.65134E-04_JPRB, 1.00312E-03_JPRB, 1.16311E-03_JPRB, &
+     & 1.34861E-03_JPRB, 1.56371E-03_JPRB, 1.81310E-03_JPRB, 2.10228E-03_JPRB, 2.43758E-03_JPRB, &
+     & 2.82635E-03_JPRB, 3.27714E-03_JPRB, 3.79981E-03_JPRB, 4.40586E-03_JPRB, 5.10855E-03_JPRB, &
+     & 5.92333E-03_JPRB, 6.86806E-03_JPRB, 7.96346E-03_JPRB, 9.23357E-03_JPRB/)
+      KAO_MCO2( 3, :, 6) = (/ &
+     & 1.11336E-03_JPRB, 1.26910E-03_JPRB, 1.44662E-03_JPRB, 1.64897E-03_JPRB, 1.87962E-03_JPRB, &
+     & 2.14254E-03_JPRB, 2.44224E-03_JPRB, 2.78385E-03_JPRB, 3.17325E-03_JPRB, 3.61712E-03_JPRB, &
+     & 4.12308E-03_JPRB, 4.69981E-03_JPRB, 5.35720E-03_JPRB, 6.10656E-03_JPRB, 6.96073E-03_JPRB, &
+     & 7.93439E-03_JPRB, 9.04424E-03_JPRB, 1.03093E-02_JPRB, 1.17514E-02_JPRB/)
+      KAO_MCO2( 4, :, 6) = (/ &
+     & 1.87991E-03_JPRB, 2.10276E-03_JPRB, 2.35202E-03_JPRB, 2.63082E-03_JPRB, 2.94268E-03_JPRB, &
+     & 3.29150E-03_JPRB, 3.68168E-03_JPRB, 4.11810E-03_JPRB, 4.60626E-03_JPRB, 5.15228E-03_JPRB, &
+     & 5.76303E-03_JPRB, 6.44617E-03_JPRB, 7.21030E-03_JPRB, 8.06500E-03_JPRB, 9.02102E-03_JPRB, &
+     & 1.00904E-02_JPRB, 1.12865E-02_JPRB, 1.26244E-02_JPRB, 1.41208E-02_JPRB/)
+      KAO_MCO2( 5, :, 6) = (/ &
+     & 3.65848E-03_JPRB, 4.01372E-03_JPRB, 4.40346E-03_JPRB, 4.83104E-03_JPRB, 5.30015E-03_JPRB, &
+     & 5.81480E-03_JPRB, 6.37943E-03_JPRB, 6.99888E-03_JPRB, 7.67849E-03_JPRB, 8.42408E-03_JPRB, &
+     & 9.24208E-03_JPRB, 1.01395E-02_JPRB, 1.11241E-02_JPRB, 1.22042E-02_JPRB, 1.33893E-02_JPRB, &
+     & 1.46894E-02_JPRB, 1.61158E-02_JPRB, 1.76806E-02_JPRB, 1.93975E-02_JPRB/)
+      KAO_MCO2( 6, :, 6) = (/ &
+     & 5.38476E-03_JPRB, 5.85088E-03_JPRB, 6.35735E-03_JPRB, 6.90765E-03_JPRB, 7.50560E-03_JPRB, &
+     & 8.15530E-03_JPRB, 8.86124E-03_JPRB, 9.62829E-03_JPRB, 1.04617E-02_JPRB, 1.13673E-02_JPRB, &
+     & 1.23513E-02_JPRB, 1.34205E-02_JPRB, 1.45822E-02_JPRB, 1.58445E-02_JPRB, 1.72160E-02_JPRB, &
+     & 1.87062E-02_JPRB, 2.03255E-02_JPRB, 2.20849E-02_JPRB, 2.39966E-02_JPRB/)
+      KAO_MCO2( 7, :, 6) = (/ &
+     & 6.27017E-03_JPRB, 6.84772E-03_JPRB, 7.47846E-03_JPRB, 8.16731E-03_JPRB, 8.91960E-03_JPRB, &
+     & 9.74118E-03_JPRB, 1.06384E-02_JPRB, 1.16183E-02_JPRB, 1.26885E-02_JPRB, 1.38573E-02_JPRB, &
+     & 1.51336E-02_JPRB, 1.65276E-02_JPRB, 1.80500E-02_JPRB, 1.97125E-02_JPRB, 2.15283E-02_JPRB, &
+     & 2.35112E-02_JPRB, 2.56769E-02_JPRB, 2.80420E-02_JPRB, 3.06249E-02_JPRB/)
+      KAO_MCO2( 8, :, 6) = (/ &
+     & 9.61932E-03_JPRB, 1.04802E-02_JPRB, 1.14182E-02_JPRB, 1.24401E-02_JPRB, 1.35534E-02_JPRB, &
+     & 1.47664E-02_JPRB, 1.60880E-02_JPRB, 1.75278E-02_JPRB, 1.90965E-02_JPRB, 2.08056E-02_JPRB, &
+     & 2.26677E-02_JPRB, 2.46964E-02_JPRB, 2.69066E-02_JPRB, 2.93147E-02_JPRB, 3.19383E-02_JPRB, &
+     & 3.47967E-02_JPRB, 3.79110E-02_JPRB, 4.13039E-02_JPRB, 4.50005E-02_JPRB/)
+      KAO_MCO2( 9, :, 6) = (/ &
+     & 2.37921E-03_JPRB, 2.64556E-03_JPRB, 2.94173E-03_JPRB, 3.27105E-03_JPRB, 3.63724E-03_JPRB, &
+     & 4.04442E-03_JPRB, 4.49718E-03_JPRB, 5.00064E-03_JPRB, 5.56045E-03_JPRB, 6.18293E-03_JPRB, &
+     & 6.87510E-03_JPRB, 7.64475E-03_JPRB, 8.50057E-03_JPRB, 9.45219E-03_JPRB, 1.05103E-02_JPRB, &
+     & 1.16870E-02_JPRB, 1.29953E-02_JPRB, 1.44501E-02_JPRB, 1.60677E-02_JPRB/)
+      KAO_MCO2( 1, :, 7) = (/ &
+     & 4.64970E-03_JPRB, 5.13188E-03_JPRB, 5.66406E-03_JPRB, 6.25144E-03_JPRB, 6.89972E-03_JPRB, &
+     & 7.61523E-03_JPRB, 8.40493E-03_JPRB, 9.27654E-03_JPRB, 1.02385E-02_JPRB, 1.13003E-02_JPRB, &
+     & 1.24721E-02_JPRB, 1.37655E-02_JPRB, 1.51930E-02_JPRB, 1.67685E-02_JPRB, 1.85075E-02_JPRB, &
+     & 2.04267E-02_JPRB, 2.25450E-02_JPRB, 2.48829E-02_JPRB, 2.74633E-02_JPRB/)
+      KAO_MCO2( 2, :, 7) = (/ &
+     & 6.37148E-03_JPRB, 6.96805E-03_JPRB, 7.62046E-03_JPRB, 8.33397E-03_JPRB, 9.11428E-03_JPRB, &
+     & 9.96765E-03_JPRB, 1.09009E-02_JPRB, 1.19216E-02_JPRB, 1.30378E-02_JPRB, 1.42585E-02_JPRB, &
+     & 1.55935E-02_JPRB, 1.70536E-02_JPRB, 1.86503E-02_JPRB, 2.03965E-02_JPRB, 2.23062E-02_JPRB, &
+     & 2.43948E-02_JPRB, 2.66789E-02_JPRB, 2.91768E-02_JPRB, 3.19086E-02_JPRB/)
+      KAO_MCO2( 3, :, 7) = (/ &
+     & 7.79364E-03_JPRB, 8.48097E-03_JPRB, 9.22892E-03_JPRB, 1.00428E-02_JPRB, 1.09285E-02_JPRB, &
+     & 1.18923E-02_JPRB, 1.29411E-02_JPRB, 1.40825E-02_JPRB, 1.53244E-02_JPRB, 1.66759E-02_JPRB, &
+     & 1.81466E-02_JPRB, 1.97470E-02_JPRB, 2.14885E-02_JPRB, 2.33836E-02_JPRB, 2.54458E-02_JPRB, &
+     & 2.76899E-02_JPRB, 3.01320E-02_JPRB, 3.27893E-02_JPRB, 3.56811E-02_JPRB/)
+      KAO_MCO2( 4, :, 7) = (/ &
+     & 8.70586E-03_JPRB, 9.48737E-03_JPRB, 1.03390E-02_JPRB, 1.12672E-02_JPRB, 1.22786E-02_JPRB, &
+     & 1.33808E-02_JPRB, 1.45820E-02_JPRB, 1.58910E-02_JPRB, 1.73175E-02_JPRB, 1.88721E-02_JPRB, &
+     & 2.05662E-02_JPRB, 2.24124E-02_JPRB, 2.44243E-02_JPRB, 2.66169E-02_JPRB, 2.90062E-02_JPRB, &
+     & 3.16101E-02_JPRB, 3.44477E-02_JPRB, 3.75400E-02_JPRB, 4.09099E-02_JPRB/)
+      KAO_MCO2( 5, :, 7) = (/ &
+     & 9.24510E-03_JPRB, 1.00865E-02_JPRB, 1.10045E-02_JPRB, 1.20061E-02_JPRB, 1.30988E-02_JPRB, &
+     & 1.42910E-02_JPRB, 1.55916E-02_JPRB, 1.70106E-02_JPRB, 1.85588E-02_JPRB, 2.02479E-02_JPRB, &
+     & 2.20908E-02_JPRB, 2.41013E-02_JPRB, 2.62948E-02_JPRB, 2.86880E-02_JPRB, 3.12990E-02_JPRB, &
+     & 3.41476E-02_JPRB, 3.72555E-02_JPRB, 4.06462E-02_JPRB, 4.43455E-02_JPRB/)
+      KAO_MCO2( 6, :, 7) = (/ &
+     & 1.09559E-02_JPRB, 1.19933E-02_JPRB, 1.31290E-02_JPRB, 1.43722E-02_JPRB, 1.57331E-02_JPRB, &
+     & 1.72229E-02_JPRB, 1.88537E-02_JPRB, 2.06390E-02_JPRB, 2.25933E-02_JPRB, 2.47327E-02_JPRB, &
+     & 2.70747E-02_JPRB, 2.96384E-02_JPRB, 3.24449E-02_JPRB, 3.55171E-02_JPRB, 3.88802E-02_JPRB, &
+     & 4.25619E-02_JPRB, 4.65921E-02_JPRB, 5.10039E-02_JPRB, 5.58335E-02_JPRB/)
+      KAO_MCO2( 7, :, 7) = (/ &
+     & 1.36116E-02_JPRB, 1.48659E-02_JPRB, 1.62357E-02_JPRB, 1.77318E-02_JPRB, 1.93657E-02_JPRB, &
+     & 2.11502E-02_JPRB, 2.30991E-02_JPRB, 2.52276E-02_JPRB, 2.75522E-02_JPRB, 3.00910E-02_JPRB, &
+     & 3.28638E-02_JPRB, 3.58921E-02_JPRB, 3.91995E-02_JPRB, 4.28116E-02_JPRB, 4.67565E-02_JPRB, &
+     & 5.10650E-02_JPRB, 5.57704E-02_JPRB, 6.09095E-02_JPRB, 6.65221E-02_JPRB/)
+      KAO_MCO2( 8, :, 7) = (/ &
+     & 1.51783E-02_JPRB, 1.64551E-02_JPRB, 1.78392E-02_JPRB, 1.93399E-02_JPRB, 2.09667E-02_JPRB, &
+     & 2.27304E-02_JPRB, 2.46424E-02_JPRB, 2.67153E-02_JPRB, 2.89626E-02_JPRB, 3.13988E-02_JPRB, &
+     & 3.40401E-02_JPRB, 3.69035E-02_JPRB, 4.00077E-02_JPRB, 4.33731E-02_JPRB, 4.70216E-02_JPRB, &
+     & 5.09770E-02_JPRB, 5.52651E-02_JPRB, 5.99139E-02_JPRB, 6.49538E-02_JPRB/)
+      KAO_MCO2( 9, :, 7) = (/ &
+     & 1.00072E-02_JPRB, 1.08638E-02_JPRB, 1.17937E-02_JPRB, 1.28032E-02_JPRB, 1.38991E-02_JPRB, &
+     & 1.50888E-02_JPRB, 1.63803E-02_JPRB, 1.77824E-02_JPRB, 1.93045E-02_JPRB, 2.09568E-02_JPRB, &
+     & 2.27507E-02_JPRB, 2.46980E-02_JPRB, 2.68120E-02_JPRB, 2.91070E-02_JPRB, 3.15984E-02_JPRB, &
+     & 3.43031E-02_JPRB, 3.72393E-02_JPRB, 4.04268E-02_JPRB, 4.38872E-02_JPRB/)
+      KAO_MCO2( 1, :, 8) = (/ &
+     & 1.59610E-02_JPRB, 1.74387E-02_JPRB, 1.90532E-02_JPRB, 2.08171E-02_JPRB, 2.27444E-02_JPRB, &
+     & 2.48501E-02_JPRB, 2.71508E-02_JPRB, 2.96645E-02_JPRB, 3.24109E-02_JPRB, 3.54115E-02_JPRB, &
+     & 3.86900E-02_JPRB, 4.22720E-02_JPRB, 4.61856E-02_JPRB, 5.04616E-02_JPRB, 5.51334E-02_JPRB, &
+     & 6.02378E-02_JPRB, 6.58147E-02_JPRB, 7.19079E-02_JPRB, 7.85653E-02_JPRB/)
+      KAO_MCO2( 2, :, 8) = (/ &
+     & 1.61961E-02_JPRB, 1.76986E-02_JPRB, 1.93405E-02_JPRB, 2.11348E-02_JPRB, 2.30955E-02_JPRB, &
+     & 2.52381E-02_JPRB, 2.75794E-02_JPRB, 3.01380E-02_JPRB, 3.29340E-02_JPRB, 3.59893E-02_JPRB, &
+     & 3.93280E-02_JPRB, 4.29766E-02_JPRB, 4.69636E-02_JPRB, 5.13204E-02_JPRB, 5.60815E-02_JPRB, &
+     & 6.12843E-02_JPRB, 6.69697E-02_JPRB, 7.31826E-02_JPRB, 7.99718E-02_JPRB/)
+      KAO_MCO2( 3, :, 8) = (/ &
+     & 1.72034E-02_JPRB, 1.88241E-02_JPRB, 2.05974E-02_JPRB, 2.25377E-02_JPRB, 2.46609E-02_JPRB, &
+     & 2.69841E-02_JPRB, 2.95261E-02_JPRB, 3.23076E-02_JPRB, 3.53511E-02_JPRB, 3.86813E-02_JPRB, &
+     & 4.23253E-02_JPRB, 4.63126E-02_JPRB, 5.06754E-02_JPRB, 5.54493E-02_JPRB, 6.06728E-02_JPRB, &
+     & 6.63885E-02_JPRB, 7.26426E-02_JPRB, 7.94859E-02_JPRB, 8.69738E-02_JPRB/)
+      KAO_MCO2( 4, :, 8) = (/ &
+     & 1.79777E-02_JPRB, 1.96517E-02_JPRB, 2.14815E-02_JPRB, 2.34817E-02_JPRB, 2.56682E-02_JPRB, &
+     & 2.80583E-02_JPRB, 3.06709E-02_JPRB, 3.35268E-02_JPRB, 3.66486E-02_JPRB, 4.00611E-02_JPRB, &
+     & 4.37914E-02_JPRB, 4.78690E-02_JPRB, 5.23262E-02_JPRB, 5.71985E-02_JPRB, 6.25245E-02_JPRB, &
+     & 6.83464E-02_JPRB, 7.47104E-02_JPRB, 8.16670E-02_JPRB, 8.92713E-02_JPRB/)
+      KAO_MCO2( 5, :, 8) = (/ &
+     & 2.02540E-02_JPRB, 2.21214E-02_JPRB, 2.41610E-02_JPRB, 2.63887E-02_JPRB, 2.88218E-02_JPRB, &
+     & 3.14792E-02_JPRB, 3.43816E-02_JPRB, 3.75516E-02_JPRB, 4.10139E-02_JPRB, 4.47954E-02_JPRB, &
+     & 4.89256E-02_JPRB, 5.34366E-02_JPRB, 5.83635E-02_JPRB, 6.37447E-02_JPRB, 6.96220E-02_JPRB, &
+     & 7.60413E-02_JPRB, 8.30523E-02_JPRB, 9.07098E-02_JPRB, 9.90734E-02_JPRB/)
+      KAO_MCO2( 6, :, 8) = (/ &
+     & 2.19009E-02_JPRB, 2.38517E-02_JPRB, 2.59762E-02_JPRB, 2.82899E-02_JPRB, 3.08097E-02_JPRB, &
+     & 3.35540E-02_JPRB, 3.65427E-02_JPRB, 3.97976E-02_JPRB, 4.33424E-02_JPRB, 4.72030E-02_JPRB, &
+     & 5.14074E-02_JPRB, 5.59863E-02_JPRB, 6.09731E-02_JPRB, 6.64040E-02_JPRB, 7.23187E-02_JPRB, &
+     & 7.87603E-02_JPRB, 8.57755E-02_JPRB, 9.34157E-02_JPRB, 1.01736E-01_JPRB/)
+      KAO_MCO2( 7, :, 8) = (/ &
+     & 2.52383E-02_JPRB, 2.73978E-02_JPRB, 2.97421E-02_JPRB, 3.22869E-02_JPRB, 3.50496E-02_JPRB, &
+     & 3.80486E-02_JPRB, 4.13042E-02_JPRB, 4.48383E-02_JPRB, 4.86749E-02_JPRB, 5.28397E-02_JPRB, &
+     & 5.73610E-02_JPRB, 6.22690E-02_JPRB, 6.75970E-02_JPRB, 7.33810E-02_JPRB, 7.96598E-02_JPRB, &
+     & 8.64758E-02_JPRB, 9.38751E-02_JPRB, 1.01907E-01_JPRB, 1.10627E-01_JPRB/)
+      KAO_MCO2( 8, :, 8) = (/ &
+     & 3.36506E-02_JPRB, 3.59288E-02_JPRB, 3.83613E-02_JPRB, 4.09584E-02_JPRB, 4.37313E-02_JPRB, &
+     & 4.66920E-02_JPRB, 4.98531E-02_JPRB, 5.32283E-02_JPRB, 5.68319E-02_JPRB, 6.06795E-02_JPRB, &
+     & 6.47876E-02_JPRB, 6.91739E-02_JPRB, 7.38570E-02_JPRB, 7.88573E-02_JPRB, 8.41960E-02_JPRB, &
+     & 8.98962E-02_JPRB, 9.59824E-02_JPRB, 1.02481E-01_JPRB, 1.09419E-01_JPRB/)
+      KAO_MCO2( 9, :, 8) = (/ &
+     & 2.15151E-02_JPRB, 2.34420E-02_JPRB, 2.55415E-02_JPRB, 2.78291E-02_JPRB, 3.03215E-02_JPRB, &
+     & 3.30372E-02_JPRB, 3.59961E-02_JPRB, 3.92200E-02_JPRB, 4.27326E-02_JPRB, 4.65598E-02_JPRB, &
+     & 5.07299E-02_JPRB, 5.52734E-02_JPRB, 6.02238E-02_JPRB, 6.56176E-02_JPRB, 7.14944E-02_JPRB, &
+     & 7.78977E-02_JPRB, 8.48744E-02_JPRB, 9.24759E-02_JPRB, 1.00758E-01_JPRB/)
+      KAO_MCO2( 1, :, 9) = (/ &
+     & 3.34296E-02_JPRB, 3.64437E-02_JPRB, 3.97294E-02_JPRB, 4.33114E-02_JPRB, 4.72164E-02_JPRB, &
+     & 5.14734E-02_JPRB, 5.61143E-02_JPRB, 6.11735E-02_JPRB, 6.66890E-02_JPRB, 7.27016E-02_JPRB, &
+     & 7.92564E-02_JPRB, 8.64022E-02_JPRB, 9.41922E-02_JPRB, 1.02685E-01_JPRB, 1.11943E-01_JPRB, &
+     & 1.22035E-01_JPRB, 1.33038E-01_JPRB, 1.45033E-01_JPRB, 1.58109E-01_JPRB/)
+      KAO_MCO2( 2, :, 9) = (/ &
+     & 3.73946E-02_JPRB, 4.07543E-02_JPRB, 4.44160E-02_JPRB, 4.84066E-02_JPRB, 5.27558E-02_JPRB, &
+     & 5.74958E-02_JPRB, 6.26616E-02_JPRB, 6.82915E-02_JPRB, 7.44273E-02_JPRB, 8.11144E-02_JPRB, &
+     & 8.84023E-02_JPRB, 9.63449E-02_JPRB, 1.05001E-01_JPRB, 1.14435E-01_JPRB, 1.24717E-01_JPRB, &
+     & 1.35922E-01_JPRB, 1.48135E-01_JPRB, 1.61444E-01_JPRB, 1.75949E-01_JPRB/)
+      KAO_MCO2( 3, :, 9) = (/ &
+     & 4.24539E-02_JPRB, 4.61192E-02_JPRB, 5.01010E-02_JPRB, 5.44265E-02_JPRB, 5.91255E-02_JPRB, &
+     & 6.42302E-02_JPRB, 6.97756E-02_JPRB, 7.57998E-02_JPRB, 8.23442E-02_JPRB, 8.94535E-02_JPRB, &
+     & 9.71766E-02_JPRB, 1.05566E-01_JPRB, 1.14681E-01_JPRB, 1.24582E-01_JPRB, 1.35338E-01_JPRB, &
+     & 1.47022E-01_JPRB, 1.59716E-01_JPRB, 1.73505E-01_JPRB, 1.88485E-01_JPRB/)
+      KAO_MCO2( 4, :, 9) = (/ &
+     & 5.30296E-02_JPRB, 5.73416E-02_JPRB, 6.20043E-02_JPRB, 6.70462E-02_JPRB, 7.24980E-02_JPRB, &
+     & 7.83931E-02_JPRB, 8.47676E-02_JPRB, 9.16604E-02_JPRB, 9.91137E-02_JPRB, 1.07173E-01_JPRB, &
+     & 1.15888E-01_JPRB, 1.25311E-01_JPRB, 1.35501E-01_JPRB, 1.46519E-01_JPRB, 1.58433E-01_JPRB, &
+     & 1.71316E-01_JPRB, 1.85246E-01_JPRB, 2.00309E-01_JPRB, 2.16597E-01_JPRB/)
+      KAO_MCO2( 5, :, 9) = (/ &
+     & 6.26111E-02_JPRB, 6.74018E-02_JPRB, 7.25591E-02_JPRB, 7.81111E-02_JPRB, 8.40878E-02_JPRB, &
+     & 9.05218E-02_JPRB, 9.74482E-02_JPRB, 1.04904E-01_JPRB, 1.12931E-01_JPRB, 1.21572E-01_JPRB, &
+     & 1.30875E-01_JPRB, 1.40889E-01_JPRB, 1.51669E-01_JPRB, 1.63274E-01_JPRB, 1.75767E-01_JPRB, &
+     & 1.89216E-01_JPRB, 2.03694E-01_JPRB, 2.19279E-01_JPRB, 2.36058E-01_JPRB/)
+      KAO_MCO2( 6, :, 9) = (/ &
+     & 7.59080E-02_JPRB, 8.13446E-02_JPRB, 8.71706E-02_JPRB, 9.34139E-02_JPRB, 1.00104E-01_JPRB, &
+     & 1.07274E-01_JPRB, 1.14957E-01_JPRB, 1.23190E-01_JPRB, 1.32013E-01_JPRB, 1.41468E-01_JPRB, &
+     & 1.51600E-01_JPRB, 1.62458E-01_JPRB, 1.74094E-01_JPRB, 1.86562E-01_JPRB, 1.99924E-01_JPRB, &
+     & 2.14243E-01_JPRB, 2.29587E-01_JPRB, 2.46031E-01_JPRB, 2.63652E-01_JPRB/)
+      KAO_MCO2( 7, :, 9) = (/ &
+     & 8.81942E-02_JPRB, 9.39942E-02_JPRB, 1.00176E-01_JPRB, 1.06763E-01_JPRB, 1.13784E-01_JPRB, &
+     & 1.21267E-01_JPRB, 1.29242E-01_JPRB, 1.37742E-01_JPRB, 1.46800E-01_JPRB, 1.56454E-01_JPRB, &
+     & 1.66743E-01_JPRB, 1.77708E-01_JPRB, 1.89395E-01_JPRB, 2.01850E-01_JPRB, 2.15124E-01_JPRB, &
+     & 2.29272E-01_JPRB, 2.44349E-01_JPRB, 2.60418E-01_JPRB, 2.77544E-01_JPRB/)
+      KAO_MCO2( 8, :, 9) = (/ &
+     & 6.28535E-02_JPRB, 6.69314E-02_JPRB, 7.12740E-02_JPRB, 7.58982E-02_JPRB, 8.08225E-02_JPRB, &
+     & 8.60662E-02_JPRB, 9.16502E-02_JPRB, 9.75965E-02_JPRB, 1.03929E-01_JPRB, 1.10671E-01_JPRB, &
+     & 1.17852E-01_JPRB, 1.25498E-01_JPRB, 1.33640E-01_JPRB, 1.42311E-01_JPRB, 1.51544E-01_JPRB, &
+     & 1.61376E-01_JPRB, 1.71846E-01_JPRB, 1.82996E-01_JPRB, 1.94868E-01_JPRB/)
+      KAO_MCO2( 9, :, 9) = (/ &
+     & 6.39196E-02_JPRB, 6.86702E-02_JPRB, 7.37738E-02_JPRB, 7.92568E-02_JPRB, 8.51473E-02_JPRB, &
+     & 9.14756E-02_JPRB, 9.82742E-02_JPRB, 1.05578E-01_JPRB, 1.13425E-01_JPRB, 1.21855E-01_JPRB, &
+     & 1.30911E-01_JPRB, 1.40641E-01_JPRB, 1.51093E-01_JPRB, 1.62323E-01_JPRB, 1.74387E-01_JPRB, &
+     & 1.87348E-01_JPRB, 2.01272E-01_JPRB, 2.16231E-01_JPRB, 2.32301E-01_JPRB/)
+      KAO_MCO2( 1, :,10) = (/ &
+     & 9.44086E-02_JPRB, 1.02788E-01_JPRB, 1.11911E-01_JPRB, 1.21844E-01_JPRB, 1.32659E-01_JPRB, &
+     & 1.44434E-01_JPRB, 1.57253E-01_JPRB, 1.71211E-01_JPRB, 1.86407E-01_JPRB, 2.02952E-01_JPRB, &
+     & 2.20966E-01_JPRB, 2.40578E-01_JPRB, 2.61932E-01_JPRB, 2.85180E-01_JPRB, 3.10492E-01_JPRB, &
+     & 3.38051E-01_JPRB, 3.68056E-01_JPRB, 4.00723E-01_JPRB, 4.36291E-01_JPRB/)
+      KAO_MCO2( 2, :,10) = (/ &
+     & 1.29528E-01_JPRB, 1.39646E-01_JPRB, 1.50554E-01_JPRB, 1.62315E-01_JPRB, 1.74994E-01_JPRB, &
+     & 1.88664E-01_JPRB, 2.03401E-01_JPRB, 2.19290E-01_JPRB, 2.36419E-01_JPRB, 2.54887E-01_JPRB, &
+     & 2.74798E-01_JPRB, 2.96263E-01_JPRB, 3.19406E-01_JPRB, 3.44356E-01_JPRB, 3.71255E-01_JPRB, &
+     & 4.00256E-01_JPRB, 4.31522E-01_JPRB, 4.65230E-01_JPRB, 5.01571E-01_JPRB/)
+      KAO_MCO2( 3, :,10) = (/ &
+     & 1.52325E-01_JPRB, 1.62991E-01_JPRB, 1.74404E-01_JPRB, 1.86616E-01_JPRB, 1.99684E-01_JPRB, &
+     & 2.13666E-01_JPRB, 2.28628E-01_JPRB, 2.44637E-01_JPRB, 2.61767E-01_JPRB, 2.80096E-01_JPRB, &
+     & 2.99710E-01_JPRB, 3.20696E-01_JPRB, 3.43152E-01_JPRB, 3.67181E-01_JPRB, 3.92892E-01_JPRB, &
+     & 4.20403E-01_JPRB, 4.49841E-01_JPRB, 4.81340E-01_JPRB, 5.15045E-01_JPRB/)
+      KAO_MCO2( 4, :,10) = (/ &
+     & 1.59763E-01_JPRB, 1.70378E-01_JPRB, 1.81698E-01_JPRB, 1.93770E-01_JPRB, 2.06644E-01_JPRB, &
+     & 2.20373E-01_JPRB, 2.35015E-01_JPRB, 2.50629E-01_JPRB, 2.67281E-01_JPRB, 2.85039E-01_JPRB, &
+     & 3.03977E-01_JPRB, 3.24174E-01_JPRB, 3.45712E-01_JPRB, 3.68681E-01_JPRB, 3.93176E-01_JPRB, &
+     & 4.19299E-01_JPRB, 4.47157E-01_JPRB, 4.76866E-01_JPRB, 5.08549E-01_JPRB/)
+      KAO_MCO2( 5, :,10) = (/ &
+     & 1.79202E-01_JPRB, 1.91125E-01_JPRB, 2.03840E-01_JPRB, 2.17402E-01_JPRB, 2.31866E-01_JPRB, &
+     & 2.47292E-01_JPRB, 2.63744E-01_JPRB, 2.81291E-01_JPRB, 3.00005E-01_JPRB, 3.19964E-01_JPRB, &
+     & 3.41251E-01_JPRB, 3.63955E-01_JPRB, 3.88169E-01_JPRB, 4.13994E-01_JPRB, 4.41537E-01_JPRB, &
+     & 4.70912E-01_JPRB, 5.02242E-01_JPRB, 5.35656E-01_JPRB, 5.71293E-01_JPRB/)
+      KAO_MCO2( 6, :,10) = (/ &
+     & 1.66628E-01_JPRB, 1.76984E-01_JPRB, 1.87984E-01_JPRB, 1.99668E-01_JPRB, 2.12078E-01_JPRB, &
+     & 2.25259E-01_JPRB, 2.39259E-01_JPRB, 2.54129E-01_JPRB, 2.69924E-01_JPRB, 2.86700E-01_JPRB, &
+     & 3.04519E-01_JPRB, 3.23446E-01_JPRB, 3.43549E-01_JPRB, 3.64901E-01_JPRB, 3.87580E-01_JPRB, &
+     & 4.11669E-01_JPRB, 4.37255E-01_JPRB, 4.64431E-01_JPRB, 4.93297E-01_JPRB/)
+      KAO_MCO2( 7, :,10) = (/ &
+     & 2.03980E-01_JPRB, 2.17141E-01_JPRB, 2.31152E-01_JPRB, 2.46067E-01_JPRB, 2.61945E-01_JPRB, &
+     & 2.78847E-01_JPRB, 2.96839E-01_JPRB, 3.15993E-01_JPRB, 3.36382E-01_JPRB, 3.58087E-01_JPRB, &
+     & 3.81193E-01_JPRB, 4.05789E-01_JPRB, 4.31972E-01_JPRB, 4.59845E-01_JPRB, 4.89517E-01_JPRB, &
+     & 5.21103E-01_JPRB, 5.54727E-01_JPRB, 5.90520E-01_JPRB, 6.28623E-01_JPRB/)
+      KAO_MCO2( 8, :,10) = (/ &
+     & 1.96161E-04_JPRB, 2.07177E-04_JPRB, 2.18812E-04_JPRB, 2.31101E-04_JPRB, 2.44079E-04_JPRB, &
+     & 2.57787E-04_JPRB, 2.72264E-04_JPRB, 2.87554E-04_JPRB, 3.03703E-04_JPRB, 3.20758E-04_JPRB, &
+     & 3.38772E-04_JPRB, 3.57797E-04_JPRB, 3.77891E-04_JPRB, 3.99113E-04_JPRB, 4.21527E-04_JPRB, &
+     & 4.45200E-04_JPRB, 4.70202E-04_JPRB, 4.96608E-04_JPRB, 5.24498E-04_JPRB/)
+      KAO_MCO2( 9, :,10) = (/ &
+     & 1.76275E-01_JPRB, 1.88091E-01_JPRB, 2.00699E-01_JPRB, 2.14152E-01_JPRB, 2.28507E-01_JPRB, &
+     & 2.43824E-01_JPRB, 2.60168E-01_JPRB, 2.77607E-01_JPRB, 2.96216E-01_JPRB, 3.16071E-01_JPRB, &
+     & 3.37258E-01_JPRB, 3.59865E-01_JPRB, 3.83987E-01_JPRB, 4.09726E-01_JPRB, 4.37190E-01_JPRB, &
+     & 4.66495E-01_JPRB, 4.97765E-01_JPRB, 5.31131E-01_JPRB, 5.66733E-01_JPRB/)
+      KAO_MCO2( 1, :,11) = (/ &
+     & 1.99797E-01_JPRB, 2.14154E-01_JPRB, 2.29543E-01_JPRB, 2.46038E-01_JPRB, 2.63718E-01_JPRB, &
+     & 2.82669E-01_JPRB, 3.02981E-01_JPRB, 3.24753E-01_JPRB, 3.48090E-01_JPRB, 3.73104E-01_JPRB, &
+     & 3.99915E-01_JPRB, 4.28652E-01_JPRB, 4.59455E-01_JPRB, 4.92471E-01_JPRB, 5.27859E-01_JPRB, &
+     & 5.65791E-01_JPRB, 6.06448E-01_JPRB, 6.50027E-01_JPRB, 6.96738E-01_JPRB/)
+      KAO_MCO2( 2, :,11) = (/ &
+     & 2.20638E-01_JPRB, 2.35685E-01_JPRB, 2.51759E-01_JPRB, 2.68929E-01_JPRB, 2.87271E-01_JPRB, &
+     & 3.06863E-01_JPRB, 3.27791E-01_JPRB, 3.50146E-01_JPRB, 3.74026E-01_JPRB, 3.99535E-01_JPRB, &
+     & 4.26784E-01_JPRB, 4.55891E-01_JPRB, 4.86983E-01_JPRB, 5.20195E-01_JPRB, 5.55673E-01_JPRB, &
+     & 5.93570E-01_JPRB, 6.34052E-01_JPRB, 6.77294E-01_JPRB, 7.23486E-01_JPRB/)
+      KAO_MCO2( 3, :,11) = (/ &
+     & 2.62988E-01_JPRB, 2.80924E-01_JPRB, 3.00085E-01_JPRB, 3.20552E-01_JPRB, 3.42414E-01_JPRB, &
+     & 3.65768E-01_JPRB, 3.90715E-01_JPRB, 4.17363E-01_JPRB, 4.45829E-01_JPRB, 4.76237E-01_JPRB, &
+     & 5.08718E-01_JPRB, 5.43414E-01_JPRB, 5.80477E-01_JPRB, 6.20068E-01_JPRB, 6.62359E-01_JPRB, &
+     & 7.07535E-01_JPRB, 7.55791E-01_JPRB, 8.07339E-01_JPRB, 8.62403E-01_JPRB/)
+      KAO_MCO2( 4, :,11) = (/ &
+     & 2.43674E-01_JPRB, 2.59946E-01_JPRB, 2.77304E-01_JPRB, 2.95821E-01_JPRB, 3.15575E-01_JPRB, &
+     & 3.36647E-01_JPRB, 3.59127E-01_JPRB, 3.83108E-01_JPRB, 4.08691E-01_JPRB, 4.35981E-01_JPRB, &
+     & 4.65094E-01_JPRB, 4.96152E-01_JPRB, 5.29282E-01_JPRB, 5.64626E-01_JPRB, 6.02329E-01_JPRB, &
+     & 6.42550E-01_JPRB, 6.85457E-01_JPRB, 7.31229E-01_JPRB, 7.80057E-01_JPRB/)
+      KAO_MCO2( 5, :,11) = (/ &
+     & 2.23323E-01_JPRB, 2.37553E-01_JPRB, 2.52689E-01_JPRB, 2.68791E-01_JPRB, 2.85918E-01_JPRB, &
+     & 3.04136E-01_JPRB, 3.23515E-01_JPRB, 3.44129E-01_JPRB, 3.66057E-01_JPRB, 3.89381E-01_JPRB, &
+     & 4.14192E-01_JPRB, 4.40584E-01_JPRB, 4.68657E-01_JPRB, 4.98520E-01_JPRB, 5.30285E-01_JPRB, &
+     & 5.64074E-01_JPRB, 6.00016E-01_JPRB, 6.38248E-01_JPRB, 6.78917E-01_JPRB/)
+      KAO_MCO2( 6, :,11) = (/ &
+     & 2.83716E-01_JPRB, 3.02622E-01_JPRB, 3.22788E-01_JPRB, 3.44298E-01_JPRB, 3.67241E-01_JPRB, &
+     & 3.91713E-01_JPRB, 4.17816E-01_JPRB, 4.45658E-01_JPRB, 4.75356E-01_JPRB, 5.07033E-01_JPRB, &
+     & 5.40820E-01_JPRB, 5.76859E-01_JPRB, 6.15300E-01_JPRB, 6.56302E-01_JPRB, 7.00037E-01_JPRB, &
+     & 7.46686E-01_JPRB, 7.96443E-01_JPRB, 8.49516E-01_JPRB, 9.06126E-01_JPRB/)
+      KAO_MCO2( 7, :,11) = (/ &
+     & 1.00497E-03_JPRB, 1.06500E-03_JPRB, 1.12863E-03_JPRB, 1.19606E-03_JPRB, 1.26751E-03_JPRB, &
+     & 1.34323E-03_JPRB, 1.42348E-03_JPRB, 1.50852E-03_JPRB, 1.59864E-03_JPRB, 1.69414E-03_JPRB, &
+     & 1.79535E-03_JPRB, 1.90261E-03_JPRB, 2.01628E-03_JPRB, 2.13673E-03_JPRB, 2.26438E-03_JPRB, &
+     & 2.39966E-03_JPRB, 2.54302E-03_JPRB, 2.69494E-03_JPRB, 2.85594E-03_JPRB/)
+      KAO_MCO2( 8, :,11) = (/ &
+     & 3.22623E-04_JPRB, 3.39937E-04_JPRB, 3.58181E-04_JPRB, 3.77404E-04_JPRB, 3.97658E-04_JPRB, &
+     & 4.19000E-04_JPRB, 4.41487E-04_JPRB, 4.65180E-04_JPRB, 4.90146E-04_JPRB, 5.16451E-04_JPRB, &
+     & 5.44167E-04_JPRB, 5.73372E-04_JPRB, 6.04143E-04_JPRB, 6.36567E-04_JPRB, 6.70730E-04_JPRB, &
+     & 7.06726E-04_JPRB, 7.44655E-04_JPRB, 7.84619E-04_JPRB, 8.26727E-04_JPRB/)
+      KAO_MCO2( 9, :,11) = (/ &
+     & 2.23872E-01_JPRB, 2.38360E-01_JPRB, 2.53786E-01_JPRB, 2.70210E-01_JPRB, 2.87697E-01_JPRB, &
+     & 3.06316E-01_JPRB, 3.26140E-01_JPRB, 3.47247E-01_JPRB, 3.69720E-01_JPRB, 3.93647E-01_JPRB, &
+     & 4.19122E-01_JPRB, 4.46246E-01_JPRB, 4.75126E-01_JPRB, 5.05874E-01_JPRB, 5.38613E-01_JPRB, &
+     & 5.73470E-01_JPRB, 6.10583E-01_JPRB, 6.50098E-01_JPRB, 6.92170E-01_JPRB/)
+      KAO_MCO2( 1, :,12) = (/ &
+     & 3.52418E-01_JPRB, 3.76085E-01_JPRB, 4.01341E-01_JPRB, 4.28293E-01_JPRB, 4.57055E-01_JPRB, &
+     & 4.87749E-01_JPRB, 5.20504E-01_JPRB, 5.55458E-01_JPRB, 5.92760E-01_JPRB, 6.32567E-01_JPRB, &
+     & 6.75047E-01_JPRB, 7.20380E-01_JPRB, 7.68757E-01_JPRB, 8.20383E-01_JPRB, 8.75476E-01_JPRB, &
+     & 9.34268E-01_JPRB, 9.97009E-01_JPRB, 1.06396E+00_JPRB, 1.13541E+00_JPRB/)
+      KAO_MCO2( 2, :,12) = (/ &
+     & 3.38812E-01_JPRB, 3.61001E-01_JPRB, 3.84645E-01_JPRB, 4.09836E-01_JPRB, 4.36678E-01_JPRB, &
+     & 4.65278E-01_JPRB, 4.95750E-01_JPRB, 5.28219E-01_JPRB, 5.62814E-01_JPRB, 5.99674E-01_JPRB, &
+     & 6.38949E-01_JPRB, 6.80796E-01_JPRB, 7.25384E-01_JPRB, 7.72892E-01_JPRB, 8.23511E-01_JPRB, &
+     & 8.77446E-01_JPRB, 9.34913E-01_JPRB, 9.96144E-01_JPRB, 1.06138E+00_JPRB/)
+      KAO_MCO2( 3, :,12) = (/ &
+     & 3.44644E-01_JPRB, 3.66671E-01_JPRB, 3.90105E-01_JPRB, 4.15038E-01_JPRB, 4.41564E-01_JPRB, &
+     & 4.69785E-01_JPRB, 4.99810E-01_JPRB, 5.31754E-01_JPRB, 5.65740E-01_JPRB, 6.01897E-01_JPRB, &
+     & 6.40366E-01_JPRB, 6.81293E-01_JPRB, 7.24836E-01_JPRB, 7.71162E-01_JPRB, 8.20448E-01_JPRB, &
+     & 8.72885E-01_JPRB, 9.28673E-01_JPRB, 9.88027E-01_JPRB, 1.05117E+00_JPRB/)
+      KAO_MCO2( 4, :,12) = (/ &
+     & 4.20358E-01_JPRB, 4.47809E-01_JPRB, 4.77053E-01_JPRB, 5.08207E-01_JPRB, 5.41395E-01_JPRB, &
+     & 5.76750E-01_JPRB, 6.14414E-01_JPRB, 6.54538E-01_JPRB, 6.97282E-01_JPRB, 7.42818E-01_JPRB, &
+     & 7.91327E-01_JPRB, 8.43004E-01_JPRB, 8.98056E-01_JPRB, 9.56703E-01_JPRB, 1.01918E+00_JPRB, &
+     & 1.08574E+00_JPRB, 1.15664E+00_JPRB, 1.23217E+00_JPRB, 1.31264E+00_JPRB/)
+      KAO_MCO2( 5, :,12) = (/ &
+     & 4.42756E-01_JPRB, 4.72000E-01_JPRB, 5.03174E-01_JPRB, 5.36408E-01_JPRB, 5.71837E-01_JPRB, &
+     & 6.09606E-01_JPRB, 6.49870E-01_JPRB, 6.92793E-01_JPRB, 7.38551E-01_JPRB, 7.87331E-01_JPRB, &
+     & 8.39333E-01_JPRB, 8.94770E-01_JPRB, 9.53868E-01_JPRB, 1.01687E+00_JPRB, 1.08403E+00_JPRB, &
+     & 1.15563E+00_JPRB, 1.23196E+00_JPRB, 1.31333E+00_JPRB, 1.40007E+00_JPRB/)
+      KAO_MCO2( 6, :,12) = (/ &
+     & 1.53662E-01_JPRB, 1.63104E-01_JPRB, 1.73126E-01_JPRB, 1.83764E-01_JPRB, 1.95055E-01_JPRB, &
+     & 2.07040E-01_JPRB, 2.19762E-01_JPRB, 2.33265E-01_JPRB, 2.47598E-01_JPRB, 2.62811E-01_JPRB, &
+     & 2.78960E-01_JPRB, 2.96100E-01_JPRB, 3.14294E-01_JPRB, 3.33606E-01_JPRB, 3.54104E-01_JPRB, &
+     & 3.75862E-01_JPRB, 3.98956E-01_JPRB, 4.23470E-01_JPRB, 4.49490E-01_JPRB/)
+      KAO_MCO2( 7, :,12) = (/ &
+     & 5.41472E-04_JPRB, 5.65116E-04_JPRB, 5.89793E-04_JPRB, 6.15547E-04_JPRB, 6.42426E-04_JPRB, &
+     & 6.70479E-04_JPRB, 6.99757E-04_JPRB, 7.30313E-04_JPRB, 7.62203E-04_JPRB, 7.95486E-04_JPRB, &
+     & 8.30223E-04_JPRB, 8.66476E-04_JPRB, 9.04312E-04_JPRB, 9.43801E-04_JPRB, 9.85013E-04_JPRB, &
+     & 1.02803E-03_JPRB, 1.07292E-03_JPRB, 1.11977E-03_JPRB, 1.16866E-03_JPRB/)
+      KAO_MCO2( 8, :,12) = (/ &
+     & 5.94251E-04_JPRB, 6.17650E-04_JPRB, 6.41969E-04_JPRB, 6.67246E-04_JPRB, 6.93518E-04_JPRB, &
+     & 7.20824E-04_JPRB, 7.49206E-04_JPRB, 7.78705E-04_JPRB, 8.09366E-04_JPRB, 8.41234E-04_JPRB, &
+     & 8.74356E-04_JPRB, 9.08783E-04_JPRB, 9.44566E-04_JPRB, 9.81757E-04_JPRB, 1.02041E-03_JPRB, &
+     & 1.06059E-03_JPRB, 1.10235E-03_JPRB, 1.14575E-03_JPRB, 1.19087E-03_JPRB/)
+      KAO_MCO2( 9, :,12) = (/ &
+     & 4.21683E-01_JPRB, 4.49025E-01_JPRB, 4.78140E-01_JPRB, 5.09142E-01_JPRB, 5.42155E-01_JPRB, &
+     & 5.77309E-01_JPRB, 6.14741E-01_JPRB, 6.54601E-01_JPRB, 6.97046E-01_JPRB, 7.42242E-01_JPRB, &
+     & 7.90369E-01_JPRB, 8.41617E-01_JPRB, 8.96188E-01_JPRB, 9.54297E-01_JPRB, 1.01617E+00_JPRB, &
+     & 1.08206E+00_JPRB, 1.15222E+00_JPRB, 1.22693E+00_JPRB, 1.30649E+00_JPRB/)
+      KAO_MCO2( 1, :,13) = (/ &
+     & 5.61805E-01_JPRB, 5.98988E-01_JPRB, 6.38631E-01_JPRB, 6.80898E-01_JPRB, 7.25962E-01_JPRB, &
+     & 7.74009E-01_JPRB, 8.25236E-01_JPRB, 8.79853E-01_JPRB, 9.38085E-01_JPRB, 1.00017E+00_JPRB, &
+     & 1.06637E+00_JPRB, 1.13694E+00_JPRB, 1.21219E+00_JPRB, 1.29242E+00_JPRB, 1.37795E+00_JPRB, &
+     & 1.46915E+00_JPRB, 1.56638E+00_JPRB, 1.67005E+00_JPRB, 1.78058E+00_JPRB/)
+      KAO_MCO2( 2, :,13) = (/ &
+     & 5.55938E-01_JPRB, 5.91800E-01_JPRB, 6.29976E-01_JPRB, 6.70615E-01_JPRB, 7.13876E-01_JPRB, &
+     & 7.59927E-01_JPRB, 8.08949E-01_JPRB, 8.61133E-01_JPRB, 9.16683E-01_JPRB, 9.75817E-01_JPRB, &
+     & 1.03877E+00_JPRB, 1.10577E+00_JPRB, 1.17711E+00_JPRB, 1.25304E+00_JPRB, 1.33387E+00_JPRB, &
+     & 1.41992E+00_JPRB, 1.51152E+00_JPRB, 1.60902E+00_JPRB, 1.71282E+00_JPRB/)
+      KAO_MCO2( 3, :,13) = (/ &
+     & 5.94615E-01_JPRB, 6.33277E-01_JPRB, 6.74453E-01_JPRB, 7.18307E-01_JPRB, 7.65012E-01_JPRB, &
+     & 8.14753E-01_JPRB, 8.67729E-01_JPRB, 9.24149E-01_JPRB, 9.84238E-01_JPRB, 1.04823E+00_JPRB, &
+     & 1.11639E+00_JPRB, 1.18898E+00_JPRB, 1.26629E+00_JPRB, 1.34862E+00_JPRB, 1.43631E+00_JPRB, &
+     & 1.52970E+00_JPRB, 1.62916E+00_JPRB, 1.73509E+00_JPRB, 1.84791E+00_JPRB/)
+      KAO_MCO2( 4, :,13) = (/ &
+     & 5.48973E-01_JPRB, 5.84145E-01_JPRB, 6.21570E-01_JPRB, 6.61394E-01_JPRB, 7.03768E-01_JPRB, &
+     & 7.48858E-01_JPRB, 7.96836E-01_JPRB, 8.47889E-01_JPRB, 9.02212E-01_JPRB, 9.60015E-01_JPRB, &
+     & 1.02152E+00_JPRB, 1.08697E+00_JPRB, 1.15661E+00_JPRB, 1.23071E+00_JPRB, 1.30956E+00_JPRB, &
+     & 1.39347E+00_JPRB, 1.48274E+00_JPRB, 1.57774E+00_JPRB, 1.67883E+00_JPRB/)
+      KAO_MCO2( 5, :,13) = (/ &
+     & 1.49742E-01_JPRB, 1.59049E-01_JPRB, 1.68934E-01_JPRB, 1.79434E-01_JPRB, 1.90586E-01_JPRB, &
+     & 2.02432E-01_JPRB, 2.15013E-01_JPRB, 2.28377E-01_JPRB, 2.42571E-01_JPRB, 2.57648E-01_JPRB, &
+     & 2.73661E-01_JPRB, 2.90670E-01_JPRB, 3.08736E-01_JPRB, 3.27925E-01_JPRB, 3.48307E-01_JPRB, &
+     & 3.69955E-01_JPRB, 3.92949E-01_JPRB, 4.17372E-01_JPRB, 4.43312E-01_JPRB/)
+      KAO_MCO2( 6, :,13) = (/ &
+     & 8.81777E-04_JPRB, 9.16690E-04_JPRB, 9.52985E-04_JPRB, 9.90718E-04_JPRB, 1.02994E-03_JPRB, &
+     & 1.07072E-03_JPRB, 1.11312E-03_JPRB, 1.15719E-03_JPRB, 1.20301E-03_JPRB, 1.25064E-03_JPRB, &
+     & 1.30016E-03_JPRB, 1.35163E-03_JPRB, 1.40515E-03_JPRB, 1.46079E-03_JPRB, 1.51862E-03_JPRB, &
+     & 1.57875E-03_JPRB, 1.64126E-03_JPRB, 1.70624E-03_JPRB, 1.77380E-03_JPRB/)
+      KAO_MCO2( 7, :,13) = (/ &
+     & 8.84366E-04_JPRB, 9.20446E-04_JPRB, 9.57999E-04_JPRB, 9.97083E-04_JPRB, 1.03776E-03_JPRB, &
+     & 1.08010E-03_JPRB, 1.12417E-03_JPRB, 1.17003E-03_JPRB, 1.21777E-03_JPRB, 1.26745E-03_JPRB, &
+     & 1.31916E-03_JPRB, 1.37298E-03_JPRB, 1.42899E-03_JPRB, 1.48729E-03_JPRB, 1.54797E-03_JPRB, &
+     & 1.61113E-03_JPRB, 1.67686E-03_JPRB, 1.74527E-03_JPRB, 1.81647E-03_JPRB/)
+      KAO_MCO2( 8, :,13) = (/ &
+     & 8.92597E-04_JPRB, 9.33069E-04_JPRB, 9.75377E-04_JPRB, 1.01960E-03_JPRB, 1.06583E-03_JPRB, &
+     & 1.11416E-03_JPRB, 1.16468E-03_JPRB, 1.21749E-03_JPRB, 1.27269E-03_JPRB, 1.33040E-03_JPRB, &
+     & 1.39073E-03_JPRB, 1.45378E-03_JPRB, 1.51970E-03_JPRB, 1.58861E-03_JPRB, 1.66064E-03_JPRB, &
+     & 1.73594E-03_JPRB, 1.81465E-03_JPRB, 1.89693E-03_JPRB, 1.98294E-03_JPRB/)
+      KAO_MCO2( 9, :,13) = (/ &
+     & 1.46280E-01_JPRB, 1.55378E-01_JPRB, 1.65043E-01_JPRB, 1.75308E-01_JPRB, 1.86212E-01_JPRB, &
+     & 1.97794E-01_JPRB, 2.10097E-01_JPRB, 2.23164E-01_JPRB, 2.37045E-01_JPRB, 2.51788E-01_JPRB, &
+     & 2.67449E-01_JPRB, 2.84084E-01_JPRB, 3.01754E-01_JPRB, 3.20522E-01_JPRB, 3.40458E-01_JPRB, &
+     & 3.61634E-01_JPRB, 3.84127E-01_JPRB, 4.08020E-01_JPRB, 4.33398E-01_JPRB/)
+      KAO_MCO2( 1, :,14) = (/ &
+     & 9.20236E-01_JPRB, 9.80010E-01_JPRB, 1.04367E+00_JPRB, 1.11146E+00_JPRB, 1.18366E+00_JPRB, &
+     & 1.26054E+00_JPRB, 1.34242E+00_JPRB, 1.42962E+00_JPRB, 1.52248E+00_JPRB, 1.62137E+00_JPRB, &
+     & 1.72669E+00_JPRB, 1.83885E+00_JPRB, 1.95829E+00_JPRB, 2.08549E+00_JPRB, 2.22096E+00_JPRB, &
+     & 2.36522E+00_JPRB, 2.51886E+00_JPRB, 2.68247E+00_JPRB, 2.85671E+00_JPRB/)
+      KAO_MCO2( 2, :,14) = (/ &
+     & 8.39823E-01_JPRB, 8.95471E-01_JPRB, 9.54806E-01_JPRB, 1.01807E+00_JPRB, 1.08553E+00_JPRB, &
+     & 1.15746E+00_JPRB, 1.23416E+00_JPRB, 1.31593E+00_JPRB, 1.40313E+00_JPRB, 1.49610E+00_JPRB, &
+     & 1.59523E+00_JPRB, 1.70094E+00_JPRB, 1.81364E+00_JPRB, 1.93382E+00_JPRB, 2.06195E+00_JPRB, &
+     & 2.19858E+00_JPRB, 2.34426E+00_JPRB, 2.49960E+00_JPRB, 2.66522E+00_JPRB/)
+      KAO_MCO2( 3, :,14) = (/ &
+     & 5.39252E-01_JPRB, 5.73971E-01_JPRB, 6.10925E-01_JPRB, 6.50259E-01_JPRB, 6.92125E-01_JPRB, &
+     & 7.36686E-01_JPRB, 7.84117E-01_JPRB, 8.34601E-01_JPRB, 8.88336E-01_JPRB, 9.45530E-01_JPRB, &
+     & 1.00641E+00_JPRB, 1.07120E+00_JPRB, 1.14017E+00_JPRB, 1.21358E+00_JPRB, 1.29171E+00_JPRB, &
+     & 1.37488E+00_JPRB, 1.46340E+00_JPRB, 1.55762E+00_JPRB, 1.65790E+00_JPRB/)
+      KAO_MCO2( 4, :,14) = (/ &
+     & 1.14837E-03_JPRB, 1.19701E-03_JPRB, 1.24770E-03_JPRB, 1.30055E-03_JPRB, 1.35563E-03_JPRB, &
+     & 1.41305E-03_JPRB, 1.47289E-03_JPRB, 1.53528E-03_JPRB, 1.60030E-03_JPRB, 1.66808E-03_JPRB, &
+     & 1.73873E-03_JPRB, 1.81237E-03_JPRB, 1.88913E-03_JPRB, 1.96914E-03_JPRB, 2.05254E-03_JPRB, &
+     & 2.13947E-03_JPRB, 2.23009E-03_JPRB, 2.32454E-03_JPRB, 2.42299E-03_JPRB/)
+      KAO_MCO2( 5, :,14) = (/ &
+     & 1.14611E-03_JPRB, 1.19424E-03_JPRB, 1.24440E-03_JPRB, 1.29666E-03_JPRB, 1.35111E-03_JPRB, &
+     & 1.40786E-03_JPRB, 1.46698E-03_JPRB, 1.52859E-03_JPRB, 1.59279E-03_JPRB, 1.65968E-03_JPRB, &
+     & 1.72938E-03_JPRB, 1.80201E-03_JPRB, 1.87769E-03_JPRB, 1.95655E-03_JPRB, 2.03872E-03_JPRB, &
+     & 2.12434E-03_JPRB, 2.21355E-03_JPRB, 2.30651E-03_JPRB, 2.40338E-03_JPRB/)
+      KAO_MCO2( 6, :,14) = (/ &
+     & 1.14203E-03_JPRB, 1.18930E-03_JPRB, 1.23852E-03_JPRB, 1.28979E-03_JPRB, 1.34317E-03_JPRB, &
+     & 1.39877E-03_JPRB, 1.45666E-03_JPRB, 1.51695E-03_JPRB, 1.57974E-03_JPRB, 1.64513E-03_JPRB, &
+     & 1.71322E-03_JPRB, 1.78413E-03_JPRB, 1.85798E-03_JPRB, 1.93488E-03_JPRB, 2.01497E-03_JPRB, &
+     & 2.09837E-03_JPRB, 2.18522E-03_JPRB, 2.27567E-03_JPRB, 2.36986E-03_JPRB/)
+      KAO_MCO2( 7, :,14) = (/ &
+     & 1.11217E-03_JPRB, 1.15727E-03_JPRB, 1.20421E-03_JPRB, 1.25305E-03_JPRB, 1.30386E-03_JPRB, &
+     & 1.35674E-03_JPRB, 1.41177E-03_JPRB, 1.46902E-03_JPRB, 1.52860E-03_JPRB, 1.59059E-03_JPRB, &
+     & 1.65510E-03_JPRB, 1.72222E-03_JPRB, 1.79207E-03_JPRB, 1.86475E-03_JPRB, 1.94037E-03_JPRB, &
+     & 2.01907E-03_JPRB, 2.10095E-03_JPRB, 2.18616E-03_JPRB, 2.27482E-03_JPRB/)
+      KAO_MCO2( 8, :,14) = (/ &
+     & 1.21596E-03_JPRB, 1.25817E-03_JPRB, 1.30183E-03_JPRB, 1.34702E-03_JPRB, 1.39377E-03_JPRB, &
+     & 1.44214E-03_JPRB, 1.49219E-03_JPRB, 1.54398E-03_JPRB, 1.59757E-03_JPRB, 1.65302E-03_JPRB, &
+     & 1.71039E-03_JPRB, 1.76975E-03_JPRB, 1.83117E-03_JPRB, 1.89473E-03_JPRB, 1.96049E-03_JPRB, &
+     & 2.02853E-03_JPRB, 2.09893E-03_JPRB, 2.17178E-03_JPRB, 2.24716E-03_JPRB/)
+      KAO_MCO2( 9, :,14) = (/ &
+     & 1.14611E-03_JPRB, 1.19424E-03_JPRB, 1.24440E-03_JPRB, 1.29666E-03_JPRB, 1.35111E-03_JPRB, &
+     & 1.40786E-03_JPRB, 1.46698E-03_JPRB, 1.52859E-03_JPRB, 1.59279E-03_JPRB, 1.65968E-03_JPRB, &
+     & 1.72938E-03_JPRB, 1.80201E-03_JPRB, 1.87769E-03_JPRB, 1.95655E-03_JPRB, 2.03872E-03_JPRB, &
+     & 2.12434E-03_JPRB, 2.21355E-03_JPRB, 2.30651E-03_JPRB, 2.40338E-03_JPRB/)
+      KAO_MCO2( 1, :,15) = (/ &
+     & 1.29470E+00_JPRB, 1.37848E+00_JPRB, 1.46768E+00_JPRB, 1.56266E+00_JPRB, 1.66378E+00_JPRB, &
+     & 1.77145E+00_JPRB, 1.88609E+00_JPRB, 2.00814E+00_JPRB, 2.13809E+00_JPRB, 2.27645E+00_JPRB, &
+     & 2.42376E+00_JPRB, 2.58061E+00_JPRB, 2.74761E+00_JPRB, 2.92541E+00_JPRB, 3.11472E+00_JPRB, &
+     & 3.31628E+00_JPRB, 3.53088E+00_JPRB, 3.75938E+00_JPRB, 4.00265E+00_JPRB/)
+      KAO_MCO2( 2, :,15) = (/ &
+     & 7.23701E-01_JPRB, 7.68508E-01_JPRB, 8.16089E-01_JPRB, 8.66616E-01_JPRB, 9.20272E-01_JPRB, &
+     & 9.77250E-01_JPRB, 1.03775E+00_JPRB, 1.10201E+00_JPRB, 1.17024E+00_JPRB, 1.24269E+00_JPRB, &
+     & 1.31963E+00_JPRB, 1.40133E+00_JPRB, 1.48809E+00_JPRB, 1.58023E+00_JPRB, 1.67807E+00_JPRB, &
+     & 1.78196E+00_JPRB, 1.89229E+00_JPRB, 2.00945E+00_JPRB, 2.13386E+00_JPRB/)
+      KAO_MCO2( 3, :,15) = (/ &
+     & 1.81684E-03_JPRB, 1.85424E-03_JPRB, 1.89241E-03_JPRB, 1.93137E-03_JPRB, 1.97114E-03_JPRB, &
+     & 2.01172E-03_JPRB, 2.05313E-03_JPRB, 2.09540E-03_JPRB, 2.13854E-03_JPRB, 2.18257E-03_JPRB, &
+     & 2.22750E-03_JPRB, 2.27336E-03_JPRB, 2.32016E-03_JPRB, 2.36793E-03_JPRB, 2.41668E-03_JPRB, &
+     & 2.46643E-03_JPRB, 2.51721E-03_JPRB, 2.56903E-03_JPRB, 2.62192E-03_JPRB/)
+      KAO_MCO2( 4, :,15) = (/ &
+     & 1.84644E-03_JPRB, 1.88437E-03_JPRB, 1.92309E-03_JPRB, 1.96260E-03_JPRB, 2.00293E-03_JPRB, &
+     & 2.04408E-03_JPRB, 2.08608E-03_JPRB, 2.12894E-03_JPRB, 2.17268E-03_JPRB, 2.21732E-03_JPRB, &
+     & 2.26288E-03_JPRB, 2.30938E-03_JPRB, 2.35683E-03_JPRB, 2.40525E-03_JPRB, 2.45467E-03_JPRB, &
+     & 2.50510E-03_JPRB, 2.55658E-03_JPRB, 2.60910E-03_JPRB, 2.66271E-03_JPRB/)
+      KAO_MCO2( 5, :,15) = (/ &
+     & 1.88579E-03_JPRB, 1.92454E-03_JPRB, 1.96408E-03_JPRB, 2.00443E-03_JPRB, 2.04561E-03_JPRB, &
+     & 2.08764E-03_JPRB, 2.13054E-03_JPRB, 2.17431E-03_JPRB, 2.21898E-03_JPRB, 2.26457E-03_JPRB, &
+     & 2.31110E-03_JPRB, 2.35858E-03_JPRB, 2.40704E-03_JPRB, 2.45650E-03_JPRB, 2.50697E-03_JPRB, &
+     & 2.55848E-03_JPRB, 2.61104E-03_JPRB, 2.66469E-03_JPRB, 2.71943E-03_JPRB/)
+      KAO_MCO2( 6, :,15) = (/ &
+     & 1.95322E-03_JPRB, 1.99316E-03_JPRB, 2.03391E-03_JPRB, 2.07549E-03_JPRB, 2.11793E-03_JPRB, &
+     & 2.16123E-03_JPRB, 2.20542E-03_JPRB, 2.25051E-03_JPRB, 2.29652E-03_JPRB, 2.34347E-03_JPRB, &
+     & 2.39139E-03_JPRB, 2.44028E-03_JPRB, 2.49017E-03_JPRB, 2.54109E-03_JPRB, 2.59304E-03_JPRB, &
+     & 2.64605E-03_JPRB, 2.70015E-03_JPRB, 2.75536E-03_JPRB, 2.81169E-03_JPRB/)
+      KAO_MCO2( 7, :,15) = (/ &
+     & 2.13640E-03_JPRB, 2.17976E-03_JPRB, 2.22400E-03_JPRB, 2.26914E-03_JPRB, 2.31520E-03_JPRB, &
+     & 2.36219E-03_JPRB, 2.41013E-03_JPRB, 2.45905E-03_JPRB, 2.50896E-03_JPRB, 2.55988E-03_JPRB, &
+     & 2.61184E-03_JPRB, 2.66485E-03_JPRB, 2.71893E-03_JPRB, 2.77412E-03_JPRB, 2.83042E-03_JPRB, &
+     & 2.88787E-03_JPRB, 2.94648E-03_JPRB, 3.00629E-03_JPRB, 3.06730E-03_JPRB/)
+      KAO_MCO2( 8, :,15) = (/ &
+     & 2.17014E-03_JPRB, 2.21411E-03_JPRB, 2.25897E-03_JPRB, 2.30474E-03_JPRB, 2.35143E-03_JPRB, &
+     & 2.39908E-03_JPRB, 2.44769E-03_JPRB, 2.49728E-03_JPRB, 2.54788E-03_JPRB, 2.59950E-03_JPRB, &
+     & 2.65217E-03_JPRB, 2.70591E-03_JPRB, 2.76073E-03_JPRB, 2.81667E-03_JPRB, 2.87374E-03_JPRB, &
+     & 2.93197E-03_JPRB, 2.99137E-03_JPRB, 3.05198E-03_JPRB, 3.11382E-03_JPRB/)
+      KAO_MCO2( 9, :,15) = (/ &
+     & 1.88579E-03_JPRB, 1.92454E-03_JPRB, 1.96408E-03_JPRB, 2.00443E-03_JPRB, 2.04561E-03_JPRB, &
+     & 2.08764E-03_JPRB, 2.13054E-03_JPRB, 2.17431E-03_JPRB, 2.21898E-03_JPRB, 2.26457E-03_JPRB, &
+     & 2.31110E-03_JPRB, 2.35858E-03_JPRB, 2.40704E-03_JPRB, 2.45650E-03_JPRB, 2.50697E-03_JPRB, &
+     & 2.55848E-03_JPRB, 2.61104E-03_JPRB, 2.66469E-03_JPRB, 2.71943E-03_JPRB/)
+      KAO_MCO2( 1, :,16) = (/ &
+     & 1.48989E+00_JPRB, 1.58377E+00_JPRB, 1.68356E+00_JPRB, 1.78964E+00_JPRB, 1.90241E+00_JPRB, &
+     & 2.02228E+00_JPRB, 2.14971E+00_JPRB, 2.28516E+00_JPRB, 2.42915E+00_JPRB, 2.58221E+00_JPRB, &
+     & 2.74492E+00_JPRB, 2.91788E+00_JPRB, 3.10174E+00_JPRB, 3.29718E+00_JPRB, 3.50494E+00_JPRB, &
+     & 3.72578E+00_JPRB, 3.96055E+00_JPRB, 4.21010E+00_JPRB, 4.47538E+00_JPRB/)
+      KAO_MCO2( 2, :,16) = (/ &
+     & 2.10609E-03_JPRB, 2.14759E-03_JPRB, 2.18992E-03_JPRB, 2.23307E-03_JPRB, 2.27708E-03_JPRB, &
+     & 2.32196E-03_JPRB, 2.36771E-03_JPRB, 2.41438E-03_JPRB, 2.46196E-03_JPRB, 2.51047E-03_JPRB, &
+     & 2.55995E-03_JPRB, 2.61040E-03_JPRB, 2.66184E-03_JPRB, 2.71430E-03_JPRB, 2.76779E-03_JPRB, &
+     & 2.82234E-03_JPRB, 2.87796E-03_JPRB, 2.93467E-03_JPRB, 2.99251E-03_JPRB/)
+      KAO_MCO2( 3, :,16) = (/ &
+     & 2.10609E-03_JPRB, 2.14759E-03_JPRB, 2.18992E-03_JPRB, 2.23307E-03_JPRB, 2.27708E-03_JPRB, &
+     & 2.32196E-03_JPRB, 2.36771E-03_JPRB, 2.41438E-03_JPRB, 2.46196E-03_JPRB, 2.51047E-03_JPRB, &
+     & 2.55995E-03_JPRB, 2.61040E-03_JPRB, 2.66184E-03_JPRB, 2.71430E-03_JPRB, 2.76779E-03_JPRB, &
+     & 2.82234E-03_JPRB, 2.87796E-03_JPRB, 2.93467E-03_JPRB, 2.99251E-03_JPRB/)
+      KAO_MCO2( 4, :,16) = (/ &
+     & 2.10609E-03_JPRB, 2.14759E-03_JPRB, 2.18992E-03_JPRB, 2.23307E-03_JPRB, 2.27708E-03_JPRB, &
+     & 2.32196E-03_JPRB, 2.36771E-03_JPRB, 2.41438E-03_JPRB, 2.46196E-03_JPRB, 2.51047E-03_JPRB, &
+     & 2.55995E-03_JPRB, 2.61040E-03_JPRB, 2.66184E-03_JPRB, 2.71430E-03_JPRB, 2.76779E-03_JPRB, &
+     & 2.82234E-03_JPRB, 2.87796E-03_JPRB, 2.93467E-03_JPRB, 2.99251E-03_JPRB/)
+      KAO_MCO2( 5, :,16) = (/ &
+     & 2.10609E-03_JPRB, 2.14759E-03_JPRB, 2.18992E-03_JPRB, 2.23307E-03_JPRB, 2.27708E-03_JPRB, &
+     & 2.32196E-03_JPRB, 2.36771E-03_JPRB, 2.41438E-03_JPRB, 2.46196E-03_JPRB, 2.51047E-03_JPRB, &
+     & 2.55995E-03_JPRB, 2.61040E-03_JPRB, 2.66184E-03_JPRB, 2.71430E-03_JPRB, 2.76779E-03_JPRB, &
+     & 2.82234E-03_JPRB, 2.87796E-03_JPRB, 2.93467E-03_JPRB, 2.99251E-03_JPRB/)
+      KAO_MCO2( 6, :,16) = (/ &
+     & 2.10609E-03_JPRB, 2.14759E-03_JPRB, 2.18992E-03_JPRB, 2.23307E-03_JPRB, 2.27708E-03_JPRB, &
+     & 2.32196E-03_JPRB, 2.36771E-03_JPRB, 2.41438E-03_JPRB, 2.46196E-03_JPRB, 2.51047E-03_JPRB, &
+     & 2.55995E-03_JPRB, 2.61040E-03_JPRB, 2.66184E-03_JPRB, 2.71430E-03_JPRB, 2.76779E-03_JPRB, &
+     & 2.82234E-03_JPRB, 2.87796E-03_JPRB, 2.93467E-03_JPRB, 2.99251E-03_JPRB/)
+      KAO_MCO2( 7, :,16) = (/ &
+     & 2.09970E-03_JPRB, 2.14101E-03_JPRB, 2.18312E-03_JPRB, 2.22606E-03_JPRB, 2.26985E-03_JPRB, &
+     & 2.31450E-03_JPRB, 2.36003E-03_JPRB, 2.40645E-03_JPRB, 2.45379E-03_JPRB, 2.50205E-03_JPRB, &
+     & 2.55127E-03_JPRB, 2.60146E-03_JPRB, 2.65263E-03_JPRB, 2.70481E-03_JPRB, 2.75801E-03_JPRB, &
+     & 2.81226E-03_JPRB, 2.86758E-03_JPRB, 2.92399E-03_JPRB, 2.98150E-03_JPRB/)
+      KAO_MCO2( 8, :,16) = (/ &
+     & 2.09970E-03_JPRB, 2.14101E-03_JPRB, 2.18312E-03_JPRB, 2.22606E-03_JPRB, 2.26985E-03_JPRB, &
+     & 2.31450E-03_JPRB, 2.36003E-03_JPRB, 2.40645E-03_JPRB, 2.45379E-03_JPRB, 2.50205E-03_JPRB, &
+     & 2.55127E-03_JPRB, 2.60146E-03_JPRB, 2.65263E-03_JPRB, 2.70481E-03_JPRB, 2.75801E-03_JPRB, &
+     & 2.81226E-03_JPRB, 2.86758E-03_JPRB, 2.92399E-03_JPRB, 2.98150E-03_JPRB/)
+      KAO_MCO2( 9, :,16) = (/ &
+     & 2.10609E-03_JPRB, 2.14759E-03_JPRB, 2.18992E-03_JPRB, 2.23307E-03_JPRB, 2.27708E-03_JPRB, &
+     & 2.32196E-03_JPRB, 2.36771E-03_JPRB, 2.41438E-03_JPRB, 2.46196E-03_JPRB, 2.51047E-03_JPRB, &
+     & 2.55995E-03_JPRB, 2.61040E-03_JPRB, 2.66184E-03_JPRB, 2.71430E-03_JPRB, 2.76779E-03_JPRB, &
+     & 2.82234E-03_JPRB, 2.87796E-03_JPRB, 2.93467E-03_JPRB, 2.99251E-03_JPRB/)
+
+      KAO_MCO( 1, :, 1) = (/ &
+     & 4.58355E-01_JPRB, 4.47074E-01_JPRB, 4.36070E-01_JPRB, 4.25337E-01_JPRB, 4.14868E-01_JPRB, &
+     & 4.04657E-01_JPRB, 3.94697E-01_JPRB, 3.84982E-01_JPRB, 3.75506E-01_JPRB, 3.66264E-01_JPRB, &
+     & 3.57249E-01_JPRB, 3.48456E-01_JPRB, 3.39879E-01_JPRB, 3.31514E-01_JPRB, 3.23354E-01_JPRB, &
+     & 3.15395E-01_JPRB, 3.07632E-01_JPRB, 3.00061E-01_JPRB, 2.92675E-01_JPRB/)
+      KAO_MCO( 2, :, 1) = (/ &
+     & 7.03080E-01_JPRB, 6.84132E-01_JPRB, 6.65696E-01_JPRB, 6.47756E-01_JPRB, 6.30300E-01_JPRB, &
+     & 6.13314E-01_JPRB, 5.96786E-01_JPRB, 5.80703E-01_JPRB, 5.65053E-01_JPRB, 5.49826E-01_JPRB, &
+     & 5.35009E-01_JPRB, 5.20591E-01_JPRB, 5.06561E-01_JPRB, 4.92910E-01_JPRB, 4.79627E-01_JPRB, &
+     & 4.66701E-01_JPRB, 4.54124E-01_JPRB, 4.41886E-01_JPRB, 4.29978E-01_JPRB/)
+      KAO_MCO( 3, :, 1) = (/ &
+     & 8.53018E-01_JPRB, 8.29537E-01_JPRB, 8.06703E-01_JPRB, 7.84497E-01_JPRB, 7.62903E-01_JPRB, &
+     & 7.41903E-01_JPRB, 7.21481E-01_JPRB, 7.01621E-01_JPRB, 6.82307E-01_JPRB, 6.63526E-01_JPRB, &
+     & 6.45261E-01_JPRB, 6.27499E-01_JPRB, 6.10226E-01_JPRB, 5.93429E-01_JPRB, 5.77094E-01_JPRB, &
+     & 5.61208E-01_JPRB, 5.45760E-01_JPRB, 5.30737E-01_JPRB, 5.16128E-01_JPRB/)
+      KAO_MCO( 4, :, 1) = (/ &
+     & 9.58866E-01_JPRB, 9.31881E-01_JPRB, 9.05654E-01_JPRB, 8.80166E-01_JPRB, 8.55395E-01_JPRB, &
+     & 8.31321E-01_JPRB, 8.07925E-01_JPRB, 7.85187E-01_JPRB, 7.63089E-01_JPRB, 7.41613E-01_JPRB, &
+     & 7.20742E-01_JPRB, 7.00457E-01_JPRB, 6.80744E-01_JPRB, 6.61586E-01_JPRB, 6.42966E-01_JPRB, &
+     & 6.24871E-01_JPRB, 6.07285E-01_JPRB, 5.90194E-01_JPRB, 5.73584E-01_JPRB/)
+      KAO_MCO( 5, :, 1) = (/ &
+     & 1.07140E+00_JPRB, 1.04056E+00_JPRB, 1.01061E+00_JPRB, 9.81521E-01_JPRB, 9.53269E-01_JPRB, &
+     & 9.25829E-01_JPRB, 8.99180E-01_JPRB, 8.73297E-01_JPRB, 8.48160E-01_JPRB, 8.23746E-01_JPRB, &
+     & 8.00035E-01_JPRB, 7.77006E-01_JPRB, 7.54641E-01_JPRB, 7.32919E-01_JPRB, 7.11822E-01_JPRB, &
+     & 6.91333E-01_JPRB, 6.71433E-01_JPRB, 6.52106E-01_JPRB, 6.33336E-01_JPRB/)
+      KAO_MCO( 6, :, 1) = (/ &
+     & 1.21046E+00_JPRB, 1.17478E+00_JPRB, 1.14015E+00_JPRB, 1.10655E+00_JPRB, 1.07393E+00_JPRB, &
+     & 1.04228E+00_JPRB, 1.01156E+00_JPRB, 9.81740E-01_JPRB, 9.52803E-01_JPRB, 9.24720E-01_JPRB, &
+     & 8.97463E-01_JPRB, 8.71011E-01_JPRB, 8.45338E-01_JPRB, 8.20422E-01_JPRB, 7.96240E-01_JPRB, &
+     & 7.72771E-01_JPRB, 7.49993E-01_JPRB, 7.27887E-01_JPRB, 7.06433E-01_JPRB/)
+      KAO_MCO( 7, :, 1) = (/ &
+     & 1.57730E+00_JPRB, 1.52919E+00_JPRB, 1.48255E+00_JPRB, 1.43733E+00_JPRB, 1.39349E+00_JPRB, &
+     & 1.35099E+00_JPRB, 1.30978E+00_JPRB, 1.26983E+00_JPRB, 1.23110E+00_JPRB, 1.19355E+00_JPRB, &
+     & 1.15715E+00_JPRB, 1.12186E+00_JPRB, 1.08764E+00_JPRB, 1.05446E+00_JPRB, 1.02230E+00_JPRB, &
+     & 9.91121E-01_JPRB, 9.60890E-01_JPRB, 9.31583E-01_JPRB, 9.03169E-01_JPRB/)
+      KAO_MCO( 8, :, 1) = (/ &
+     & 2.43678E+00_JPRB, 2.36595E+00_JPRB, 2.29719E+00_JPRB, 2.23042E+00_JPRB, 2.16560E+00_JPRB, &
+     & 2.10266E+00_JPRB, 2.04154E+00_JPRB, 1.98221E+00_JPRB, 1.92460E+00_JPRB, 1.86866E+00_JPRB, &
+     & 1.81435E+00_JPRB, 1.76162E+00_JPRB, 1.71042E+00_JPRB, 1.66070E+00_JPRB, 1.61244E+00_JPRB, &
+     & 1.56557E+00_JPRB, 1.52007E+00_JPRB, 1.47589E+00_JPRB, 1.43300E+00_JPRB/)
+      KAO_MCO( 9, :, 1) = (/ &
+     & 9.66296E-01_JPRB, 9.39903E-01_JPRB, 9.14232E-01_JPRB, 8.89262E-01_JPRB, 8.64973E-01_JPRB, &
+     & 8.41348E-01_JPRB, 8.18369E-01_JPRB, 7.96017E-01_JPRB, 7.74275E-01_JPRB, 7.53128E-01_JPRB, &
+     & 7.32558E-01_JPRB, 7.12549E-01_JPRB, 6.93088E-01_JPRB, 6.74157E-01_JPRB, 6.55744E-01_JPRB, &
+     & 6.37834E-01_JPRB, 6.20413E-01_JPRB, 6.03468E-01_JPRB, 5.86985E-01_JPRB/)
+      KAO_MCO( 1, :, 2) = (/ &
+     & 1.15047E+00_JPRB, 1.12127E+00_JPRB, 1.09281E+00_JPRB, 1.06507E+00_JPRB, 1.03804E+00_JPRB, &
+     & 1.01169E+00_JPRB, 9.86010E-01_JPRB, 9.60983E-01_JPRB, 9.36591E-01_JPRB, 9.12818E-01_JPRB, &
+     & 8.89649E-01_JPRB, 8.67067E-01_JPRB, 8.45059E-01_JPRB, 8.23610E-01_JPRB, 8.02705E-01_JPRB, &
+     & 7.82330E-01_JPRB, 7.62473E-01_JPRB, 7.43119E-01_JPRB, 7.24257E-01_JPRB/)
+      KAO_MCO( 2, :, 2) = (/ &
+     & 1.43243E+00_JPRB, 1.39430E+00_JPRB, 1.35719E+00_JPRB, 1.32106E+00_JPRB, 1.28590E+00_JPRB, &
+     & 1.25167E+00_JPRB, 1.21836E+00_JPRB, 1.18593E+00_JPRB, 1.15436E+00_JPRB, 1.12364E+00_JPRB, &
+     & 1.09373E+00_JPRB, 1.06462E+00_JPRB, 1.03628E+00_JPRB, 1.00870E+00_JPRB, 9.81848E-01_JPRB, &
+     & 9.55714E-01_JPRB, 9.30275E-01_JPRB, 9.05514E-01_JPRB, 8.81412E-01_JPRB/)
+      KAO_MCO( 3, :, 2) = (/ &
+     & 1.61389E+00_JPRB, 1.56911E+00_JPRB, 1.52556E+00_JPRB, 1.48323E+00_JPRB, 1.44207E+00_JPRB, &
+     & 1.40205E+00_JPRB, 1.36314E+00_JPRB, 1.32531E+00_JPRB, 1.28854E+00_JPRB, 1.25278E+00_JPRB, &
+     & 1.21801E+00_JPRB, 1.18421E+00_JPRB, 1.15135E+00_JPRB, 1.11940E+00_JPRB, 1.08834E+00_JPRB, &
+     & 1.05814E+00_JPRB, 1.02877E+00_JPRB, 1.00022E+00_JPRB, 9.72466E-01_JPRB/)
+      KAO_MCO( 4, :, 2) = (/ &
+     & 1.78458E+00_JPRB, 1.73440E+00_JPRB, 1.68564E+00_JPRB, 1.63825E+00_JPRB, 1.59219E+00_JPRB, &
+     & 1.54742E+00_JPRB, 1.50391E+00_JPRB, 1.46163E+00_JPRB, 1.42053E+00_JPRB, 1.38059E+00_JPRB, &
+     & 1.34178E+00_JPRB, 1.30405E+00_JPRB, 1.26739E+00_JPRB, 1.23175E+00_JPRB, 1.19712E+00_JPRB, &
+     & 1.16346E+00_JPRB, 1.13075E+00_JPRB, 1.09896E+00_JPRB, 1.06806E+00_JPRB/)
+      KAO_MCO( 5, :, 2) = (/ &
+     & 1.92622E+00_JPRB, 1.87172E+00_JPRB, 1.81876E+00_JPRB, 1.76730E+00_JPRB, 1.71730E+00_JPRB, &
+     & 1.66871E+00_JPRB, 1.62150E+00_JPRB, 1.57562E+00_JPRB, 1.53104E+00_JPRB, 1.48772E+00_JPRB, &
+     & 1.44563E+00_JPRB, 1.40473E+00_JPRB, 1.36498E+00_JPRB, 1.32636E+00_JPRB, 1.28883E+00_JPRB, &
+     & 1.25237E+00_JPRB, 1.21693E+00_JPRB, 1.18250E+00_JPRB, 1.14905E+00_JPRB/)
+      KAO_MCO( 6, :, 2) = (/ &
+     & 2.23194E+00_JPRB, 2.16782E+00_JPRB, 2.10554E+00_JPRB, 2.04505E+00_JPRB, 1.98630E+00_JPRB, &
+     & 1.92924E+00_JPRB, 1.87381E+00_JPRB, 1.81998E+00_JPRB, 1.76770E+00_JPRB, 1.71691E+00_JPRB, &
+     & 1.66759E+00_JPRB, 1.61968E+00_JPRB, 1.57315E+00_JPRB, 1.52796E+00_JPRB, 1.48406E+00_JPRB, &
+     & 1.44143E+00_JPRB, 1.40002E+00_JPRB, 1.35980E+00_JPRB, 1.32073E+00_JPRB/)
+      KAO_MCO( 7, :, 2) = (/ &
+     & 2.64692E+00_JPRB, 2.57290E+00_JPRB, 2.50096E+00_JPRB, 2.43103E+00_JPRB, 2.36305E+00_JPRB, &
+     & 2.29697E+00_JPRB, 2.23275E+00_JPRB, 2.17031E+00_JPRB, 2.10963E+00_JPRB, 2.05064E+00_JPRB, &
+     & 1.99330E+00_JPRB, 1.93756E+00_JPRB, 1.88338E+00_JPRB, 1.83072E+00_JPRB, 1.77953E+00_JPRB, &
+     & 1.72977E+00_JPRB, 1.68140E+00_JPRB, 1.63438E+00_JPRB, 1.58868E+00_JPRB/)
+      KAO_MCO( 8, :, 2) = (/ &
+     & 2.86812E+00_JPRB, 2.80121E+00_JPRB, 2.73586E+00_JPRB, 2.67204E+00_JPRB, 2.60970E+00_JPRB, &
+     & 2.54882E+00_JPRB, 2.48936E+00_JPRB, 2.43129E+00_JPRB, 2.37457E+00_JPRB, 2.31917E+00_JPRB, &
+     & 2.26507E+00_JPRB, 2.21223E+00_JPRB, 2.16062E+00_JPRB, 2.11022E+00_JPRB, 2.06099E+00_JPRB, &
+     & 2.01291E+00_JPRB, 1.96595E+00_JPRB, 1.92009E+00_JPRB, 1.87529E+00_JPRB/)
+      KAO_MCO( 9, :, 2) = (/ &
+     & 1.25243E+00_JPRB, 1.22790E+00_JPRB, 1.20385E+00_JPRB, 1.18027E+00_JPRB, 1.15716E+00_JPRB, &
+     & 1.13449E+00_JPRB, 1.11227E+00_JPRB, 1.09049E+00_JPRB, 1.06913E+00_JPRB, 1.04819E+00_JPRB, &
+     & 1.02766E+00_JPRB, 1.00754E+00_JPRB, 9.87804E-01_JPRB, 9.68457E-01_JPRB, 9.49490E-01_JPRB, &
+     & 9.30894E-01_JPRB, 9.12662E-01_JPRB, 8.94787E-01_JPRB, 8.77263E-01_JPRB/)
+      KAO_MCO( 1, :, 3) = (/ &
+     & 2.55598E+00_JPRB, 2.48729E+00_JPRB, 2.42045E+00_JPRB, 2.35541E+00_JPRB, 2.29211E+00_JPRB, &
+     & 2.23052E+00_JPRB, 2.17058E+00_JPRB, 2.11225E+00_JPRB, 2.05549E+00_JPRB, 2.00025E+00_JPRB, &
+     & 1.94650E+00_JPRB, 1.89419E+00_JPRB, 1.84329E+00_JPRB, 1.79376E+00_JPRB, 1.74555E+00_JPRB, &
+     & 1.69865E+00_JPRB, 1.65300E+00_JPRB, 1.60858E+00_JPRB, 1.56535E+00_JPRB/)
+      KAO_MCO( 2, :, 3) = (/ &
+     & 2.93113E+00_JPRB, 2.85257E+00_JPRB, 2.77612E+00_JPRB, 2.70172E+00_JPRB, 2.62932E+00_JPRB, &
+     & 2.55885E+00_JPRB, 2.49028E+00_JPRB, 2.42354E+00_JPRB, 2.35859E+00_JPRB, 2.29538E+00_JPRB, &
+     & 2.23386E+00_JPRB, 2.17400E+00_JPRB, 2.11573E+00_JPRB, 2.05903E+00_JPRB, 2.00385E+00_JPRB, &
+     & 1.95015E+00_JPRB, 1.89788E+00_JPRB, 1.84702E+00_JPRB, 1.79752E+00_JPRB/)
+      KAO_MCO( 3, :, 3) = (/ &
+     & 3.26626E+00_JPRB, 3.18025E+00_JPRB, 3.09651E+00_JPRB, 3.01497E+00_JPRB, 2.93558E+00_JPRB, &
+     & 2.85828E+00_JPRB, 2.78302E+00_JPRB, 2.70973E+00_JPRB, 2.63838E+00_JPRB, 2.56891E+00_JPRB, &
+     & 2.50126E+00_JPRB, 2.43540E+00_JPRB, 2.37127E+00_JPRB, 2.30883E+00_JPRB, 2.24803E+00_JPRB, &
+     & 2.18883E+00_JPRB, 2.13120E+00_JPRB, 2.07508E+00_JPRB, 2.02044E+00_JPRB/)
+      KAO_MCO( 4, :, 3) = (/ &
+     & 3.65895E+00_JPRB, 3.56418E+00_JPRB, 3.47187E+00_JPRB, 3.38194E+00_JPRB, 3.29435E+00_JPRB, &
+     & 3.20903E+00_JPRB, 3.12591E+00_JPRB, 3.04495E+00_JPRB, 2.96608E+00_JPRB, 2.88926E+00_JPRB, &
+     & 2.81443E+00_JPRB, 2.74153E+00_JPRB, 2.67053E+00_JPRB, 2.60136E+00_JPRB, 2.53398E+00_JPRB, &
+     & 2.46835E+00_JPRB, 2.40442E+00_JPRB, 2.34214E+00_JPRB, 2.28148E+00_JPRB/)
+      KAO_MCO( 5, :, 3) = (/ &
+     & 4.13692E+00_JPRB, 4.03459E+00_JPRB, 3.93479E+00_JPRB, 3.83746E+00_JPRB, 3.74254E+00_JPRB, &
+     & 3.64997E+00_JPRB, 3.55968E+00_JPRB, 3.47163E+00_JPRB, 3.38576E+00_JPRB, 3.30201E+00_JPRB, &
+     & 3.22034E+00_JPRB, 3.14068E+00_JPRB, 3.06299E+00_JPRB, 2.98723E+00_JPRB, 2.91334E+00_JPRB, &
+     & 2.84128E+00_JPRB, 2.77100E+00_JPRB, 2.70246E+00_JPRB, 2.63561E+00_JPRB/)
+      KAO_MCO( 6, :, 3) = (/ &
+     & 4.42856E+00_JPRB, 4.32480E+00_JPRB, 4.22348E+00_JPRB, 4.12453E+00_JPRB, 4.02790E+00_JPRB, &
+     & 3.93353E+00_JPRB, 3.84137E+00_JPRB, 3.75137E+00_JPRB, 3.66348E+00_JPRB, 3.57765E+00_JPRB, &
+     & 3.49383E+00_JPRB, 3.41198E+00_JPRB, 3.33204E+00_JPRB, 3.25397E+00_JPRB, 3.17774E+00_JPRB, &
+     & 3.10329E+00_JPRB, 3.03058E+00_JPRB, 2.95958E+00_JPRB, 2.89024E+00_JPRB/)
+      KAO_MCO( 7, :, 3) = (/ &
+     & 4.31306E+00_JPRB, 4.21750E+00_JPRB, 4.12406E+00_JPRB, 4.03268E+00_JPRB, 3.94333E+00_JPRB, &
+     & 3.85596E+00_JPRB, 3.77053E+00_JPRB, 3.68699E+00_JPRB, 3.60530E+00_JPRB, 3.52542E+00_JPRB, &
+     & 3.44731E+00_JPRB, 3.37093E+00_JPRB, 3.29624E+00_JPRB, 3.22321E+00_JPRB, 3.15179E+00_JPRB, &
+     & 3.08196E+00_JPRB, 3.01368E+00_JPRB, 2.94691E+00_JPRB, 2.88161E+00_JPRB/)
+      KAO_MCO( 8, :, 3) = (/ &
+     & 4.38922E+00_JPRB, 4.32180E+00_JPRB, 4.25543E+00_JPRB, 4.19007E+00_JPRB, 4.12571E+00_JPRB, &
+     & 4.06234E+00_JPRB, 3.99995E+00_JPRB, 3.93851E+00_JPRB, 3.87802E+00_JPRB, 3.81846E+00_JPRB, &
+     & 3.75981E+00_JPRB, 3.70206E+00_JPRB, 3.64520E+00_JPRB, 3.58922E+00_JPRB, 3.53409E+00_JPRB, &
+     & 3.47981E+00_JPRB, 3.42636E+00_JPRB, 3.37374E+00_JPRB, 3.32192E+00_JPRB/)
+      KAO_MCO( 9, :, 3) = (/ &
+     & 1.56810E+00_JPRB, 1.54211E+00_JPRB, 1.51654E+00_JPRB, 1.49139E+00_JPRB, 1.46667E+00_JPRB, &
+     & 1.44235E+00_JPRB, 1.41844E+00_JPRB, 1.39492E+00_JPRB, 1.37179E+00_JPRB, 1.34905E+00_JPRB, &
+     & 1.32668E+00_JPRB, 1.30469E+00_JPRB, 1.28306E+00_JPRB, 1.26178E+00_JPRB, 1.24086E+00_JPRB, &
+     & 1.22029E+00_JPRB, 1.20006E+00_JPRB, 1.18016E+00_JPRB, 1.16059E+00_JPRB/)
+      KAO_MCO( 1, :, 4) = (/ &
+     & 6.58275E+00_JPRB, 6.43026E+00_JPRB, 6.28130E+00_JPRB, 6.13579E+00_JPRB, 5.99365E+00_JPRB, &
+     & 5.85481E+00_JPRB, 5.71918E+00_JPRB, 5.58669E+00_JPRB, 5.45727E+00_JPRB, 5.33085E+00_JPRB, &
+     & 5.20736E+00_JPRB, 5.08673E+00_JPRB, 4.96889E+00_JPRB, 4.85379E+00_JPRB, 4.74135E+00_JPRB, &
+     & 4.63151E+00_JPRB, 4.52422E+00_JPRB, 4.41942E+00_JPRB, 4.31704E+00_JPRB/)
+      KAO_MCO( 2, :, 4) = (/ &
+     & 6.59883E+00_JPRB, 6.45139E+00_JPRB, 6.30725E+00_JPRB, 6.16633E+00_JPRB, 6.02855E+00_JPRB, &
+     & 5.89386E+00_JPRB, 5.76217E+00_JPRB, 5.63342E+00_JPRB, 5.50756E+00_JPRB, 5.38450E+00_JPRB, &
+     & 5.26419E+00_JPRB, 5.14657E+00_JPRB, 5.03158E+00_JPRB, 4.91916E+00_JPRB, 4.80925E+00_JPRB, &
+     & 4.70180E+00_JPRB, 4.59675E+00_JPRB, 4.49404E+00_JPRB, 4.39363E+00_JPRB/)
+      KAO_MCO( 3, :, 4) = (/ &
+     & 6.58521E+00_JPRB, 6.44452E+00_JPRB, 6.30683E+00_JPRB, 6.17209E+00_JPRB, 6.04023E+00_JPRB, &
+     & 5.91118E+00_JPRB, 5.78489E+00_JPRB, 5.66130E+00_JPRB, 5.54034E+00_JPRB, 5.42198E+00_JPRB, &
+     & 5.30614E+00_JPRB, 5.19277E+00_JPRB, 5.08183E+00_JPRB, 4.97326E+00_JPRB, 4.86701E+00_JPRB, &
+     & 4.76303E+00_JPRB, 4.66127E+00_JPRB, 4.56168E+00_JPRB, 4.46422E+00_JPRB/)
+      KAO_MCO( 4, :, 4) = (/ &
+     & 6.33742E+00_JPRB, 6.20870E+00_JPRB, 6.08260E+00_JPRB, 5.95905E+00_JPRB, 5.83802E+00_JPRB, &
+     & 5.71945E+00_JPRB, 5.60328E+00_JPRB, 5.48947E+00_JPRB, 5.37798E+00_JPRB, 5.26875E+00_JPRB, &
+     & 5.16174E+00_JPRB, 5.05690E+00_JPRB, 4.95419E+00_JPRB, 4.85357E+00_JPRB, 4.75499E+00_JPRB, &
+     & 4.65841E+00_JPRB, 4.56379E+00_JPRB, 4.47110E+00_JPRB, 4.38029E+00_JPRB/)
+      KAO_MCO( 5, :, 4) = (/ &
+     & 5.99732E+00_JPRB, 5.88459E+00_JPRB, 5.77398E+00_JPRB, 5.66545E+00_JPRB, 5.55896E+00_JPRB, &
+     & 5.45447E+00_JPRB, 5.35194E+00_JPRB, 5.25134E+00_JPRB, 5.15263E+00_JPRB, 5.05578E+00_JPRB, &
+     & 4.96075E+00_JPRB, 4.86750E+00_JPRB, 4.77601E+00_JPRB, 4.68623E+00_JPRB, 4.59815E+00_JPRB, &
+     & 4.51171E+00_JPRB, 4.42691E+00_JPRB, 4.34370E+00_JPRB, 4.26205E+00_JPRB/)
+      KAO_MCO( 6, :, 4) = (/ &
+     & 5.74529E+00_JPRB, 5.65249E+00_JPRB, 5.56119E+00_JPRB, 5.47136E+00_JPRB, 5.38299E+00_JPRB, &
+     & 5.29604E+00_JPRB, 5.21049E+00_JPRB, 5.12633E+00_JPRB, 5.04353E+00_JPRB, 4.96206E+00_JPRB, &
+     & 4.88191E+00_JPRB, 4.80306E+00_JPRB, 4.72547E+00_JPRB, 4.64915E+00_JPRB, 4.57405E+00_JPRB, &
+     & 4.50017E+00_JPRB, 4.42748E+00_JPRB, 4.35596E+00_JPRB, 4.28560E+00_JPRB/)
+      KAO_MCO( 7, :, 4) = (/ &
+     & 5.87251E+00_JPRB, 5.79956E+00_JPRB, 5.72753E+00_JPRB, 5.65638E+00_JPRB, 5.58613E+00_JPRB, &
+     & 5.51674E+00_JPRB, 5.44822E+00_JPRB, 5.38054E+00_JPRB, 5.31371E+00_JPRB, 5.24771E+00_JPRB, &
+     & 5.18253E+00_JPRB, 5.11815E+00_JPRB, 5.05458E+00_JPRB, 4.99180E+00_JPRB, 4.92979E+00_JPRB, &
+     & 4.86856E+00_JPRB, 4.80809E+00_JPRB, 4.74837E+00_JPRB, 4.68939E+00_JPRB/)
+      KAO_MCO( 8, :, 4) = (/ &
+     & 5.68503E+00_JPRB, 5.62827E+00_JPRB, 5.57207E+00_JPRB, 5.51644E+00_JPRB, 5.46136E+00_JPRB, &
+     & 5.40684E+00_JPRB, 5.35285E+00_JPRB, 5.29941E+00_JPRB, 5.24650E+00_JPRB, 5.19412E+00_JPRB, &
+     & 5.14226E+00_JPRB, 5.09092E+00_JPRB, 5.04009E+00_JPRB, 4.98977E+00_JPRB, 4.93995E+00_JPRB, &
+     & 4.89063E+00_JPRB, 4.84180E+00_JPRB, 4.79346E+00_JPRB, 4.74560E+00_JPRB/)
+      KAO_MCO( 9, :, 4) = (/ &
+     & 2.69278E+00_JPRB, 2.65058E+00_JPRB, 2.60903E+00_JPRB, 2.56814E+00_JPRB, 2.52789E+00_JPRB, &
+     & 2.48827E+00_JPRB, 2.44927E+00_JPRB, 2.41088E+00_JPRB, 2.37310E+00_JPRB, 2.33590E+00_JPRB, &
+     & 2.29929E+00_JPRB, 2.26325E+00_JPRB, 2.22778E+00_JPRB, 2.19286E+00_JPRB, 2.15849E+00_JPRB, &
+     & 2.12466E+00_JPRB, 2.09136E+00_JPRB, 2.05859E+00_JPRB, 2.02632E+00_JPRB/)
+      KAO_MCO( 1, :, 5) = (/ &
+     & 9.12231E+00_JPRB, 9.00052E+00_JPRB, 8.88036E+00_JPRB, 8.76180E+00_JPRB, 8.64482E+00_JPRB, &
+     & 8.52941E+00_JPRB, 8.41553E+00_JPRB, 8.30318E+00_JPRB, 8.19233E+00_JPRB, 8.08295E+00_JPRB, &
+     & 7.97504E+00_JPRB, 7.86857E+00_JPRB, 7.76352E+00_JPRB, 7.65987E+00_JPRB, 7.55760E+00_JPRB, &
+     & 7.45671E+00_JPRB, 7.35715E+00_JPRB, 7.25893E+00_JPRB, 7.16202E+00_JPRB/)
+      KAO_MCO( 2, :, 5) = (/ &
+     & 8.37315E+00_JPRB, 8.27808E+00_JPRB, 8.18410E+00_JPRB, 8.09118E+00_JPRB, 7.99931E+00_JPRB, &
+     & 7.90849E+00_JPRB, 7.81871E+00_JPRB, 7.72994E+00_JPRB, 7.64217E+00_JPRB, 7.55541E+00_JPRB, &
+     & 7.46963E+00_JPRB, 7.38482E+00_JPRB, 7.30098E+00_JPRB, 7.21809E+00_JPRB, 7.13614E+00_JPRB, &
+     & 7.05512E+00_JPRB, 6.97502E+00_JPRB, 6.89582E+00_JPRB, 6.81753E+00_JPRB/)
+      KAO_MCO( 3, :, 5) = (/ &
+     & 8.14557E+00_JPRB, 8.06533E+00_JPRB, 7.98587E+00_JPRB, 7.90720E+00_JPRB, 7.82930E+00_JPRB, &
+     & 7.75217E+00_JPRB, 7.67580E+00_JPRB, 7.60018E+00_JPRB, 7.52530E+00_JPRB, 7.45117E+00_JPRB, &
+     & 7.37776E+00_JPRB, 7.30508E+00_JPRB, 7.23311E+00_JPRB, 7.16186E+00_JPRB, 7.09130E+00_JPRB, &
+     & 7.02144E+00_JPRB, 6.95227E+00_JPRB, 6.88378E+00_JPRB, 6.81596E+00_JPRB/)
+      KAO_MCO( 4, :, 5) = (/ &
+     & 8.18046E+00_JPRB, 8.11056E+00_JPRB, 8.04126E+00_JPRB, 7.97256E+00_JPRB, 7.90444E+00_JPRB, &
+     & 7.83690E+00_JPRB, 7.76994E+00_JPRB, 7.70355E+00_JPRB, 7.63773E+00_JPRB, 7.57247E+00_JPRB, &
+     & 7.50777E+00_JPRB, 7.44362E+00_JPRB, 7.38002E+00_JPRB, 7.31697E+00_JPRB, 7.25445E+00_JPRB, &
+     & 7.19247E+00_JPRB, 7.13101E+00_JPRB, 7.07008E+00_JPRB, 7.00968E+00_JPRB/)
+      KAO_MCO( 5, :, 5) = (/ &
+     & 8.30092E+00_JPRB, 8.23529E+00_JPRB, 8.17019E+00_JPRB, 8.10559E+00_JPRB, 8.04151E+00_JPRB, &
+     & 7.97794E+00_JPRB, 7.91487E+00_JPRB, 7.85230E+00_JPRB, 7.79022E+00_JPRB, 7.72863E+00_JPRB, &
+     & 7.66753E+00_JPRB, 7.60691E+00_JPRB, 7.54678E+00_JPRB, 7.48711E+00_JPRB, 7.42792E+00_JPRB, &
+     & 7.36920E+00_JPRB, 7.31094E+00_JPRB, 7.25314E+00_JPRB, 7.19580E+00_JPRB/)
+      KAO_MCO( 6, :, 5) = (/ &
+     & 8.30014E+00_JPRB, 8.24466E+00_JPRB, 8.18955E+00_JPRB, 8.13481E+00_JPRB, 8.08044E+00_JPRB, &
+     & 8.02642E+00_JPRB, 7.97277E+00_JPRB, 7.91948E+00_JPRB, 7.86655E+00_JPRB, 7.81396E+00_JPRB, &
+     & 7.76173E+00_JPRB, 7.70985E+00_JPRB, 7.65832E+00_JPRB, 7.60713E+00_JPRB, 7.55628E+00_JPRB, &
+     & 7.50577E+00_JPRB, 7.45560E+00_JPRB, 7.40577E+00_JPRB, 7.35627E+00_JPRB/)
+      KAO_MCO( 7, :, 5) = (/ &
+     & 7.95931E+00_JPRB, 7.93958E+00_JPRB, 7.91989E+00_JPRB, 7.90025E+00_JPRB, 7.88066E+00_JPRB, &
+     & 7.86112E+00_JPRB, 7.84163E+00_JPRB, 7.82219E+00_JPRB, 7.80279E+00_JPRB, 7.78344E+00_JPRB, &
+     & 7.76414E+00_JPRB, 7.74489E+00_JPRB, 7.72568E+00_JPRB, 7.70653E+00_JPRB, 7.68742E+00_JPRB, &
+     & 7.66836E+00_JPRB, 7.64934E+00_JPRB, 7.63038E+00_JPRB, 7.61146E+00_JPRB/)
+      KAO_MCO( 8, :, 5) = (/ &
+     & 9.32576E+00_JPRB, 9.31747E+00_JPRB, 9.30919E+00_JPRB, 9.30092E+00_JPRB, 9.29265E+00_JPRB, &
+     & 9.28439E+00_JPRB, 9.27613E+00_JPRB, 9.26789E+00_JPRB, 9.25965E+00_JPRB, 9.25142E+00_JPRB, &
+     & 9.24320E+00_JPRB, 9.23498E+00_JPRB, 9.22677E+00_JPRB, 9.21857E+00_JPRB, 9.21038E+00_JPRB, &
+     & 9.20219E+00_JPRB, 9.19401E+00_JPRB, 9.18584E+00_JPRB, 9.17767E+00_JPRB/)
+      KAO_MCO( 9, :, 5) = (/ &
+     & 4.13116E+00_JPRB, 4.08426E+00_JPRB, 4.03788E+00_JPRB, 3.99204E+00_JPRB, 3.94671E+00_JPRB, &
+     & 3.90190E+00_JPRB, 3.85760E+00_JPRB, 3.81380E+00_JPRB, 3.77049E+00_JPRB, 3.72768E+00_JPRB, &
+     & 3.68536E+00_JPRB, 3.64351E+00_JPRB, 3.60214E+00_JPRB, 3.56124E+00_JPRB, 3.52081E+00_JPRB, &
+     & 3.48083E+00_JPRB, 3.44131E+00_JPRB, 3.40224E+00_JPRB, 3.36361E+00_JPRB/)
+      KAO_MCO( 1, :, 6) = (/ &
+     & 1.21200E+01_JPRB, 1.21580E+01_JPRB, 1.21961E+01_JPRB, 1.22344E+01_JPRB, 1.22728E+01_JPRB, &
+     & 1.23113E+01_JPRB, 1.23499E+01_JPRB, 1.23886E+01_JPRB, 1.24275E+01_JPRB, 1.24664E+01_JPRB, &
+     & 1.25056E+01_JPRB, 1.25448E+01_JPRB, 1.25841E+01_JPRB, 1.26236E+01_JPRB, 1.26632E+01_JPRB, &
+     & 1.27029E+01_JPRB, 1.27428E+01_JPRB, 1.27827E+01_JPRB, 1.28228E+01_JPRB/)
+      KAO_MCO( 2, :, 6) = (/ &
+     & 1.25231E+01_JPRB, 1.25625E+01_JPRB, 1.26020E+01_JPRB, 1.26417E+01_JPRB, 1.26815E+01_JPRB, &
+     & 1.27214E+01_JPRB, 1.27614E+01_JPRB, 1.28015E+01_JPRB, 1.28418E+01_JPRB, 1.28822E+01_JPRB, &
+     & 1.29228E+01_JPRB, 1.29634E+01_JPRB, 1.30042E+01_JPRB, 1.30451E+01_JPRB, 1.30862E+01_JPRB, &
+     & 1.31274E+01_JPRB, 1.31687E+01_JPRB, 1.32101E+01_JPRB, 1.32517E+01_JPRB/)
+      KAO_MCO( 3, :, 6) = (/ &
+     & 1.27566E+01_JPRB, 1.27983E+01_JPRB, 1.28401E+01_JPRB, 1.28820E+01_JPRB, 1.29241E+01_JPRB, &
+     & 1.29663E+01_JPRB, 1.30087E+01_JPRB, 1.30512E+01_JPRB, 1.30938E+01_JPRB, 1.31366E+01_JPRB, &
+     & 1.31795E+01_JPRB, 1.32225E+01_JPRB, 1.32657E+01_JPRB, 1.33090E+01_JPRB, 1.33525E+01_JPRB, &
+     & 1.33961E+01_JPRB, 1.34399E+01_JPRB, 1.34838E+01_JPRB, 1.35278E+01_JPRB/)
+      KAO_MCO( 4, :, 6) = (/ &
+     & 1.27132E+01_JPRB, 1.27454E+01_JPRB, 1.27777E+01_JPRB, 1.28101E+01_JPRB, 1.28425E+01_JPRB, &
+     & 1.28750E+01_JPRB, 1.29077E+01_JPRB, 1.29403E+01_JPRB, 1.29731E+01_JPRB, 1.30060E+01_JPRB, &
+     & 1.30389E+01_JPRB, 1.30720E+01_JPRB, 1.31051E+01_JPRB, 1.31383E+01_JPRB, 1.31716E+01_JPRB, &
+     & 1.32049E+01_JPRB, 1.32384E+01_JPRB, 1.32719E+01_JPRB, 1.33055E+01_JPRB/)
+      KAO_MCO( 5, :, 6) = (/ &
+     & 1.33151E+01_JPRB, 1.33523E+01_JPRB, 1.33896E+01_JPRB, 1.34271E+01_JPRB, 1.34646E+01_JPRB, &
+     & 1.35022E+01_JPRB, 1.35400E+01_JPRB, 1.35779E+01_JPRB, 1.36158E+01_JPRB, 1.36539E+01_JPRB, &
+     & 1.36921E+01_JPRB, 1.37303E+01_JPRB, 1.37687E+01_JPRB, 1.38072E+01_JPRB, 1.38458E+01_JPRB, &
+     & 1.38846E+01_JPRB, 1.39234E+01_JPRB, 1.39623E+01_JPRB, 1.40013E+01_JPRB/)
+      KAO_MCO( 6, :, 6) = (/ &
+     & 1.41448E+01_JPRB, 1.41902E+01_JPRB, 1.42357E+01_JPRB, 1.42814E+01_JPRB, 1.43272E+01_JPRB, &
+     & 1.43732E+01_JPRB, 1.44194E+01_JPRB, 1.44656E+01_JPRB, 1.45121E+01_JPRB, 1.45586E+01_JPRB, &
+     & 1.46054E+01_JPRB, 1.46522E+01_JPRB, 1.46993E+01_JPRB, 1.47464E+01_JPRB, 1.47938E+01_JPRB, &
+     & 1.48413E+01_JPRB, 1.48889E+01_JPRB, 1.49367E+01_JPRB, 1.49846E+01_JPRB/)
+      KAO_MCO( 7, :, 6) = (/ &
+     & 1.56578E+01_JPRB, 1.56938E+01_JPRB, 1.57299E+01_JPRB, 1.57661E+01_JPRB, 1.58024E+01_JPRB, &
+     & 1.58388E+01_JPRB, 1.58752E+01_JPRB, 1.59117E+01_JPRB, 1.59484E+01_JPRB, 1.59851E+01_JPRB, &
+     & 1.60218E+01_JPRB, 1.60587E+01_JPRB, 1.60957E+01_JPRB, 1.61327E+01_JPRB, 1.61698E+01_JPRB, &
+     & 1.62070E+01_JPRB, 1.62443E+01_JPRB, 1.62817E+01_JPRB, 1.63192E+01_JPRB/)
+      KAO_MCO( 8, :, 6) = (/ &
+     & 1.73627E+01_JPRB, 1.74761E+01_JPRB, 1.75903E+01_JPRB, 1.77052E+01_JPRB, 1.78208E+01_JPRB, &
+     & 1.79373E+01_JPRB, 1.80544E+01_JPRB, 1.81724E+01_JPRB, 1.82911E+01_JPRB, 1.84106E+01_JPRB, &
+     & 1.85309E+01_JPRB, 1.86519E+01_JPRB, 1.87738E+01_JPRB, 1.88964E+01_JPRB, 1.90198E+01_JPRB, &
+     & 1.91441E+01_JPRB, 1.92692E+01_JPRB, 1.93950E+01_JPRB, 1.95217E+01_JPRB/)
+      KAO_MCO( 9, :, 6) = (/ &
+     & 7.16326E+00_JPRB, 7.12921E+00_JPRB, 7.09531E+00_JPRB, 7.06158E+00_JPRB, 7.02800E+00_JPRB, &
+     & 6.99459E+00_JPRB, 6.96133E+00_JPRB, 6.92824E+00_JPRB, 6.89530E+00_JPRB, 6.86252E+00_JPRB, &
+     & 6.82989E+00_JPRB, 6.79742E+00_JPRB, 6.76510E+00_JPRB, 6.73293E+00_JPRB, 6.70092E+00_JPRB, &
+     & 6.66906E+00_JPRB, 6.63736E+00_JPRB, 6.60580E+00_JPRB, 6.57439E+00_JPRB/)
+      KAO_MCO( 1, :, 7) = (/ &
+     & 2.09288E+01_JPRB, 2.10487E+01_JPRB, 2.11692E+01_JPRB, 2.12904E+01_JPRB, 2.14124E+01_JPRB, &
+     & 2.15350E+01_JPRB, 2.16583E+01_JPRB, 2.17823E+01_JPRB, 2.19070E+01_JPRB, 2.20325E+01_JPRB, &
+     & 2.21587E+01_JPRB, 2.22855E+01_JPRB, 2.24132E+01_JPRB, 2.25415E+01_JPRB, 2.26706E+01_JPRB, &
+     & 2.28004E+01_JPRB, 2.29310E+01_JPRB, 2.30623E+01_JPRB, 2.31943E+01_JPRB/)
+      KAO_MCO( 2, :, 7) = (/ &
+     & 2.08159E+01_JPRB, 2.09509E+01_JPRB, 2.10867E+01_JPRB, 2.12234E+01_JPRB, 2.13610E+01_JPRB, &
+     & 2.14994E+01_JPRB, 2.16388E+01_JPRB, 2.17791E+01_JPRB, 2.19202E+01_JPRB, 2.20623E+01_JPRB, &
+     & 2.22053E+01_JPRB, 2.23493E+01_JPRB, 2.24942E+01_JPRB, 2.26400E+01_JPRB, 2.27867E+01_JPRB, &
+     & 2.29345E+01_JPRB, 2.30831E+01_JPRB, 2.32328E+01_JPRB, 2.33834E+01_JPRB/)
+      KAO_MCO( 3, :, 7) = (/ &
+     & 2.10827E+01_JPRB, 2.12409E+01_JPRB, 2.14002E+01_JPRB, 2.15608E+01_JPRB, 2.17225E+01_JPRB, &
+     & 2.18855E+01_JPRB, 2.20497E+01_JPRB, 2.22151E+01_JPRB, 2.23818E+01_JPRB, 2.25497E+01_JPRB, &
+     & 2.27189E+01_JPRB, 2.28893E+01_JPRB, 2.30611E+01_JPRB, 2.32341E+01_JPRB, 2.34084E+01_JPRB, &
+     & 2.35840E+01_JPRB, 2.37609E+01_JPRB, 2.39392E+01_JPRB, 2.41188E+01_JPRB/)
+      KAO_MCO( 4, :, 7) = (/ &
+     & 2.13866E+01_JPRB, 2.15772E+01_JPRB, 2.17694E+01_JPRB, 2.19634E+01_JPRB, 2.21590E+01_JPRB, &
+     & 2.23565E+01_JPRB, 2.25556E+01_JPRB, 2.27566E+01_JPRB, 2.29594E+01_JPRB, 2.31639E+01_JPRB, &
+     & 2.33703E+01_JPRB, 2.35785E+01_JPRB, 2.37886E+01_JPRB, 2.40005E+01_JPRB, 2.42144E+01_JPRB, &
+     & 2.44301E+01_JPRB, 2.46477E+01_JPRB, 2.48673E+01_JPRB, 2.50889E+01_JPRB/)
+      KAO_MCO( 5, :, 7) = (/ &
+     & 1.93714E+01_JPRB, 1.95595E+01_JPRB, 1.97493E+01_JPRB, 1.99410E+01_JPRB, 2.01345E+01_JPRB, &
+     & 2.03300E+01_JPRB, 2.05273E+01_JPRB, 2.07265E+01_JPRB, 2.09277E+01_JPRB, 2.11308E+01_JPRB, &
+     & 2.13359E+01_JPRB, 2.15430E+01_JPRB, 2.17521E+01_JPRB, 2.19632E+01_JPRB, 2.21764E+01_JPRB, &
+     & 2.23917E+01_JPRB, 2.26090E+01_JPRB, 2.28284E+01_JPRB, 2.30500E+01_JPRB/)
+      KAO_MCO( 6, :, 7) = (/ &
+     & 1.70418E+01_JPRB, 1.72109E+01_JPRB, 1.73817E+01_JPRB, 1.75541E+01_JPRB, 1.77283E+01_JPRB, &
+     & 1.79041E+01_JPRB, 1.80818E+01_JPRB, 1.82612E+01_JPRB, 1.84423E+01_JPRB, 1.86253E+01_JPRB, &
+     & 1.88101E+01_JPRB, 1.89967E+01_JPRB, 1.91852E+01_JPRB, 1.93755E+01_JPRB, 1.95678E+01_JPRB, &
+     & 1.97619E+01_JPRB, 1.99580E+01_JPRB, 2.01560E+01_JPRB, 2.03560E+01_JPRB/)
+      KAO_MCO( 7, :, 7) = (/ &
+     & 1.31735E+01_JPRB, 1.32921E+01_JPRB, 1.34118E+01_JPRB, 1.35326E+01_JPRB, 1.36545E+01_JPRB, &
+     & 1.37775E+01_JPRB, 1.39015E+01_JPRB, 1.40267E+01_JPRB, 1.41531E+01_JPRB, 1.42805E+01_JPRB, &
+     & 1.44091E+01_JPRB, 1.45389E+01_JPRB, 1.46698E+01_JPRB, 1.48019E+01_JPRB, 1.49353E+01_JPRB, &
+     & 1.50698E+01_JPRB, 1.52055E+01_JPRB, 1.53424E+01_JPRB, 1.54806E+01_JPRB/)
+      KAO_MCO( 8, :, 7) = (/ &
+     & 4.97361E+00_JPRB, 4.96550E+00_JPRB, 4.95740E+00_JPRB, 4.94931E+00_JPRB, 4.94124E+00_JPRB, &
+     & 4.93318E+00_JPRB, 4.92513E+00_JPRB, 4.91709E+00_JPRB, 4.90907E+00_JPRB, 4.90106E+00_JPRB, &
+     & 4.89307E+00_JPRB, 4.88509E+00_JPRB, 4.87712E+00_JPRB, 4.86916E+00_JPRB, 4.86122E+00_JPRB, &
+     & 4.85329E+00_JPRB, 4.84537E+00_JPRB, 4.83747E+00_JPRB, 4.82958E+00_JPRB/)
+      KAO_MCO( 9, :, 7) = (/ &
+     & 1.76121E+01_JPRB, 1.75887E+01_JPRB, 1.75653E+01_JPRB, 1.75420E+01_JPRB, 1.75187E+01_JPRB, &
+     & 1.74955E+01_JPRB, 1.74722E+01_JPRB, 1.74490E+01_JPRB, 1.74259E+01_JPRB, 1.74027E+01_JPRB, &
+     & 1.73796E+01_JPRB, 1.73566E+01_JPRB, 1.73335E+01_JPRB, 1.73105E+01_JPRB, 1.72875E+01_JPRB, &
+     & 1.72646E+01_JPRB, 1.72416E+01_JPRB, 1.72188E+01_JPRB, 1.71959E+01_JPRB/)
+      KAO_MCO( 1, :, 8) = (/ &
+     & 5.99126E+00_JPRB, 6.08386E+00_JPRB, 6.17790E+00_JPRB, 6.27339E+00_JPRB, 6.37035E+00_JPRB, &
+     & 6.46881E+00_JPRB, 6.56880E+00_JPRB, 6.67033E+00_JPRB, 6.77343E+00_JPRB, 6.87812E+00_JPRB, &
+     & 6.98443E+00_JPRB, 7.09238E+00_JPRB, 7.20201E+00_JPRB, 7.31332E+00_JPRB, 7.42636E+00_JPRB, &
+     & 7.54115E+00_JPRB, 7.65771E+00_JPRB, 7.77607E+00_JPRB, 7.89626E+00_JPRB/)
+      KAO_MCO( 2, :, 8) = (/ &
+     & 4.71621E+00_JPRB, 4.78830E+00_JPRB, 4.86149E+00_JPRB, 4.93580E+00_JPRB, 5.01124E+00_JPRB, &
+     & 5.08784E+00_JPRB, 5.16561E+00_JPRB, 5.24456E+00_JPRB, 5.32473E+00_JPRB, 5.40612E+00_JPRB, &
+     & 5.48875E+00_JPRB, 5.57264E+00_JPRB, 5.65782E+00_JPRB, 5.74430E+00_JPRB, 5.83211E+00_JPRB, &
+     & 5.92125E+00_JPRB, 6.01176E+00_JPRB, 6.10365E+00_JPRB, 6.19694E+00_JPRB/)
+      KAO_MCO( 3, :, 8) = (/ &
+     & 2.77067E+00_JPRB, 2.81437E+00_JPRB, 2.85876E+00_JPRB, 2.90385E+00_JPRB, 2.94965E+00_JPRB, &
+     & 2.99617E+00_JPRB, 3.04343E+00_JPRB, 3.09143E+00_JPRB, 3.14019E+00_JPRB, 3.18972E+00_JPRB, &
+     & 3.24003E+00_JPRB, 3.29114E+00_JPRB, 3.34305E+00_JPRB, 3.39578E+00_JPRB, 3.44934E+00_JPRB, &
+     & 3.50374E+00_JPRB, 3.55901E+00_JPRB, 3.61514E+00_JPRB, 3.67216E+00_JPRB/)
+      KAO_MCO( 4, :, 8) = (/ &
+     & 1.22388E+00_JPRB, 1.24248E+00_JPRB, 1.26136E+00_JPRB, 1.28053E+00_JPRB, 1.29999E+00_JPRB, &
+     & 1.31974E+00_JPRB, 1.33979E+00_JPRB, 1.36015E+00_JPRB, 1.38082E+00_JPRB, 1.40181E+00_JPRB, &
+     & 1.42311E+00_JPRB, 1.44473E+00_JPRB, 1.46669E+00_JPRB, 1.48897E+00_JPRB, 1.51160E+00_JPRB, &
+     & 1.53457E+00_JPRB, 1.55789E+00_JPRB, 1.58156E+00_JPRB, 1.60559E+00_JPRB/)
+      KAO_MCO( 5, :, 8) = (/ &
+     & 1.41479E+00_JPRB, 1.43540E+00_JPRB, 1.45631E+00_JPRB, 1.47752E+00_JPRB, 1.49904E+00_JPRB, &
+     & 1.52088E+00_JPRB, 1.54303E+00_JPRB, 1.56550E+00_JPRB, 1.58831E+00_JPRB, 1.61144E+00_JPRB, &
+     & 1.63491E+00_JPRB, 1.65872E+00_JPRB, 1.68288E+00_JPRB, 1.70740E+00_JPRB, 1.73227E+00_JPRB, &
+     & 1.75750E+00_JPRB, 1.78310E+00_JPRB, 1.80907E+00_JPRB, 1.83542E+00_JPRB/)
+      KAO_MCO( 6, :, 8) = (/ &
+     & 1.43154E+00_JPRB, 1.46074E+00_JPRB, 1.49053E+00_JPRB, 1.52093E+00_JPRB, 1.55196E+00_JPRB, &
+     & 1.58361E+00_JPRB, 1.61591E+00_JPRB, 1.64887E+00_JPRB, 1.68250E+00_JPRB, 1.71682E+00_JPRB, &
+     & 1.75184E+00_JPRB, 1.78757E+00_JPRB, 1.82403E+00_JPRB, 1.86123E+00_JPRB, 1.89920E+00_JPRB, &
+     & 1.93793E+00_JPRB, 1.97746E+00_JPRB, 2.01779E+00_JPRB, 2.05895E+00_JPRB/)
+      KAO_MCO( 7, :, 8) = (/ &
+     & 2.49358E+00_JPRB, 2.56028E+00_JPRB, 2.62875E+00_JPRB, 2.69906E+00_JPRB, 2.77124E+00_JPRB, &
+     & 2.84536E+00_JPRB, 2.92146E+00_JPRB, 2.99960E+00_JPRB, 3.07982E+00_JPRB, 3.16219E+00_JPRB, &
+     & 3.24677E+00_JPRB, 3.33360E+00_JPRB, 3.42276E+00_JPRB, 3.51430E+00_JPRB, 3.60829E+00_JPRB, &
+     & 3.70480E+00_JPRB, 3.80388E+00_JPRB, 3.90562E+00_JPRB, 4.01007E+00_JPRB/)
+      KAO_MCO( 8, :, 8) = (/ &
+     & 4.32513E+00_JPRB, 4.39903E+00_JPRB, 4.47420E+00_JPRB, 4.55065E+00_JPRB, 4.62841E+00_JPRB, &
+     & 4.70750E+00_JPRB, 4.78794E+00_JPRB, 4.86975E+00_JPRB, 4.95296E+00_JPRB, 5.03759E+00_JPRB, &
+     & 5.12367E+00_JPRB, 5.21122E+00_JPRB, 5.30027E+00_JPRB, 5.39084E+00_JPRB, 5.48295E+00_JPRB, &
+     & 5.57664E+00_JPRB, 5.67193E+00_JPRB, 5.76885E+00_JPRB, 5.86743E+00_JPRB/)
+      KAO_MCO( 9, :, 8) = (/ &
+     & 3.35160E+01_JPRB, 3.36789E+01_JPRB, 3.38425E+01_JPRB, 3.40069E+01_JPRB, 3.41722E+01_JPRB, &
+     & 3.43382E+01_JPRB, 3.45050E+01_JPRB, 3.46727E+01_JPRB, 3.48412E+01_JPRB, 3.50105E+01_JPRB, &
+     & 3.51806E+01_JPRB, 3.53515E+01_JPRB, 3.55233E+01_JPRB, 3.56959E+01_JPRB, 3.58693E+01_JPRB, &
+     & 3.60436E+01_JPRB, 3.62187E+01_JPRB, 3.63947E+01_JPRB, 3.65715E+01_JPRB/)
+      KAO_MCO( 1, :, 9) = (/ &
+     & 8.68159E-01_JPRB, 9.13680E-01_JPRB, 9.61587E-01_JPRB, 1.01201E+00_JPRB, 1.06507E+00_JPRB, &
+     & 1.12091E+00_JPRB, 1.17969E+00_JPRB, 1.24154E+00_JPRB, 1.30664E+00_JPRB, 1.37515E+00_JPRB, &
+     & 1.44726E+00_JPRB, 1.52314E+00_JPRB, 1.60300E+00_JPRB, 1.68705E+00_JPRB, 1.77551E+00_JPRB, &
+     & 1.86861E+00_JPRB, 1.96658E+00_JPRB, 2.06970E+00_JPRB, 2.17822E+00_JPRB/)
+      KAO_MCO( 2, :, 9) = (/ &
+     & 9.04391E-01_JPRB, 9.49669E-01_JPRB, 9.97214E-01_JPRB, 1.04714E+00_JPRB, 1.09956E+00_JPRB, &
+     & 1.15461E+00_JPRB, 1.21242E+00_JPRB, 1.27312E+00_JPRB, 1.33685E+00_JPRB, 1.40378E+00_JPRB, &
+     & 1.47406E+00_JPRB, 1.54786E+00_JPRB, 1.62535E+00_JPRB, 1.70673E+00_JPRB, 1.79217E+00_JPRB, &
+     & 1.88190E+00_JPRB, 1.97611E+00_JPRB, 2.07505E+00_JPRB, 2.17893E+00_JPRB/)
+      KAO_MCO( 3, :, 9) = (/ &
+     & 9.67479E-01_JPRB, 1.01312E+00_JPRB, 1.06092E+00_JPRB, 1.11098E+00_JPRB, 1.16339E+00_JPRB, &
+     & 1.21828E+00_JPRB, 1.27576E+00_JPRB, 1.33595E+00_JPRB, 1.39898E+00_JPRB, 1.46499E+00_JPRB, &
+     & 1.53411E+00_JPRB, 1.60649E+00_JPRB, 1.68228E+00_JPRB, 1.76165E+00_JPRB, 1.84476E+00_JPRB, &
+     & 1.93180E+00_JPRB, 2.02294E+00_JPRB, 2.11839E+00_JPRB, 2.21833E+00_JPRB/)
+      KAO_MCO( 4, :, 9) = (/ &
+     & 1.05240E+00_JPRB, 1.09817E+00_JPRB, 1.14592E+00_JPRB, 1.19576E+00_JPRB, 1.24776E+00_JPRB, &
+     & 1.30202E+00_JPRB, 1.35864E+00_JPRB, 1.41772E+00_JPRB, 1.47937E+00_JPRB, 1.54371E+00_JPRB, &
+     & 1.61084E+00_JPRB, 1.68089E+00_JPRB, 1.75398E+00_JPRB, 1.83026E+00_JPRB, 1.90985E+00_JPRB, &
+     & 1.99290E+00_JPRB, 2.07957E+00_JPRB, 2.17000E+00_JPRB, 2.26437E+00_JPRB/)
+      KAO_MCO( 5, :, 9) = (/ &
+     & 1.25800E+00_JPRB, 1.30557E+00_JPRB, 1.35494E+00_JPRB, 1.40618E+00_JPRB, 1.45935E+00_JPRB, &
+     & 1.51454E+00_JPRB, 1.57181E+00_JPRB, 1.63125E+00_JPRB, 1.69293E+00_JPRB, 1.75695E+00_JPRB, &
+     & 1.82339E+00_JPRB, 1.89234E+00_JPRB, 1.96389E+00_JPRB, 2.03816E+00_JPRB, 2.11523E+00_JPRB, &
+     & 2.19522E+00_JPRB, 2.27823E+00_JPRB, 2.36438E+00_JPRB, 2.45378E+00_JPRB/)
+      KAO_MCO( 6, :, 9) = (/ &
+     & 1.76509E+00_JPRB, 1.80550E+00_JPRB, 1.84683E+00_JPRB, 1.88911E+00_JPRB, 1.93235E+00_JPRB, &
+     & 1.97658E+00_JPRB, 2.02183E+00_JPRB, 2.06811E+00_JPRB, 2.11546E+00_JPRB, 2.16388E+00_JPRB, &
+     & 2.21342E+00_JPRB, 2.26408E+00_JPRB, 2.31591E+00_JPRB, 2.36893E+00_JPRB, 2.42315E+00_JPRB, &
+     & 2.47862E+00_JPRB, 2.53536E+00_JPRB, 2.59340E+00_JPRB, 2.65277E+00_JPRB/)
+      KAO_MCO( 7, :, 9) = (/ &
+     & 2.03543E+00_JPRB, 2.05285E+00_JPRB, 2.07042E+00_JPRB, 2.08815E+00_JPRB, 2.10602E+00_JPRB, &
+     & 2.12405E+00_JPRB, 2.14223E+00_JPRB, 2.16057E+00_JPRB, 2.17907E+00_JPRB, 2.19772E+00_JPRB, &
+     & 2.21654E+00_JPRB, 2.23551E+00_JPRB, 2.25465E+00_JPRB, 2.27395E+00_JPRB, 2.29342E+00_JPRB, &
+     & 2.31305E+00_JPRB, 2.33285E+00_JPRB, 2.35282E+00_JPRB, 2.37296E+00_JPRB/)
+      KAO_MCO( 8, :, 9) = (/ &
+     & 3.18883E+00_JPRB, 3.20538E+00_JPRB, 3.22200E+00_JPRB, 3.23872E+00_JPRB, 3.25552E+00_JPRB, &
+     & 3.27241E+00_JPRB, 3.28939E+00_JPRB, 3.30645E+00_JPRB, 3.32360E+00_JPRB, 3.34085E+00_JPRB, &
+     & 3.35818E+00_JPRB, 3.37560E+00_JPRB, 3.39311E+00_JPRB, 3.41071E+00_JPRB, 3.42841E+00_JPRB, &
+     & 3.44619E+00_JPRB, 3.46407E+00_JPRB, 3.48204E+00_JPRB, 3.50011E+00_JPRB/)
+      KAO_MCO( 9, :, 9) = (/ &
+     & 3.97585E+00_JPRB, 3.96333E+00_JPRB, 3.95084E+00_JPRB, 3.93839E+00_JPRB, 3.92598E+00_JPRB, &
+     & 3.91361E+00_JPRB, 3.90128E+00_JPRB, 3.88899E+00_JPRB, 3.87674E+00_JPRB, 3.86452E+00_JPRB, &
+     & 3.85235E+00_JPRB, 3.84021E+00_JPRB, 3.82811E+00_JPRB, 3.81605E+00_JPRB, 3.80402E+00_JPRB, &
+     & 3.79204E+00_JPRB, 3.78009E+00_JPRB, 3.76818E+00_JPRB, 3.75631E+00_JPRB/)
+      KAO_MCO( 1, :,10) = (/ &
+     & 8.62646E-01_JPRB, 9.35164E-01_JPRB, 1.01378E+00_JPRB, 1.09900E+00_JPRB, 1.19139E+00_JPRB, &
+     & 1.29154E+00_JPRB, 1.40011E+00_JPRB, 1.51781E+00_JPRB, 1.64541E+00_JPRB, 1.78373E+00_JPRB, &
+     & 1.93367E+00_JPRB, 2.09623E+00_JPRB, 2.27245E+00_JPRB, 2.46348E+00_JPRB, 2.67057E+00_JPRB, &
+     & 2.89507E+00_JPRB, 3.13844E+00_JPRB, 3.40227E+00_JPRB, 3.68828E+00_JPRB/)
+      KAO_MCO( 2, :,10) = (/ &
+     & 8.04693E-01_JPRB, 8.72167E-01_JPRB, 9.45298E-01_JPRB, 1.02456E+00_JPRB, 1.11047E+00_JPRB, &
+     & 1.20358E+00_JPRB, 1.30450E+00_JPRB, 1.41389E+00_JPRB, 1.53244E+00_JPRB, 1.66094E+00_JPRB, &
+     & 1.80021E+00_JPRB, 1.95115E+00_JPRB, 2.11476E+00_JPRB, 2.29208E+00_JPRB, 2.48427E+00_JPRB, &
+     & 2.69258E+00_JPRB, 2.91835E+00_JPRB, 3.16305E+00_JPRB, 3.42827E+00_JPRB/)
+      KAO_MCO( 3, :,10) = (/ &
+     & 7.66566E-01_JPRB, 8.24651E-01_JPRB, 8.87137E-01_JPRB, 9.54358E-01_JPRB, 1.02667E+00_JPRB, &
+     & 1.10447E+00_JPRB, 1.18815E+00_JPRB, 1.27818E+00_JPRB, 1.37503E+00_JPRB, 1.47922E+00_JPRB, &
+     & 1.59131E+00_JPRB, 1.71189E+00_JPRB, 1.84160E+00_JPRB, 1.98114E+00_JPRB, 2.13126E+00_JPRB, &
+     & 2.29275E+00_JPRB, 2.46648E+00_JPRB, 2.65337E+00_JPRB, 2.85442E+00_JPRB/)
+      KAO_MCO( 4, :,10) = (/ &
+     & 5.40305E-01_JPRB, 5.77106E-01_JPRB, 6.16414E-01_JPRB, 6.58400E-01_JPRB, 7.03245E-01_JPRB, &
+     & 7.51145E-01_JPRB, 8.02307E-01_JPRB, 8.56954E-01_JPRB, 9.15323E-01_JPRB, 9.77668E-01_JPRB, &
+     & 1.04426E+00_JPRB, 1.11539E+00_JPRB, 1.19136E+00_JPRB, 1.27250E+00_JPRB, 1.35918E+00_JPRB, &
+     & 1.45175E+00_JPRB, 1.55064E+00_JPRB, 1.65625E+00_JPRB, 1.76906E+00_JPRB/)
+      KAO_MCO( 5, :,10) = (/ &
+     & 8.22474E-01_JPRB, 8.02911E-01_JPRB, 7.83814E-01_JPRB, 7.65171E-01_JPRB, 7.46971E-01_JPRB, &
+     & 7.29204E-01_JPRB, 7.11860E-01_JPRB, 6.94928E-01_JPRB, 6.78399E-01_JPRB, 6.62263E-01_JPRB, &
+     & 6.46511E-01_JPRB, 6.31133E-01_JPRB, 6.16122E-01_JPRB, 6.01467E-01_JPRB, 5.87161E-01_JPRB, &
+     & 5.73195E-01_JPRB, 5.59562E-01_JPRB, 5.46252E-01_JPRB, 5.33260E-01_JPRB/)
+      KAO_MCO( 6, :,10) = (/ &
+     & 1.28162E+00_JPRB, 1.25110E+00_JPRB, 1.22131E+00_JPRB, 1.19223E+00_JPRB, 1.16384E+00_JPRB, &
+     & 1.13613E+00_JPRB, 1.10908E+00_JPRB, 1.08267E+00_JPRB, 1.05689E+00_JPRB, 1.03173E+00_JPRB, &
+     & 1.00716E+00_JPRB, 9.83184E-01_JPRB, 9.59774E-01_JPRB, 9.36921E-01_JPRB, 9.14613E-01_JPRB, &
+     & 8.92836E-01_JPRB, 8.71577E-01_JPRB, 8.50825E-01_JPRB, 8.30567E-01_JPRB/)
+      KAO_MCO( 7, :,10) = (/ &
+     & 1.92679E+00_JPRB, 1.90551E+00_JPRB, 1.88446E+00_JPRB, 1.86365E+00_JPRB, 1.84307E+00_JPRB, &
+     & 1.82271E+00_JPRB, 1.80258E+00_JPRB, 1.78267E+00_JPRB, 1.76298E+00_JPRB, 1.74351E+00_JPRB, &
+     & 1.72425E+00_JPRB, 1.70520E+00_JPRB, 1.68637E+00_JPRB, 1.66774E+00_JPRB, 1.64932E+00_JPRB, &
+     & 1.63111E+00_JPRB, 1.61309E+00_JPRB, 1.59527E+00_JPRB, 1.57765E+00_JPRB/)
+      KAO_MCO( 8, :,10) = (/ &
+     & 4.66485E+00_JPRB, 4.60869E+00_JPRB, 4.55320E+00_JPRB, 4.49838E+00_JPRB, 4.44423E+00_JPRB, &
+     & 4.39072E+00_JPRB, 4.33786E+00_JPRB, 4.28563E+00_JPRB, 4.23404E+00_JPRB, 4.18306E+00_JPRB, &
+     & 4.13270E+00_JPRB, 4.08295E+00_JPRB, 4.03379E+00_JPRB, 3.98523E+00_JPRB, 3.93725E+00_JPRB, &
+     & 3.88985E+00_JPRB, 3.84301E+00_JPRB, 3.79675E+00_JPRB, 3.75104E+00_JPRB/)
+      KAO_MCO( 9, :,10) = (/ &
+     & 1.41505E+00_JPRB, 1.37820E+00_JPRB, 1.34232E+00_JPRB, 1.30736E+00_JPRB, 1.27332E+00_JPRB, &
+     & 1.24016E+00_JPRB, 1.20786E+00_JPRB, 1.17641E+00_JPRB, 1.14578E+00_JPRB, 1.11594E+00_JPRB, &
+     & 1.08688E+00_JPRB, 1.05858E+00_JPRB, 1.03101E+00_JPRB, 1.00416E+00_JPRB, 9.78015E-01_JPRB, &
+     & 9.52547E-01_JPRB, 9.27742E-01_JPRB, 9.03583E-01_JPRB, 8.80053E-01_JPRB/)
+      KAO_MCO( 1, :,11) = (/ &
+     & 3.40468E-03_JPRB, 4.05994E-03_JPRB, 4.84130E-03_JPRB, 5.77305E-03_JPRB, 6.88412E-03_JPRB, &
+     & 8.20902E-03_JPRB, 9.78890E-03_JPRB, 1.16728E-02_JPRB, 1.39194E-02_JPRB, 1.65983E-02_JPRB, &
+     & 1.97927E-02_JPRB, 2.36020E-02_JPRB, 2.81444E-02_JPRB, 3.35610E-02_JPRB, 4.00200E-02_JPRB, &
+     & 4.77222E-02_JPRB, 5.69067E-02_JPRB, 6.78588E-02_JPRB, 8.09187E-02_JPRB/)
+      KAO_MCO( 2, :,11) = (/ &
+     & 3.85021E-02_JPRB, 4.02208E-02_JPRB, 4.20162E-02_JPRB, 4.38918E-02_JPRB, 4.58512E-02_JPRB, &
+     & 4.78980E-02_JPRB, 5.00361E-02_JPRB, 5.22697E-02_JPRB, 5.46031E-02_JPRB, 5.70405E-02_JPRB, &
+     & 5.95868E-02_JPRB, 6.22468E-02_JPRB, 6.50254E-02_JPRB, 6.79282E-02_JPRB, 7.09605E-02_JPRB, &
+     & 7.41282E-02_JPRB, 7.74372E-02_JPRB, 8.08940E-02_JPRB, 8.45051E-02_JPRB/)
+      KAO_MCO( 3, :,11) = (/ &
+     & 5.24852E-01_JPRB, 5.10480E-01_JPRB, 4.96501E-01_JPRB, 4.82905E-01_JPRB, 4.69681E-01_JPRB, &
+     & 4.56820E-01_JPRB, 4.44310E-01_JPRB, 4.32143E-01_JPRB, 4.20310E-01_JPRB, 4.08800E-01_JPRB, &
+     & 3.97606E-01_JPRB, 3.86718E-01_JPRB, 3.76128E-01_JPRB, 3.65828E-01_JPRB, 3.55810E-01_JPRB, &
+     & 3.46067E-01_JPRB, 3.36590E-01_JPRB, 3.27373E-01_JPRB, 3.18409E-01_JPRB/)
+      KAO_MCO( 4, :,11) = (/ &
+     & 5.86290E-01_JPRB, 5.70241E-01_JPRB, 5.54632E-01_JPRB, 5.39450E-01_JPRB, 5.24683E-01_JPRB, &
+     & 5.10321E-01_JPRB, 4.96352E-01_JPRB, 4.82765E-01_JPRB, 4.69550E-01_JPRB, 4.56697E-01_JPRB, &
+     & 4.44196E-01_JPRB, 4.32036E-01_JPRB, 4.20210E-01_JPRB, 4.08708E-01_JPRB, 3.97520E-01_JPRB, &
+     & 3.86638E-01_JPRB, 3.76055E-01_JPRB, 3.65761E-01_JPRB, 3.55749E-01_JPRB/)
+      KAO_MCO( 5, :,11) = (/ &
+     & 1.66977E+00_JPRB, 1.61807E+00_JPRB, 1.56798E+00_JPRB, 1.51943E+00_JPRB, 1.47239E+00_JPRB, &
+     & 1.42681E+00_JPRB, 1.38264E+00_JPRB, 1.33983E+00_JPRB, 1.29835E+00_JPRB, 1.25815E+00_JPRB, &
+     & 1.21920E+00_JPRB, 1.18146E+00_JPRB, 1.14488E+00_JPRB, 1.10943E+00_JPRB, 1.07509E+00_JPRB, &
+     & 1.04180E+00_JPRB, 1.00955E+00_JPRB, 9.78295E-01_JPRB, 9.48008E-01_JPRB/)
+      KAO_MCO( 6, :,11) = (/ &
+     & 1.96627E+00_JPRB, 1.90948E+00_JPRB, 1.85432E+00_JPRB, 1.80076E+00_JPRB, 1.74875E+00_JPRB, &
+     & 1.69823E+00_JPRB, 1.64918E+00_JPRB, 1.60155E+00_JPRB, 1.55529E+00_JPRB, 1.51036E+00_JPRB, &
+     & 1.46674E+00_JPRB, 1.42437E+00_JPRB, 1.38323E+00_JPRB, 1.34328E+00_JPRB, 1.30448E+00_JPRB, &
+     & 1.26680E+00_JPRB, 1.23021E+00_JPRB, 1.19467E+00_JPRB, 1.16016E+00_JPRB/)
+      KAO_MCO( 7, :,11) = (/ &
+     & 1.67574E+00_JPRB, 1.63510E+00_JPRB, 1.59544E+00_JPRB, 1.55674E+00_JPRB, 1.51898E+00_JPRB, &
+     & 1.48213E+00_JPRB, 1.44618E+00_JPRB, 1.41111E+00_JPRB, 1.37688E+00_JPRB, 1.34348E+00_JPRB, &
+     & 1.31090E+00_JPRB, 1.27910E+00_JPRB, 1.24808E+00_JPRB, 1.21780E+00_JPRB, 1.18826E+00_JPRB, &
+     & 1.15944E+00_JPRB, 1.13132E+00_JPRB, 1.10388E+00_JPRB, 1.07710E+00_JPRB/)
+      KAO_MCO( 8, :,11) = (/ &
+     & 2.00764E+00_JPRB, 1.96233E+00_JPRB, 1.91803E+00_JPRB, 1.87474E+00_JPRB, 1.83242E+00_JPRB, &
+     & 1.79106E+00_JPRB, 1.75063E+00_JPRB, 1.71111E+00_JPRB, 1.67249E+00_JPRB, 1.63474E+00_JPRB, &
+     & 1.59784E+00_JPRB, 1.56177E+00_JPRB, 1.52652E+00_JPRB, 1.49206E+00_JPRB, 1.45838E+00_JPRB, &
+     & 1.42546E+00_JPRB, 1.39329E+00_JPRB, 1.36184E+00_JPRB, 1.33110E+00_JPRB/)
+      KAO_MCO( 9, :,11) = (/ &
+     & 1.83026E+00_JPRB, 1.77349E+00_JPRB, 1.71849E+00_JPRB, 1.66519E+00_JPRB, 1.61355E+00_JPRB, &
+     & 1.56350E+00_JPRB, 1.51501E+00_JPRB, 1.46803E+00_JPRB, 1.42250E+00_JPRB, 1.37838E+00_JPRB, &
+     & 1.33563E+00_JPRB, 1.29421E+00_JPRB, 1.25407E+00_JPRB, 1.21517E+00_JPRB, 1.17749E+00_JPRB, &
+     & 1.14097E+00_JPRB, 1.10558E+00_JPRB, 1.07129E+00_JPRB, 1.03807E+00_JPRB/)
+      KAO_MCO( 1, :,12) = (/ &
+     & 3.90309E-04_JPRB, 4.81310E-04_JPRB, 5.93528E-04_JPRB, 7.31909E-04_JPRB, 9.02554E-04_JPRB, &
+     & 1.11299E-03_JPRB, 1.37248E-03_JPRB, 1.69247E-03_JPRB, 2.08708E-03_JPRB, 2.57368E-03_JPRB, &
+     & 3.17374E-03_JPRB, 3.91370E-03_JPRB, 4.82617E-03_JPRB, 5.95140E-03_JPRB, 7.33897E-03_JPRB, &
+     & 9.05007E-03_JPRB, 1.11601E-02_JPRB, 1.37621E-02_JPRB, 1.69707E-02_JPRB/)
+      KAO_MCO( 2, :,12) = (/ &
+     & 9.80585E-02_JPRB, 9.77457E-02_JPRB, 9.74339E-02_JPRB, 9.71231E-02_JPRB, 9.68132E-02_JPRB, &
+     & 9.65044E-02_JPRB, 9.61965E-02_JPRB, 9.58897E-02_JPRB, 9.55838E-02_JPRB, 9.52789E-02_JPRB, &
+     & 9.49749E-02_JPRB, 9.46719E-02_JPRB, 9.43699E-02_JPRB, 9.40689E-02_JPRB, 9.37688E-02_JPRB, &
+     & 9.34697E-02_JPRB, 9.31715E-02_JPRB, 9.28743E-02_JPRB, 9.25780E-02_JPRB/)
+      KAO_MCO( 3, :,12) = (/ &
+     & 3.15258E-01_JPRB, 3.09936E-01_JPRB, 3.04704E-01_JPRB, 2.99560E-01_JPRB, 2.94503E-01_JPRB, &
+     & 2.89532E-01_JPRB, 2.84645E-01_JPRB, 2.79840E-01_JPRB, 2.75116E-01_JPRB, 2.70472E-01_JPRB, &
+     & 2.65906E-01_JPRB, 2.61417E-01_JPRB, 2.57004E-01_JPRB, 2.52666E-01_JPRB, 2.48401E-01_JPRB, &
+     & 2.44207E-01_JPRB, 2.40085E-01_JPRB, 2.36032E-01_JPRB, 2.32048E-01_JPRB/)
+      KAO_MCO( 4, :,12) = (/ &
+     & 9.74407E-01_JPRB, 9.46900E-01_JPRB, 9.20170E-01_JPRB, 8.94195E-01_JPRB, 8.68952E-01_JPRB, &
+     & 8.44422E-01_JPRB, 8.20585E-01_JPRB, 7.97421E-01_JPRB, 7.74910E-01_JPRB, 7.53035E-01_JPRB, &
+     & 7.31777E-01_JPRB, 7.11120E-01_JPRB, 6.91046E-01_JPRB, 6.71538E-01_JPRB, 6.52581E-01_JPRB, &
+     & 6.34159E-01_JPRB, 6.16257E-01_JPRB, 5.98861E-01_JPRB, 5.81956E-01_JPRB/)
+      KAO_MCO( 5, :,12) = (/ &
+     & 1.04234E+00_JPRB, 1.01364E+00_JPRB, 9.85726E-01_JPRB, 9.58581E-01_JPRB, 9.32184E-01_JPRB, &
+     & 9.06514E-01_JPRB, 8.81551E-01_JPRB, 8.57275E-01_JPRB, 8.33668E-01_JPRB, 8.10710E-01_JPRB, &
+     & 7.88385E-01_JPRB, 7.66675E-01_JPRB, 7.45563E-01_JPRB, 7.25032E-01_JPRB, 7.05066E-01_JPRB, &
+     & 6.85650E-01_JPRB, 6.66769E-01_JPRB, 6.48408E-01_JPRB, 6.30552E-01_JPRB/)
+      KAO_MCO( 6, :,12) = (/ &
+     & 1.79052E+00_JPRB, 1.73725E+00_JPRB, 1.68557E+00_JPRB, 1.63543E+00_JPRB, 1.58678E+00_JPRB, &
+     & 1.53957E+00_JPRB, 1.49377E+00_JPRB, 1.44933E+00_JPRB, 1.40622E+00_JPRB, 1.36439E+00_JPRB, &
+     & 1.32380E+00_JPRB, 1.28442E+00_JPRB, 1.24621E+00_JPRB, 1.20913E+00_JPRB, 1.17316E+00_JPRB, &
+     & 1.13826E+00_JPRB, 1.10440E+00_JPRB, 1.07155E+00_JPRB, 1.03967E+00_JPRB/)
+      KAO_MCO( 7, :,12) = (/ &
+     & 2.99551E+00_JPRB, 2.90366E+00_JPRB, 2.81462E+00_JPRB, 2.72831E+00_JPRB, 2.64464E+00_JPRB, &
+     & 2.56355E+00_JPRB, 2.48494E+00_JPRB, 2.40874E+00_JPRB, 2.33487E+00_JPRB, 2.26328E+00_JPRB, &
+     & 2.19387E+00_JPRB, 2.12660E+00_JPRB, 2.06139E+00_JPRB, 1.99818E+00_JPRB, 1.93690E+00_JPRB, &
+     & 1.87751E+00_JPRB, 1.81993E+00_JPRB, 1.76413E+00_JPRB, 1.71003E+00_JPRB/)
+      KAO_MCO( 8, :,12) = (/ &
+     & 2.89665E+00_JPRB, 2.81184E+00_JPRB, 2.72951E+00_JPRB, 2.64960E+00_JPRB, 2.57202E+00_JPRB, &
+     & 2.49672E+00_JPRB, 2.42362E+00_JPRB, 2.35266E+00_JPRB, 2.28378E+00_JPRB, 2.21692E+00_JPRB, &
+     & 2.15201E+00_JPRB, 2.08900E+00_JPRB, 2.02784E+00_JPRB, 1.96847E+00_JPRB, 1.91084E+00_JPRB, &
+     & 1.85489E+00_JPRB, 1.80059E+00_JPRB, 1.74787E+00_JPRB, 1.69669E+00_JPRB/)
+      KAO_MCO( 9, :,12) = (/ &
+     & 1.03145E+00_JPRB, 1.00335E+00_JPRB, 9.76014E-01_JPRB, 9.49426E-01_JPRB, 9.23561E-01_JPRB, &
+     & 8.98402E-01_JPRB, 8.73927E-01_JPRB, 8.50120E-01_JPRB, 8.26961E-01_JPRB, 8.04433E-01_JPRB, &
+     & 7.82518E-01_JPRB, 7.61201E-01_JPRB, 7.40464E-01_JPRB, 7.20293E-01_JPRB, 7.00670E-01_JPRB, &
+     & 6.81583E-01_JPRB, 6.63015E-01_JPRB, 6.44953E-01_JPRB, 6.27383E-01_JPRB/)
+      KAO_MCO( 1, :,13) = (/ &
+     & 5.27769E-04_JPRB, 6.65449E-04_JPRB, 8.39047E-04_JPRB, 1.05793E-03_JPRB, 1.33392E-03_JPRB, &
+     & 1.68190E-03_JPRB, 2.12066E-03_JPRB, 2.67388E-03_JPRB, 3.37143E-03_JPRB, 4.25094E-03_JPRB, &
+     & 5.35990E-03_JPRB, 6.75816E-03_JPRB, 8.52117E-03_JPRB, 1.07441E-02_JPRB, 1.35470E-02_JPRB, &
+     & 1.70810E-02_JPRB, 2.15370E-02_JPRB, 2.71554E-02_JPRB, 3.42395E-02_JPRB/)
+      KAO_MCO( 2, :,13) = (/ &
+     & 1.08329E-01_JPRB, 1.10179E-01_JPRB, 1.12060E-01_JPRB, 1.13974E-01_JPRB, 1.15920E-01_JPRB, &
+     & 1.17899E-01_JPRB, 1.19913E-01_JPRB, 1.21960E-01_JPRB, 1.24043E-01_JPRB, 1.26161E-01_JPRB, &
+     & 1.28316E-01_JPRB, 1.30507E-01_JPRB, 1.32735E-01_JPRB, 1.35002E-01_JPRB, 1.37307E-01_JPRB, &
+     & 1.39652E-01_JPRB, 1.42037E-01_JPRB, 1.44462E-01_JPRB, 1.46929E-01_JPRB/)
+      KAO_MCO( 3, :,13) = (/ &
+     & 1.95992E-01_JPRB, 1.94515E-01_JPRB, 1.93049E-01_JPRB, 1.91594E-01_JPRB, 1.90150E-01_JPRB, &
+     & 1.88717E-01_JPRB, 1.87294E-01_JPRB, 1.85882E-01_JPRB, 1.84481E-01_JPRB, 1.83091E-01_JPRB, &
+     & 1.81711E-01_JPRB, 1.80341E-01_JPRB, 1.78982E-01_JPRB, 1.77633E-01_JPRB, 1.76294E-01_JPRB, &
+     & 1.74965E-01_JPRB, 1.73646E-01_JPRB, 1.72337E-01_JPRB, 1.71038E-01_JPRB/)
+      KAO_MCO( 4, :,13) = (/ &
+     & 4.49766E-01_JPRB, 4.42749E-01_JPRB, 4.35841E-01_JPRB, 4.29042E-01_JPRB, 4.22348E-01_JPRB, &
+     & 4.15759E-01_JPRB, 4.09272E-01_JPRB, 4.02887E-01_JPRB, 3.96601E-01_JPRB, 3.90414E-01_JPRB, &
+     & 3.84323E-01_JPRB, 3.78327E-01_JPRB, 3.72424E-01_JPRB, 3.66614E-01_JPRB, 3.60894E-01_JPRB, &
+     & 3.55264E-01_JPRB, 3.49721E-01_JPRB, 3.44265E-01_JPRB, 3.38894E-01_JPRB/)
+      KAO_MCO( 5, :,13) = (/ &
+     & 1.07498E+00_JPRB, 1.04736E+00_JPRB, 1.02045E+00_JPRB, 9.94232E-01_JPRB, 9.68686E-01_JPRB, &
+     & 9.43797E-01_JPRB, 9.19547E-01_JPRB, 8.95920E-01_JPRB, 8.72900E-01_JPRB, 8.50471E-01_JPRB, &
+     & 8.28619E-01_JPRB, 8.07329E-01_JPRB, 7.86585E-01_JPRB, 7.66374E-01_JPRB, 7.46683E-01_JPRB, &
+     & 7.27498E-01_JPRB, 7.08805E-01_JPRB, 6.90593E-01_JPRB, 6.72849E-01_JPRB/)
+      KAO_MCO( 6, :,13) = (/ &
+     & 1.66569E+00_JPRB, 1.61740E+00_JPRB, 1.57052E+00_JPRB, 1.52500E+00_JPRB, 1.48080E+00_JPRB, &
+     & 1.43787E+00_JPRB, 1.39620E+00_JPRB, 1.35573E+00_JPRB, 1.31643E+00_JPRB, 1.27827E+00_JPRB, &
+     & 1.24122E+00_JPRB, 1.20524E+00_JPRB, 1.17031E+00_JPRB, 1.13638E+00_JPRB, 1.10344E+00_JPRB, &
+     & 1.07146E+00_JPRB, 1.04040E+00_JPRB, 1.01025E+00_JPRB, 9.80963E-01_JPRB/)
+      KAO_MCO( 7, :,13) = (/ &
+     & 1.52948E+00_JPRB, 1.48763E+00_JPRB, 1.44693E+00_JPRB, 1.40735E+00_JPRB, 1.36884E+00_JPRB, &
+     & 1.33139E+00_JPRB, 1.29497E+00_JPRB, 1.25954E+00_JPRB, 1.22508E+00_JPRB, 1.19156E+00_JPRB, &
+     & 1.15896E+00_JPRB, 1.12725E+00_JPRB, 1.09641E+00_JPRB, 1.06641E+00_JPRB, 1.03724E+00_JPRB, &
+     & 1.00886E+00_JPRB, 9.81259E-01_JPRB, 9.54412E-01_JPRB, 9.28301E-01_JPRB/)
+      KAO_MCO( 8, :,13) = (/ &
+     & 3.81027E+00_JPRB, 3.69422E+00_JPRB, 3.58170E+00_JPRB, 3.47261E+00_JPRB, 3.36684E+00_JPRB, &
+     & 3.26429E+00_JPRB, 3.16486E+00_JPRB, 3.06847E+00_JPRB, 2.97501E+00_JPRB, 2.88439E+00_JPRB, &
+     & 2.79654E+00_JPRB, 2.71136E+00_JPRB, 2.62878E+00_JPRB, 2.54871E+00_JPRB, 2.47108E+00_JPRB, &
+     & 2.39581E+00_JPRB, 2.32284E+00_JPRB, 2.25209E+00_JPRB, 2.18350E+00_JPRB/)
+      KAO_MCO( 9, :,13) = (/ &
+     & 1.12516E+00_JPRB, 1.09531E+00_JPRB, 1.06625E+00_JPRB, 1.03796E+00_JPRB, 1.01042E+00_JPRB, &
+     & 9.83616E-01_JPRB, 9.57520E-01_JPRB, 9.32117E-01_JPRB, 9.07387E-01_JPRB, 8.83314E-01_JPRB, &
+     & 8.59880E-01_JPRB, 8.37067E-01_JPRB, 8.14859E-01_JPRB, 7.93241E-01_JPRB, 7.72196E-01_JPRB, &
+     & 7.51709E-01_JPRB, 7.31766E-01_JPRB, 7.12352E-01_JPRB, 6.93454E-01_JPRB/)
+      KAO_MCO( 1, :,14) = (/ &
+     & 4.79165E-04_JPRB, 6.26966E-04_JPRB, 8.20356E-04_JPRB, 1.07340E-03_JPRB, 1.40450E-03_JPRB, &
+     & 1.83772E-03_JPRB, 2.40457E-03_JPRB, 3.14628E-03_JPRB, 4.11676E-03_JPRB, 5.38660E-03_JPRB, &
+     & 7.04813E-03_JPRB, 9.22216E-03_JPRB, 1.20668E-02_JPRB, 1.57889E-02_JPRB, 2.06590E-02_JPRB, &
+     & 2.70314E-02_JPRB, 3.53694E-02_JPRB, 4.62792E-02_JPRB, 6.05542E-02_JPRB/)
+      KAO_MCO( 2, :,14) = (/ &
+     & 4.75367E-04_JPRB, 6.21987E-04_JPRB, 8.13830E-04_JPRB, 1.06484E-03_JPRB, 1.39328E-03_JPRB, &
+     & 1.82302E-03_JPRB, 2.38530E-03_JPRB, 3.12101E-03_JPRB, 4.08365E-03_JPRB, 5.34318E-03_JPRB, &
+     & 6.99121E-03_JPRB, 9.14756E-03_JPRB, 1.19690E-02_JPRB, 1.56607E-02_JPRB, 2.04909E-02_JPRB, &
+     & 2.68111E-02_JPRB, 3.50806E-02_JPRB, 4.59007E-02_JPRB, 6.00580E-02_JPRB/)
+      KAO_MCO( 3, :,14) = (/ &
+     & 1.39594E-01_JPRB, 1.42407E-01_JPRB, 1.45276E-01_JPRB, 1.48202E-01_JPRB, 1.51188E-01_JPRB, &
+     & 1.54234E-01_JPRB, 1.57342E-01_JPRB, 1.60512E-01_JPRB, 1.63745E-01_JPRB, 1.67044E-01_JPRB, &
+     & 1.70410E-01_JPRB, 1.73843E-01_JPRB, 1.77345E-01_JPRB, 1.80918E-01_JPRB, 1.84563E-01_JPRB, &
+     & 1.88282E-01_JPRB, 1.92075E-01_JPRB, 1.95945E-01_JPRB, 1.99892E-01_JPRB/)
+      KAO_MCO( 4, :,14) = (/ &
+     & 2.73418E-01_JPRB, 2.71322E-01_JPRB, 2.69242E-01_JPRB, 2.67177E-01_JPRB, 2.65129E-01_JPRB, &
+     & 2.63096E-01_JPRB, 2.61079E-01_JPRB, 2.59077E-01_JPRB, 2.57091E-01_JPRB, 2.55120E-01_JPRB, &
+     & 2.53164E-01_JPRB, 2.51223E-01_JPRB, 2.49297E-01_JPRB, 2.47386E-01_JPRB, 2.45489E-01_JPRB, &
+     & 2.43607E-01_JPRB, 2.41739E-01_JPRB, 2.39886E-01_JPRB, 2.38047E-01_JPRB/)
+      KAO_MCO( 5, :,14) = (/ &
+     & 5.01880E-01_JPRB, 4.95066E-01_JPRB, 4.88344E-01_JPRB, 4.81713E-01_JPRB, 4.75173E-01_JPRB, &
+     & 4.68721E-01_JPRB, 4.62357E-01_JPRB, 4.56079E-01_JPRB, 4.49887E-01_JPRB, 4.43778E-01_JPRB, &
+     & 4.37753E-01_JPRB, 4.31809E-01_JPRB, 4.25946E-01_JPRB, 4.20163E-01_JPRB, 4.14458E-01_JPRB, &
+     & 4.08830E-01_JPRB, 4.03279E-01_JPRB, 3.97804E-01_JPRB, 3.92403E-01_JPRB/)
+      KAO_MCO( 6, :,14) = (/ &
+     & 9.46125E-01_JPRB, 9.29642E-01_JPRB, 9.13447E-01_JPRB, 8.97533E-01_JPRB, 8.81897E-01_JPRB, &
+     & 8.66533E-01_JPRB, 8.51437E-01_JPRB, 8.36603E-01_JPRB, 8.22029E-01_JPRB, 8.07708E-01_JPRB, &
+     & 7.93636E-01_JPRB, 7.79810E-01_JPRB, 7.66225E-01_JPRB, 7.52876E-01_JPRB, 7.39760E-01_JPRB, &
+     & 7.26872E-01_JPRB, 7.14209E-01_JPRB, 7.01766E-01_JPRB, 6.89540E-01_JPRB/)
+      KAO_MCO( 7, :,14) = (/ &
+     & 2.47697E+00_JPRB, 2.41183E+00_JPRB, 2.34840E+00_JPRB, 2.28664E+00_JPRB, 2.22650E+00_JPRB, &
+     & 2.16795E+00_JPRB, 2.11093E+00_JPRB, 2.05541E+00_JPRB, 2.00136E+00_JPRB, 1.94872E+00_JPRB, &
+     & 1.89747E+00_JPRB, 1.84757E+00_JPRB, 1.79898E+00_JPRB, 1.75167E+00_JPRB, 1.70560E+00_JPRB, &
+     & 1.66074E+00_JPRB, 1.61707E+00_JPRB, 1.57454E+00_JPRB, 1.53313E+00_JPRB/)
+      KAO_MCO( 8, :,14) = (/ &
+     & 2.19323E+00_JPRB, 2.13926E+00_JPRB, 2.08662E+00_JPRB, 2.03528E+00_JPRB, 1.98519E+00_JPRB, &
+     & 1.93635E+00_JPRB, 1.88870E+00_JPRB, 1.84222E+00_JPRB, 1.79689E+00_JPRB, 1.75268E+00_JPRB, &
+     & 1.70955E+00_JPRB, 1.66748E+00_JPRB, 1.62645E+00_JPRB, 1.58643E+00_JPRB, 1.54739E+00_JPRB, &
+     & 1.50932E+00_JPRB, 1.47218E+00_JPRB, 1.43595E+00_JPRB, 1.40062E+00_JPRB/)
+      KAO_MCO( 9, :,14) = (/ &
+     & 5.68351E-01_JPRB, 5.60360E-01_JPRB, 5.52481E-01_JPRB, 5.44712E-01_JPRB, 5.37053E-01_JPRB, &
+     & 5.29502E-01_JPRB, 5.22057E-01_JPRB, 5.14716E-01_JPRB, 5.07479E-01_JPRB, 5.00343E-01_JPRB, &
+     & 4.93308E-01_JPRB, 4.86372E-01_JPRB, 4.79533E-01_JPRB, 4.72790E-01_JPRB, 4.66142E-01_JPRB, &
+     & 4.59588E-01_JPRB, 4.53126E-01_JPRB, 4.46754E-01_JPRB, 4.40473E-01_JPRB/)
+      KAO_MCO( 1, :,15) = (/ &
+     & 7.87937E-04_JPRB, 1.01733E-03_JPRB, 1.31351E-03_JPRB, 1.69591E-03_JPRB, 2.18964E-03_JPRB, &
+     & 2.82712E-03_JPRB, 3.65018E-03_JPRB, 4.71286E-03_JPRB, 6.08493E-03_JPRB, 7.85644E-03_JPRB, &
+     & 1.01437E-02_JPRB, 1.30969E-02_JPRB, 1.69098E-02_JPRB, 2.18327E-02_JPRB, 2.81889E-02_JPRB, &
+     & 3.63956E-02_JPRB, 4.69915E-02_JPRB, 6.06722E-02_JPRB, 7.83357E-02_JPRB/)
+      KAO_MCO( 2, :,15) = (/ &
+     & 7.87937E-04_JPRB, 1.01733E-03_JPRB, 1.31351E-03_JPRB, 1.69591E-03_JPRB, 2.18964E-03_JPRB, &
+     & 2.82712E-03_JPRB, 3.65018E-03_JPRB, 4.71286E-03_JPRB, 6.08493E-03_JPRB, 7.85644E-03_JPRB, &
+     & 1.01437E-02_JPRB, 1.30969E-02_JPRB, 1.69098E-02_JPRB, 2.18327E-02_JPRB, 2.81889E-02_JPRB, &
+     & 3.63956E-02_JPRB, 4.69915E-02_JPRB, 6.06722E-02_JPRB, 7.83357E-02_JPRB/)
+      KAO_MCO( 3, :,15) = (/ &
+     & 1.97281E-01_JPRB, 2.00714E-01_JPRB, 2.04206E-01_JPRB, 2.07760E-01_JPRB, 2.11375E-01_JPRB, &
+     & 2.15053E-01_JPRB, 2.18795E-01_JPRB, 2.22603E-01_JPRB, 2.26476E-01_JPRB, 2.30417E-01_JPRB, &
+     & 2.34426E-01_JPRB, 2.38506E-01_JPRB, 2.42656E-01_JPRB, 2.46878E-01_JPRB, 2.51174E-01_JPRB, &
+     & 2.55545E-01_JPRB, 2.59992E-01_JPRB, 2.64516E-01_JPRB, 2.69119E-01_JPRB/)
+      KAO_MCO( 4, :,15) = (/ &
+     & 4.47509E-01_JPRB, 4.52222E-01_JPRB, 4.56985E-01_JPRB, 4.61799E-01_JPRB, 4.66663E-01_JPRB, &
+     & 4.71578E-01_JPRB, 4.76545E-01_JPRB, 4.81565E-01_JPRB, 4.86637E-01_JPRB, 4.91763E-01_JPRB, &
+     & 4.96942E-01_JPRB, 5.02177E-01_JPRB, 5.07466E-01_JPRB, 5.12811E-01_JPRB, 5.18213E-01_JPRB, &
+     & 5.23671E-01_JPRB, 5.29187E-01_JPRB, 5.34761E-01_JPRB, 5.40393E-01_JPRB/)
+      KAO_MCO( 5, :,15) = (/ &
+     & 1.02732E+00_JPRB, 1.02091E+00_JPRB, 1.01453E+00_JPRB, 1.00820E+00_JPRB, 1.00191E+00_JPRB, &
+     & 9.95660E-01_JPRB, 9.89447E-01_JPRB, 9.83273E-01_JPRB, 9.77137E-01_JPRB, 9.71039E-01_JPRB, &
+     & 9.64980E-01_JPRB, 9.58958E-01_JPRB, 9.52974E-01_JPRB, 9.47027E-01_JPRB, 9.41118E-01_JPRB, &
+     & 9.35245E-01_JPRB, 9.29409E-01_JPRB, 9.23609E-01_JPRB, 9.17846E-01_JPRB/)
+      KAO_MCO( 6, :,15) = (/ &
+     & 1.13766E+00_JPRB, 1.12944E+00_JPRB, 1.12128E+00_JPRB, 1.11318E+00_JPRB, 1.10514E+00_JPRB, &
+     & 1.09715E+00_JPRB, 1.08923E+00_JPRB, 1.08136E+00_JPRB, 1.07355E+00_JPRB, 1.06579E+00_JPRB, &
+     & 1.05809E+00_JPRB, 1.05045E+00_JPRB, 1.04286E+00_JPRB, 1.03532E+00_JPRB, 1.02784E+00_JPRB, &
+     & 1.02042E+00_JPRB, 1.01305E+00_JPRB, 1.00573E+00_JPRB, 9.98462E-01_JPRB/)
+      KAO_MCO( 7, :,15) = (/ &
+     & 1.13268E+00_JPRB, 1.12496E+00_JPRB, 1.11730E+00_JPRB, 1.10969E+00_JPRB, 1.10213E+00_JPRB, &
+     & 1.09462E+00_JPRB, 1.08717E+00_JPRB, 1.07976E+00_JPRB, 1.07241E+00_JPRB, 1.06510E+00_JPRB, &
+     & 1.05785E+00_JPRB, 1.05064E+00_JPRB, 1.04349E+00_JPRB, 1.03638E+00_JPRB, 1.02932E+00_JPRB, &
+     & 1.02231E+00_JPRB, 1.01535E+00_JPRB, 1.00843E+00_JPRB, 1.00156E+00_JPRB/)
+      KAO_MCO( 8, :,15) = (/ &
+     & 1.11982E+00_JPRB, 1.11343E+00_JPRB, 1.10707E+00_JPRB, 1.10075E+00_JPRB, 1.09447E+00_JPRB, &
+     & 1.08822E+00_JPRB, 1.08201E+00_JPRB, 1.07583E+00_JPRB, 1.06969E+00_JPRB, 1.06358E+00_JPRB, &
+     & 1.05751E+00_JPRB, 1.05147E+00_JPRB, 1.04547E+00_JPRB, 1.03950E+00_JPRB, 1.03356E+00_JPRB, &
+     & 1.02766E+00_JPRB, 1.02180E+00_JPRB, 1.01596E+00_JPRB, 1.01016E+00_JPRB/)
+      KAO_MCO( 9, :,15) = (/ &
+     & 1.03561E+00_JPRB, 1.02902E+00_JPRB, 1.02246E+00_JPRB, 1.01595E+00_JPRB, 1.00948E+00_JPRB, &
+     & 1.00305E+00_JPRB, 9.96667E-01_JPRB, 9.90320E-01_JPRB, 9.84013E-01_JPRB, 9.77747E-01_JPRB, &
+     & 9.71520E-01_JPRB, 9.65334E-01_JPRB, 9.59186E-01_JPRB, 9.53078E-01_JPRB, 9.47008E-01_JPRB, &
+     & 9.40978E-01_JPRB, 9.34985E-01_JPRB, 9.29031E-01_JPRB, 9.23115E-01_JPRB/)
+      KAO_MCO( 1, :,16) = (/ &
+     & 1.22217E-03_JPRB, 1.56836E-03_JPRB, 2.01261E-03_JPRB, 2.58271E-03_JPRB, 3.31429E-03_JPRB, &
+     & 4.25310E-03_JPRB, 5.45784E-03_JPRB, 7.00383E-03_JPRB, 8.98775E-03_JPRB, 1.15336E-02_JPRB, &
+     & 1.48007E-02_JPRB, 1.89931E-02_JPRB, 2.43731E-02_JPRB, 3.12771E-02_JPRB, 4.01367E-02_JPRB, &
+     & 5.15059E-02_JPRB, 6.60956E-02_JPRB, 8.48179E-02_JPRB, 1.08843E-01_JPRB/)
+      KAO_MCO( 2, :,16) = (/ &
+     & 1.22217E-03_JPRB, 1.56836E-03_JPRB, 2.01261E-03_JPRB, 2.58271E-03_JPRB, 3.31429E-03_JPRB, &
+     & 4.25310E-03_JPRB, 5.45784E-03_JPRB, 7.00383E-03_JPRB, 8.98775E-03_JPRB, 1.15336E-02_JPRB, &
+     & 1.48007E-02_JPRB, 1.89931E-02_JPRB, 2.43731E-02_JPRB, 3.12771E-02_JPRB, 4.01367E-02_JPRB, &
+     & 5.15059E-02_JPRB, 6.60956E-02_JPRB, 8.48179E-02_JPRB, 1.08843E-01_JPRB/)
+      KAO_MCO( 3, :,16) = (/ &
+     & 1.22217E-03_JPRB, 1.56836E-03_JPRB, 2.01261E-03_JPRB, 2.58271E-03_JPRB, 3.31429E-03_JPRB, &
+     & 4.25310E-03_JPRB, 5.45784E-03_JPRB, 7.00383E-03_JPRB, 8.98775E-03_JPRB, 1.15336E-02_JPRB, &
+     & 1.48007E-02_JPRB, 1.89931E-02_JPRB, 2.43731E-02_JPRB, 3.12771E-02_JPRB, 4.01367E-02_JPRB, &
+     & 5.15059E-02_JPRB, 6.60956E-02_JPRB, 8.48179E-02_JPRB, 1.08843E-01_JPRB/)
+      KAO_MCO( 4, :,16) = (/ &
+     & 1.01221E+00_JPRB, 1.01660E+00_JPRB, 1.02101E+00_JPRB, 1.02544E+00_JPRB, 1.02989E+00_JPRB, &
+     & 1.03436E+00_JPRB, 1.03884E+00_JPRB, 1.04335E+00_JPRB, 1.04788E+00_JPRB, 1.05243E+00_JPRB, &
+     & 1.05699E+00_JPRB, 1.06158E+00_JPRB, 1.06619E+00_JPRB, 1.07081E+00_JPRB, 1.07546E+00_JPRB, &
+     & 1.08012E+00_JPRB, 1.08481E+00_JPRB, 1.08952E+00_JPRB, 1.09425E+00_JPRB/)
+      KAO_MCO( 5, :,16) = (/ &
+     & 1.01221E+00_JPRB, 1.01660E+00_JPRB, 1.02101E+00_JPRB, 1.02544E+00_JPRB, 1.02989E+00_JPRB, &
+     & 1.03436E+00_JPRB, 1.03884E+00_JPRB, 1.04335E+00_JPRB, 1.04788E+00_JPRB, 1.05243E+00_JPRB, &
+     & 1.05699E+00_JPRB, 1.06158E+00_JPRB, 1.06619E+00_JPRB, 1.07081E+00_JPRB, 1.07546E+00_JPRB, &
+     & 1.08012E+00_JPRB, 1.08481E+00_JPRB, 1.08952E+00_JPRB, 1.09425E+00_JPRB/)
+      KAO_MCO( 6, :,16) = (/ &
+     & 1.01221E+00_JPRB, 1.01660E+00_JPRB, 1.02101E+00_JPRB, 1.02544E+00_JPRB, 1.02989E+00_JPRB, &
+     & 1.03436E+00_JPRB, 1.03884E+00_JPRB, 1.04335E+00_JPRB, 1.04788E+00_JPRB, 1.05243E+00_JPRB, &
+     & 1.05699E+00_JPRB, 1.06158E+00_JPRB, 1.06619E+00_JPRB, 1.07081E+00_JPRB, 1.07546E+00_JPRB, &
+     & 1.08012E+00_JPRB, 1.08481E+00_JPRB, 1.08952E+00_JPRB, 1.09425E+00_JPRB/)
+      KAO_MCO( 7, :,16) = (/ &
+     & 1.01221E+00_JPRB, 1.01660E+00_JPRB, 1.02101E+00_JPRB, 1.02544E+00_JPRB, 1.02989E+00_JPRB, &
+     & 1.03436E+00_JPRB, 1.03884E+00_JPRB, 1.04335E+00_JPRB, 1.04788E+00_JPRB, 1.05243E+00_JPRB, &
+     & 1.05699E+00_JPRB, 1.06158E+00_JPRB, 1.06619E+00_JPRB, 1.07081E+00_JPRB, 1.07546E+00_JPRB, &
+     & 1.08012E+00_JPRB, 1.08481E+00_JPRB, 1.08952E+00_JPRB, 1.09425E+00_JPRB/)
+      KAO_MCO( 8, :,16) = (/ &
+     & 1.01221E+00_JPRB, 1.01660E+00_JPRB, 1.02101E+00_JPRB, 1.02544E+00_JPRB, 1.02989E+00_JPRB, &
+     & 1.03436E+00_JPRB, 1.03884E+00_JPRB, 1.04335E+00_JPRB, 1.04788E+00_JPRB, 1.05243E+00_JPRB, &
+     & 1.05699E+00_JPRB, 1.06158E+00_JPRB, 1.06619E+00_JPRB, 1.07081E+00_JPRB, 1.07546E+00_JPRB, &
+     & 1.08012E+00_JPRB, 1.08481E+00_JPRB, 1.08952E+00_JPRB, 1.09425E+00_JPRB/)
+      KAO_MCO( 9, :,16) = (/ &
+     & 1.01221E+00_JPRB, 1.01660E+00_JPRB, 1.02101E+00_JPRB, 1.02544E+00_JPRB, 1.02989E+00_JPRB, &
+     & 1.03436E+00_JPRB, 1.03884E+00_JPRB, 1.04335E+00_JPRB, 1.04788E+00_JPRB, 1.05243E+00_JPRB, &
+     & 1.05699E+00_JPRB, 1.06158E+00_JPRB, 1.06619E+00_JPRB, 1.07081E+00_JPRB, 1.07546E+00_JPRB, &
+     & 1.08012E+00_JPRB, 1.08481E+00_JPRB, 1.08952E+00_JPRB, 1.09425E+00_JPRB/)
+
+!     The array KBO_Mxx contains the absorption coefficient for 
+!     a minor species at the 16 chosen g-values for a reference pressure
+!     level above 100~ mb.   The first index refers to temperature 
+!     in 7.2 degree increments.  For instance, JT = 1 refers to a 
+!     temperature of 188.0, JT = 2 refers to 195.2, etc. The second index 
+!     runs over the g-channel (1 to 16).
+
+      KBO_MO3(:, 1) = (/ &
+     & 1.07596E-02_JPRB, 1.12146E-02_JPRB, 1.16887E-02_JPRB, 1.21830E-02_JPRB, 1.26981E-02_JPRB, &
+     & 1.32350E-02_JPRB, 1.37946E-02_JPRB, 1.43779E-02_JPRB, 1.49858E-02_JPRB, 1.56194E-02_JPRB, &
+     & 1.62799E-02_JPRB, 1.69682E-02_JPRB, 1.76857E-02_JPRB, 1.84334E-02_JPRB, 1.92129E-02_JPRB, &
+     & 2.00252E-02_JPRB, 2.08719E-02_JPRB, 2.17544E-02_JPRB, 2.26743E-02_JPRB/)
+      KBO_MO3(:, 2) = (/ &
+     & 9.48276E-02_JPRB, 9.66591E-02_JPRB, 9.85260E-02_JPRB, 1.00429E-01_JPRB, 1.02369E-01_JPRB, &
+     & 1.04346E-01_JPRB, 1.06361E-01_JPRB, 1.08416E-01_JPRB, 1.10510E-01_JPRB, 1.12644E-01_JPRB, &
+     & 1.14820E-01_JPRB, 1.17037E-01_JPRB, 1.19298E-01_JPRB, 1.21602E-01_JPRB, 1.23951E-01_JPRB, &
+     & 1.26345E-01_JPRB, 1.28785E-01_JPRB, 1.31273E-01_JPRB, 1.33808E-01_JPRB/)
+      KBO_MO3(:, 3) = (/ &
+     & 3.54721E-01_JPRB, 3.55779E-01_JPRB, 3.56841E-01_JPRB, 3.57906E-01_JPRB, 3.58973E-01_JPRB, &
+     & 3.60044E-01_JPRB, 3.61119E-01_JPRB, 3.62196E-01_JPRB, 3.63277E-01_JPRB, 3.64360E-01_JPRB, &
+     & 3.65448E-01_JPRB, 3.66538E-01_JPRB, 3.67631E-01_JPRB, 3.68728E-01_JPRB, 3.69828E-01_JPRB, &
+     & 3.70932E-01_JPRB, 3.72038E-01_JPRB, 3.73148E-01_JPRB, 3.74262E-01_JPRB/)
+      KBO_MO3(:, 4) = (/ &
+     & 6.46454E-01_JPRB, 6.43823E-01_JPRB, 6.41202E-01_JPRB, 6.38593E-01_JPRB, 6.35994E-01_JPRB, &
+     & 6.33405E-01_JPRB, 6.30827E-01_JPRB, 6.28260E-01_JPRB, 6.25703E-01_JPRB, 6.23156E-01_JPRB, &
+     & 6.20620E-01_JPRB, 6.18094E-01_JPRB, 6.15578E-01_JPRB, 6.13073E-01_JPRB, 6.10578E-01_JPRB, &
+     & 6.08093E-01_JPRB, 6.05618E-01_JPRB, 6.03153E-01_JPRB, 6.00698E-01_JPRB/)
+      KBO_MO3(:, 5) = (/ &
+     & 9.29832E-01_JPRB, 9.22877E-01_JPRB, 9.15975E-01_JPRB, 9.09124E-01_JPRB, 9.02324E-01_JPRB, &
+     & 8.95576E-01_JPRB, 8.88877E-01_JPRB, 8.82229E-01_JPRB, 8.75631E-01_JPRB, 8.69082E-01_JPRB, &
+     & 8.62582E-01_JPRB, 8.56130E-01_JPRB, 8.49727E-01_JPRB, 8.43372E-01_JPRB, 8.37064E-01_JPRB, &
+     & 8.30803E-01_JPRB, 8.24589E-01_JPRB, 8.18422E-01_JPRB, 8.12301E-01_JPRB/)
+      KBO_MO3(:, 6) = (/ &
+     & 1.43531E+00_JPRB, 1.42616E+00_JPRB, 1.41706E+00_JPRB, 1.40802E+00_JPRB, 1.39903E+00_JPRB, &
+     & 1.39010E+00_JPRB, 1.38124E+00_JPRB, 1.37242E+00_JPRB, 1.36367E+00_JPRB, 1.35496E+00_JPRB, &
+     & 1.34632E+00_JPRB, 1.33773E+00_JPRB, 1.32919E+00_JPRB, 1.32071E+00_JPRB, 1.31229E+00_JPRB, &
+     & 1.30391E+00_JPRB, 1.29559E+00_JPRB, 1.28733E+00_JPRB, 1.27911E+00_JPRB/)
+      KBO_MO3(:, 7) = (/ &
+     & 2.68664E+00_JPRB, 2.67196E+00_JPRB, 2.65736E+00_JPRB, 2.64284E+00_JPRB, 2.62840E+00_JPRB, &
+     & 2.61404E+00_JPRB, 2.59975E+00_JPRB, 2.58555E+00_JPRB, 2.57142E+00_JPRB, 2.55737E+00_JPRB, &
+     & 2.54340E+00_JPRB, 2.52950E+00_JPRB, 2.51568E+00_JPRB, 2.50193E+00_JPRB, 2.48826E+00_JPRB, &
+     & 2.47466E+00_JPRB, 2.46114E+00_JPRB, 2.44769E+00_JPRB, 2.43432E+00_JPRB/)
+      KBO_MO3(:, 8) = (/ &
+     & 2.45343E+00_JPRB, 2.43442E+00_JPRB, 2.41556E+00_JPRB, 2.39684E+00_JPRB, 2.37827E+00_JPRB, &
+     & 2.35984E+00_JPRB, 2.34156E+00_JPRB, 2.32342E+00_JPRB, 2.30541E+00_JPRB, 2.28755E+00_JPRB, &
+     & 2.26983E+00_JPRB, 2.25224E+00_JPRB, 2.23479E+00_JPRB, 2.21747E+00_JPRB, 2.20029E+00_JPRB, &
+     & 2.18324E+00_JPRB, 2.16633E+00_JPRB, 2.14954E+00_JPRB, 2.13289E+00_JPRB/)
+      KBO_MO3(:, 9) = (/ &
+     & 1.55879E-01_JPRB, 1.55998E-01_JPRB, 1.56118E-01_JPRB, 1.56238E-01_JPRB, 1.56358E-01_JPRB, &
+     & 1.56478E-01_JPRB, 1.56599E-01_JPRB, 1.56719E-01_JPRB, 1.56840E-01_JPRB, 1.56960E-01_JPRB, &
+     & 1.57081E-01_JPRB, 1.57201E-01_JPRB, 1.57322E-01_JPRB, 1.57443E-01_JPRB, 1.57564E-01_JPRB, &
+     & 1.57685E-01_JPRB, 1.57806E-01_JPRB, 1.57928E-01_JPRB, 1.58049E-01_JPRB/)
+      KBO_MO3(:,10) = (/ &
+     & 8.75149E-03_JPRB, 8.88794E-03_JPRB, 9.02651E-03_JPRB, 9.16725E-03_JPRB, 9.31018E-03_JPRB, &
+     & 9.45534E-03_JPRB, 9.60276E-03_JPRB, 9.75248E-03_JPRB, 9.90454E-03_JPRB, 1.00590E-02_JPRB, &
+     & 1.02158E-02_JPRB, 1.03751E-02_JPRB, 1.05368E-02_JPRB, 1.07011E-02_JPRB, 1.08680E-02_JPRB, &
+     & 1.10374E-02_JPRB, 1.12095E-02_JPRB, 1.13843E-02_JPRB, 1.15618E-02_JPRB/)
+      KBO_MO3(:,11) = (/ &
+     & 8.83874E-03_JPRB, 8.97926E-03_JPRB, 9.12201E-03_JPRB, 9.26703E-03_JPRB, 9.41436E-03_JPRB, &
+     & 9.56403E-03_JPRB, 9.71608E-03_JPRB, 9.87055E-03_JPRB, 1.00275E-02_JPRB, 1.01869E-02_JPRB, &
+     & 1.03488E-02_JPRB, 1.05134E-02_JPRB, 1.06805E-02_JPRB, 1.08503E-02_JPRB, 1.10228E-02_JPRB, &
+     & 1.11980E-02_JPRB, 1.13761E-02_JPRB, 1.15569E-02_JPRB, 1.17407E-02_JPRB/)
+      KBO_MO3(:,12) = (/ &
+     & 9.59461E-03_JPRB, 9.70417E-03_JPRB, 9.81498E-03_JPRB, 9.92705E-03_JPRB, 1.00404E-02_JPRB, &
+     & 1.01550E-02_JPRB, 1.02710E-02_JPRB, 1.03883E-02_JPRB, 1.05069E-02_JPRB, 1.06269E-02_JPRB, &
+     & 1.07482E-02_JPRB, 1.08709E-02_JPRB, 1.09951E-02_JPRB, 1.11206E-02_JPRB, 1.12476E-02_JPRB, &
+     & 1.13760E-02_JPRB, 1.15059E-02_JPRB, 1.16373E-02_JPRB, 1.17702E-02_JPRB/)
+      KBO_MO3(:,13) = (/ &
+     & 1.13077E-02_JPRB, 1.14079E-02_JPRB, 1.15089E-02_JPRB, 1.16109E-02_JPRB, 1.17138E-02_JPRB, &
+     & 1.18176E-02_JPRB, 1.19223E-02_JPRB, 1.20279E-02_JPRB, 1.21344E-02_JPRB, 1.22419E-02_JPRB, &
+     & 1.23504E-02_JPRB, 1.24598E-02_JPRB, 1.25702E-02_JPRB, 1.26816E-02_JPRB, 1.27939E-02_JPRB, &
+     & 1.29073E-02_JPRB, 1.30216E-02_JPRB, 1.31370E-02_JPRB, 1.32534E-02_JPRB/)
+      KBO_MO3(:,14) = (/ &
+     & 6.74844E-03_JPRB, 6.82637E-03_JPRB, 6.90519E-03_JPRB, 6.98493E-03_JPRB, 7.06558E-03_JPRB, &
+     & 7.14717E-03_JPRB, 7.22970E-03_JPRB, 7.31318E-03_JPRB, 7.39762E-03_JPRB, 7.48304E-03_JPRB, &
+     & 7.56945E-03_JPRB, 7.65686E-03_JPRB, 7.74527E-03_JPRB, 7.83470E-03_JPRB, 7.92517E-03_JPRB, &
+     & 8.01668E-03_JPRB, 8.10925E-03_JPRB, 8.20289E-03_JPRB, 8.29761E-03_JPRB/)
+      KBO_MO3(:,15) = (/ &
+     & 7.94595E-03_JPRB, 8.00015E-03_JPRB, 8.05472E-03_JPRB, 8.10966E-03_JPRB, 8.16497E-03_JPRB, &
+     & 8.22067E-03_JPRB, 8.27674E-03_JPRB, 8.33320E-03_JPRB, 8.39004E-03_JPRB, 8.44727E-03_JPRB, &
+     & 8.50489E-03_JPRB, 8.56290E-03_JPRB, 8.62130E-03_JPRB, 8.68011E-03_JPRB, 8.73932E-03_JPRB, &
+     & 8.79893E-03_JPRB, 8.85895E-03_JPRB, 8.91937E-03_JPRB, 8.98021E-03_JPRB/)
+      KBO_MO3(:,16) = (/ &
+     & 1.85967E-03_JPRB, 1.86082E-03_JPRB, 1.86197E-03_JPRB, 1.86312E-03_JPRB, 1.86428E-03_JPRB, &
+     & 1.86543E-03_JPRB, 1.86658E-03_JPRB, 1.86774E-03_JPRB, 1.86889E-03_JPRB, 1.87005E-03_JPRB, &
+     & 1.87121E-03_JPRB, 1.87236E-03_JPRB, 1.87352E-03_JPRB, 1.87468E-03_JPRB, 1.87584E-03_JPRB, &
+     & 1.87700E-03_JPRB, 1.87816E-03_JPRB, 1.87932E-03_JPRB, 1.88049E-03_JPRB/)
+
+!     The array FORREFO contains the coefficient of the water vapor
+!     foreign-continuum (including the energy term).  The first 
+!     index refers to reference temperature (296,260,224,260) and 
+!     pressure (970,475,219,3 mbar) levels.  The second index 
+!     runs over the g-channel (1 to 16).
+
+      FORREFO(1,:) = (/ &
+     &1.6586E-05_JPRB,1.9995E-05_JPRB,1.8582E-05_JPRB,1.3988E-05_JPRB,1.3650E-05_JPRB,1.1079E-05_JPRB, &
+     &9.5855E-06_JPRB,8.4062E-06_JPRB,1.3558E-05_JPRB,1.8620E-05_JPRB,2.2652E-05_JPRB,1.7883E-05_JPRB, &
+     &2.6241E-05_JPRB,3.1171E-05_JPRB,3.9386E-05_JPRB,4.4415E-05_JPRB/)
+      FORREFO(2,:) = (/ &
+     &2.0730E-05_JPRB,2.3258E-05_JPRB,2.1543E-05_JPRB,1.5660E-05_JPRB,9.7872E-06_JPRB,8.1078E-06_JPRB, &
+     &7.0246E-06_JPRB,6.0428E-06_JPRB,4.8793E-06_JPRB,4.4937E-06_JPRB,4.7078E-06_JPRB,4.6898E-06_JPRB, &
+     &6.9481E-06_JPRB,8.6269E-06_JPRB,3.1761E-06_JPRB,3.1440E-06_JPRB/)
+      FORREFO(3,:) = (/ &
+     &1.5737E-05_JPRB,2.2501E-05_JPRB,2.3520E-05_JPRB,2.0288E-05_JPRB,1.2083E-05_JPRB,6.8256E-06_JPRB, &
+     &6.0637E-06_JPRB,5.5434E-06_JPRB,4.3888E-06_JPRB,3.8435E-06_JPRB,3.8477E-06_JPRB,3.8314E-06_JPRB, &
+     &3.8251E-06_JPRB,3.3637E-06_JPRB,3.1950E-06_JPRB,3.1440E-06_JPRB/)
+      FORREFO(4,:) = (/ &
+     &1.1400E-05_JPRB,7.9751E-06_JPRB,8.8659E-06_JPRB,1.5884E-05_JPRB,1.9118E-05_JPRB,1.9429E-05_JPRB, &
+     &2.0532E-05_JPRB,2.2155E-05_JPRB,2.3894E-05_JPRB,2.2984E-05_JPRB,2.3731E-05_JPRB,2.4538E-05_JPRB, &
+     &2.6697E-05_JPRB,1.9329E-05_JPRB,3.3306E-06_JPRB,3.2018E-06_JPRB/)
+
+
+!     The array SELFREFO contains the coefficient of the water vapor
+!     self-continuum (including the energy term).  The first index
+!     refers to temperature in 7.2 degree increments.  For instance,
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+!     etc.  The second index runs over the g-channel (1 to 16).
+
+      SELFREFO(:, 1) = (/ &
+     & 9.62275E-03_JPRB, 8.29909E-03_JPRB, 7.15750E-03_JPRB, 6.17294E-03_JPRB, 5.32382E-03_JPRB, &
+     & 4.59150E-03_JPRB, 3.95991E-03_JPRB, 3.41520E-03_JPRB, 2.94542E-03_JPRB, 2.54026E-03_JPRB/)
+      SELFREFO(:, 2) = (/ &
+     & 9.76664E-03_JPRB, 8.47783E-03_JPRB, 7.35910E-03_JPRB, 6.38799E-03_JPRB, 5.54504E-03_JPRB, &
+     & 4.81331E-03_JPRB, 4.17815E-03_JPRB, 3.62680E-03_JPRB, 3.14821E-03_JPRB, 2.73277E-03_JPRB/)
+      SELFREFO(:, 3) = (/ &
+     & 9.53856E-03_JPRB, 8.23750E-03_JPRB, 7.11390E-03_JPRB, 6.14356E-03_JPRB, 5.30558E-03_JPRB, &
+     & 4.58190E-03_JPRB, 3.95693E-03_JPRB, 3.41720E-03_JPRB, 2.95109E-03_JPRB, 2.54856E-03_JPRB/)
+      SELFREFO(:, 4) = (/ &
+     & 8.47621E-03_JPRB, 7.29518E-03_JPRB, 6.27870E-03_JPRB, 5.40385E-03_JPRB, 4.65091E-03_JPRB, &
+     & 4.00287E-03_JPRB, 3.44513E-03_JPRB, 2.96510E-03_JPRB, 2.55196E-03_JPRB, 2.19638E-03_JPRB/)
+      SELFREFO(:, 5) = (/ &
+     & 6.71258E-03_JPRB, 5.95346E-03_JPRB, 5.28020E-03_JPRB, 4.68307E-03_JPRB, 4.15348E-03_JPRB, &
+     & 3.68377E-03_JPRB, 3.26718E-03_JPRB, 2.89770E-03_JPRB, 2.57000E-03_JPRB, 2.27937E-03_JPRB/)
+      SELFREFO(:, 6) = (/ &
+     & 6.29140E-03_JPRB, 5.55557E-03_JPRB, 4.90580E-03_JPRB, 4.33203E-03_JPRB, 3.82536E-03_JPRB, &
+     & 3.37795E-03_JPRB, 2.98287E-03_JPRB, 2.63400E-03_JPRB, 2.32593E-03_JPRB, 2.05389E-03_JPRB/)
+      SELFREFO(:, 7) = (/ &
+     & 6.00229E-03_JPRB, 5.28180E-03_JPRB, 4.64780E-03_JPRB, 4.08990E-03_JPRB, 3.59897E-03_JPRB, &
+     & 3.16696E-03_JPRB, 2.78682E-03_JPRB, 2.45230E-03_JPRB, 2.15794E-03_JPRB, 1.89891E-03_JPRB/)
+      SELFREFO(:, 8) = (/ &
+     & 5.78892E-03_JPRB, 5.07191E-03_JPRB, 4.44370E-03_JPRB, 3.89330E-03_JPRB, 3.41108E-03_JPRB, &
+     & 2.98858E-03_JPRB, 2.61842E-03_JPRB, 2.29410E-03_JPRB, 2.00995E-03_JPRB, 1.76100E-03_JPRB/)
+      SELFREFO(:, 9) = (/ &
+     & 4.96186E-03_JPRB, 4.56767E-03_JPRB, 4.20480E-03_JPRB, 3.87076E-03_JPRB, 3.56325E-03_JPRB, &
+     & 3.28017E-03_JPRB, 3.01959E-03_JPRB, 2.77970E-03_JPRB, 2.55887E-03_JPRB, 2.35559E-03_JPRB/)
+      SELFREFO(:,10) = (/ &
+     & 4.56849E-03_JPRB, 4.35527E-03_JPRB, 4.15200E-03_JPRB, 3.95822E-03_JPRB, 3.77348E-03_JPRB, &
+     & 3.59736E-03_JPRB, 3.42946E-03_JPRB, 3.26940E-03_JPRB, 3.11681E-03_JPRB, 2.97134E-03_JPRB/)
+      SELFREFO(:,11) = (/ &
+     & 4.47310E-03_JPRB, 4.32453E-03_JPRB, 4.18090E-03_JPRB, 4.04204E-03_JPRB, 3.90779E-03_JPRB, &
+     & 3.77799E-03_JPRB, 3.65251E-03_JPRB, 3.53120E-03_JPRB, 3.41392E-03_JPRB, 3.30053E-03_JPRB/)
+      SELFREFO(:,12) = (/ &
+     & 4.46459E-03_JPRB, 4.24031E-03_JPRB, 4.02730E-03_JPRB, 3.82499E-03_JPRB, 3.63284E-03_JPRB, &
+     & 3.45035E-03_JPRB, 3.27702E-03_JPRB, 3.11240E-03_JPRB, 2.95605E-03_JPRB, 2.80755E-03_JPRB/)
+      SELFREFO(:,13) = (/ &
+     & 4.43961E-03_JPRB, 4.35658E-03_JPRB, 4.27510E-03_JPRB, 4.19514E-03_JPRB, 4.11669E-03_JPRB, &
+     & 4.03969E-03_JPRB, 3.96414E-03_JPRB, 3.89000E-03_JPRB, 3.81725E-03_JPRB, 3.74585E-03_JPRB/)
+      SELFREFO(:,14) = (/ &
+     & 4.40512E-03_JPRB, 4.41515E-03_JPRB, 4.42520E-03_JPRB, 4.43527E-03_JPRB, 4.44537E-03_JPRB, &
+     & 4.45549E-03_JPRB, 4.46563E-03_JPRB, 4.47580E-03_JPRB, 4.48599E-03_JPRB, 4.49620E-03_JPRB/)
+      SELFREFO(:,15) = (/ &
+     & 3.21965E-03_JPRB, 3.42479E-03_JPRB, 3.64300E-03_JPRB, 3.87512E-03_JPRB, 4.12202E-03_JPRB, &
+     & 4.38466E-03_JPRB, 4.66403E-03_JPRB, 4.96120E-03_JPRB, 5.27731E-03_JPRB, 5.61355E-03_JPRB/)
+      SELFREFO(:,16) = (/ &
+     & 3.11402E-03_JPRB, 3.35870E-03_JPRB, 3.62260E-03_JPRB, 3.90724E-03_JPRB, 4.21424E-03_JPRB, &
+     & 4.54536E-03_JPRB, 4.90250E-03_JPRB, 5.28770E-03_JPRB, 5.70317E-03_JPRB, 6.15128E-03_JPRB/)
+
+
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB13',1,ZHOOK_HANDLE)
+RETURN
+
+1001 CONTINUE
+CALL ABOR1("RRTM_KGB13:ERROR READING FILE RADRRTM")
+
+END SUBROUTINE RRTM_KGB13
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb13.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb13.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb13.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_KGB13
+END SUBROUTINE RRTM_KGB13
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb14.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb14.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb14.F90	(revision 3908)
@@ -0,0 +1,170 @@
+SUBROUTINE RRTM_KGB14
+
+!     Originally by Eli J. Mlawer, Atmospheric & Environmental Research.
+!     BAND 14:  2250-2380 cm-1 (low - CO2; high - CO2)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+!     G.Mozdzynski March 2011 read constants from files
+!     ABozzo 201306 updated to rrtmg v4.85
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+USE YOMLUN    ,ONLY : NULRAD
+USE YOMMP0    , ONLY : NPROC, MYPROC
+USE MPL_MODULE,ONLY : MPL_BROADCAST
+USE YOMTAG    ,ONLY : MTAGRAD
+
+USE YOERRTO14, ONLY : KAO     ,KBO     ,KAO_D,KBO_D,SELFREFO, FORREFO ,FRACREFAO  ,FRACREFBO
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB14',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+  READ(NULRAD,ERR=1001) KAO_D,KBO_D
+ ! Convert the data into model actual precision.
+  KAO = REAL(KAO_D,JPRB)
+  KBO = REAL(KBO_D,JPRB) 
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KAO,MTAGRAD,1,CDSTRING='RRTM_KGB14:')
+  CALL MPL_BROADCAST (KBO,MTAGRAD,1,CDSTRING='RRTM_KGB14:')
+ENDIF
+
+! Planck fraction mapping level : P = 142.5940 mb, T = 215.70 K
+      FRACREFAO(:) = (/ &
+     &  1.9360E-01_JPRB, 1.7276E-01_JPRB, 1.4811E-01_JPRB, 1.2238E-01_JPRB, &
+     &  1.0242E-01_JPRB, 8.6830E-02_JPRB, 7.1890E-02_JPRB, 5.4030E-02_JPRB, &
+     &  3.5075E-02_JPRB, 3.8052E-03_JPRB, 3.1458E-03_JPRB, 2.4873E-03_JPRB, &
+     &  1.8182E-03_JPRB, 1.1563E-03_JPRB, 4.3251E-04_JPRB, 5.7744E-05_JPRB/)
+
+! Planck fraction mapping level : P = 4.758820mb, T = 250.85 K
+      FRACREFBO(:) = (/ &
+     &  1.8599E-01_JPRB, 1.6646E-01_JPRB, 1.4264E-01_JPRB, 1.2231E-01_JPRB, &
+     &  1.0603E-01_JPRB, 9.2014E-02_JPRB, 7.5287E-02_JPRB, 5.6758E-02_JPRB, &
+     &  3.8386E-02_JPRB, 4.2139E-03_JPRB, 3.5399E-03_JPRB, 2.7381E-03_JPRB, &
+     &  1.9202E-03_JPRB, 1.2083E-03_JPRB, 4.5395E-04_JPRB, 6.2699E-05_JPRB/)
+
+!     ------------------------------------------------------------------
+
+!     The array KAO contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels > ~100mb and temperatures.  The first
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the corresponding TREF for this  pressure level, 
+!     JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, 
+!     JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  The second 
+!     index, JP, runs from 1 to 13 and refers to the corresponding 
+!     pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).  
+!     The third index, IG, goes from 1 to 16, and tells us which 
+!     g-interval the absorption coefficients are for.
+
+
+
+!     The array KBO contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels < ~100mb and temperatures. The first 
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the reference temperature TREF for this pressure 
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
+!     The second index, JP, runs from 13 to 59 and refers to the JPth
+!     reference pressure level (see taumol.f for the value of these
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
+!     and tells us which g-interval the absorption coefficients are for.
+
+
+!     The array FORREFO contains the coefficient of the water vapor
+!     foreign-continuum (including the energy term).  The first 
+!     index refers to reference temperature (296,260,224,260) and 
+!     pressure (970,475,219,3 mbar) levels.  The second index 
+!     runs over the g-channel (1 to 16).
+
+      FORREFO(1,:) = (/ &
+     &2.7075E-06_JPRB,2.2609E-06_JPRB,1.5633E-06_JPRB,8.7484E-07_JPRB,5.5470E-07_JPRB,4.8456E-07_JPRB, &
+     &4.7463E-07_JPRB,4.6154E-07_JPRB,4.4425E-07_JPRB,4.2960E-07_JPRB,4.2626E-07_JPRB,4.1715E-07_JPRB, &
+     &4.2607E-07_JPRB,3.6616E-07_JPRB,2.6366E-07_JPRB,2.6029E-07_JPRB/)
+      FORREFO(2,:) = (/ &
+     &2.6759E-06_JPRB,2.2237E-06_JPRB,1.4466E-06_JPRB,9.3032E-07_JPRB,6.4927E-07_JPRB,5.4809E-07_JPRB, &
+     &4.9504E-07_JPRB,4.6305E-07_JPRB,4.4873E-07_JPRB,4.2146E-07_JPRB,4.2176E-07_JPRB,4.2812E-07_JPRB, &
+     &4.0529E-07_JPRB,4.0969E-07_JPRB,2.9442E-07_JPRB,2.6821E-07_JPRB/)
+      FORREFO(3,:) = (/ &
+     &2.6608E-06_JPRB,2.1140E-06_JPRB,1.4838E-06_JPRB,9.2083E-07_JPRB,6.3350E-07_JPRB,5.7195E-07_JPRB, &
+     &6.2253E-07_JPRB,5.1783E-07_JPRB,4.4749E-07_JPRB,4.3261E-07_JPRB,4.2553E-07_JPRB,4.2175E-07_JPRB, &
+     &4.1085E-07_JPRB,4.0358E-07_JPRB,3.5340E-07_JPRB,2.7191E-07_JPRB/)
+      FORREFO(4,:) = (/ &
+     &2.6412E-06_JPRB,1.9814E-06_JPRB,1.2672E-06_JPRB,8.1129E-07_JPRB,7.1447E-07_JPRB,7.5026E-07_JPRB, &
+     &7.4386E-07_JPRB,7.2759E-07_JPRB,7.3583E-07_JPRB,7.6493E-07_JPRB,8.8959E-07_JPRB,7.5534E-07_JPRB, &
+     &5.3734E-07_JPRB,4.5572E-07_JPRB,4.1676E-07_JPRB,3.6198E-07_JPRB/)
+
+
+!     The array SELFREFO contains the coefficient of the water vapor
+!     self-continuum (including the energy term).  The first index
+!     refers to temperature in 7.2 degree increments.  For instance,
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+!     etc.  The second index runs over the g-channel (1 to 16).
+
+      SELFREFO(:, 1) = (/ &
+     & 4.67262E-03_JPRB, 3.95211E-03_JPRB, 3.34270E-03_JPRB, 2.82726E-03_JPRB, 2.39130E-03_JPRB, &
+     & 2.02256E-03_JPRB, 1.71069E-03_JPRB, 1.44690E-03_JPRB, 1.22379E-03_JPRB, 1.03508E-03_JPRB/)
+      SELFREFO(:, 2) = (/ &
+     & 4.42593E-03_JPRB, 3.73338E-03_JPRB, 3.14920E-03_JPRB, 2.65643E-03_JPRB, 2.24076E-03_JPRB, &
+     & 1.89014E-03_JPRB, 1.59438E-03_JPRB, 1.34490E-03_JPRB, 1.13446E-03_JPRB, 9.56943E-04_JPRB/)
+      SELFREFO(:, 3) = (/ &
+     & 3.96072E-03_JPRB, 3.33789E-03_JPRB, 2.81300E-03_JPRB, 2.37065E-03_JPRB, 1.99786E-03_JPRB, &
+     & 1.68369E-03_JPRB, 1.41893E-03_JPRB, 1.19580E-03_JPRB, 1.00776E-03_JPRB, 8.49286E-04_JPRB/)
+      SELFREFO(:, 4) = (/ &
+     & 3.71833E-03_JPRB, 3.10030E-03_JPRB, 2.58500E-03_JPRB, 2.15535E-03_JPRB, 1.79711E-03_JPRB, &
+     & 1.49841E-03_JPRB, 1.24936E-03_JPRB, 1.04170E-03_JPRB, 8.68558E-04_JPRB, 7.24195E-04_JPRB/)
+      SELFREFO(:, 5) = (/ &
+     & 3.55755E-03_JPRB, 2.95355E-03_JPRB, 2.45210E-03_JPRB, 2.03578E-03_JPRB, 1.69015E-03_JPRB, &
+     & 1.40320E-03_JPRB, 1.16497E-03_JPRB, 9.67180E-04_JPRB, 8.02973E-04_JPRB, 6.66646E-04_JPRB/)
+      SELFREFO(:, 6) = (/ &
+     & 3.47601E-03_JPRB, 2.88628E-03_JPRB, 2.39660E-03_JPRB, 1.99000E-03_JPRB, 1.65238E-03_JPRB, &
+     & 1.37204E-03_JPRB, 1.13927E-03_JPRB, 9.45980E-04_JPRB, 7.85487E-04_JPRB, 6.52224E-04_JPRB/)
+      SELFREFO(:, 7) = (/ &
+     & 3.44479E-03_JPRB, 2.86224E-03_JPRB, 2.37820E-03_JPRB, 1.97602E-03_JPRB, 1.64185E-03_JPRB, &
+     & 1.36420E-03_JPRB, 1.13350E-03_JPRB, 9.41810E-04_JPRB, 7.82539E-04_JPRB, 6.50204E-04_JPRB/)
+      SELFREFO(:, 8) = (/ &
+     & 3.40154E-03_JPRB, 2.82953E-03_JPRB, 2.35370E-03_JPRB, 1.95789E-03_JPRB, 1.62864E-03_JPRB, &
+     & 1.35476E-03_JPRB, 1.12694E-03_JPRB, 9.37430E-04_JPRB, 7.79788E-04_JPRB, 6.48655E-04_JPRB/)
+      SELFREFO(:, 9) = (/ &
+     & 3.39380E-03_JPRB, 2.82288E-03_JPRB, 2.34800E-03_JPRB, 1.95301E-03_JPRB, 1.62446E-03_JPRB, &
+     & 1.35119E-03_JPRB, 1.12389E-03_JPRB, 9.34820E-04_JPRB, 7.77560E-04_JPRB, 6.46755E-04_JPRB/)
+      SELFREFO(:,10) = (/ &
+     & 3.37185E-03_JPRB, 2.80654E-03_JPRB, 2.33600E-03_JPRB, 1.94435E-03_JPRB, 1.61837E-03_JPRB, &
+     & 1.34704E-03_JPRB, 1.12120E-03_JPRB, 9.33220E-04_JPRB, 7.76759E-04_JPRB, 6.46530E-04_JPRB/)
+      SELFREFO(:,11) = (/ &
+     & 3.37924E-03_JPRB, 2.81172E-03_JPRB, 2.33950E-03_JPRB, 1.94659E-03_JPRB, 1.61967E-03_JPRB, &
+     & 1.34765E-03_JPRB, 1.12132E-03_JPRB, 9.33000E-04_JPRB, 7.76306E-04_JPRB, 6.45930E-04_JPRB/)
+      SELFREFO(:,12) = (/ &
+     & 3.39658E-03_JPRB, 2.82289E-03_JPRB, 2.34610E-03_JPRB, 1.94984E-03_JPRB, 1.62051E-03_JPRB, &
+     & 1.34680E-03_JPRB, 1.11933E-03_JPRB, 9.30270E-04_JPRB, 7.73146E-04_JPRB, 6.42561E-04_JPRB/)
+      SELFREFO(:,13) = (/ &
+     & 3.36070E-03_JPRB, 2.79913E-03_JPRB, 2.33140E-03_JPRB, 1.94183E-03_JPRB, 1.61735E-03_JPRB, &
+     & 1.34709E-03_JPRB, 1.12199E-03_JPRB, 9.34510E-04_JPRB, 7.78354E-04_JPRB, 6.48292E-04_JPRB/)
+      SELFREFO(:,14) = (/ &
+     & 3.40428E-03_JPRB, 2.81994E-03_JPRB, 2.33590E-03_JPRB, 1.93495E-03_JPRB, 1.60282E-03_JPRB, &
+     & 1.32770E-03_JPRB, 1.09980E-03_JPRB, 9.11020E-04_JPRB, 7.54645E-04_JPRB, 6.25111E-04_JPRB/)
+      SELFREFO(:,15) = (/ &
+     & 3.27075E-03_JPRB, 2.70783E-03_JPRB, 2.24180E-03_JPRB, 1.85597E-03_JPRB, 1.53655E-03_JPRB, &
+     & 1.27210E-03_JPRB, 1.05317E-03_JPRB, 8.71910E-04_JPRB, 7.21849E-04_JPRB, 5.97615E-04_JPRB/)
+      SELFREFO(:,16) = (/ &
+     & 3.23123E-03_JPRB, 2.67891E-03_JPRB, 2.22100E-03_JPRB, 1.84136E-03_JPRB, 1.52661E-03_JPRB, &
+     & 1.26567E-03_JPRB, 1.04932E-03_JPRB, 8.69960E-04_JPRB, 7.21256E-04_JPRB, 5.97970E-04_JPRB/)
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB14',1,ZHOOK_HANDLE)
+RETURN
+
+1001 CONTINUE
+CALL ABOR1("RRTM_KGB14:ERROR READING FILE RADRRTM")
+
+END SUBROUTINE RRTM_KGB14
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb14.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb14.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb14.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_KGB14
+END SUBROUTINE RRTM_KGB14
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb15.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb15.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb15.F90	(revision 3908)
@@ -0,0 +1,918 @@
+SUBROUTINE RRTM_KGB15
+
+!     Originally by Eli J. Mlawer, Atmospheric & Environmental Research.
+!     BAND 15:  2380-2600 cm-1 (low - N2O,CO2; high - nothing)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+!     G.Mozdzynski March 2011 read constants from files
+!     ABozzo 2001306 updated to rrtmg v4.85
+!     band 15:  2380-2600 cm-1 (low - n2o,co2; low minor - n2)
+!                              (high - nothing)
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+USE YOMLUN    ,ONLY : NULRAD
+USE MPL_MODULE,ONLY : MPL_BROADCAST
+USE YOMTAG    ,ONLY : MTAGRAD
+USE YOMMP0    , ONLY : NPROC, MYPROC
+
+USE YOERRTO15, ONLY : KAO,KAO_D,KAO_MN2  ,SELFREFO,FORREFO   ,FRACREFAO
+
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB15',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+  READ(NULRAD,ERR=1001) KAO_D
+  KAO = REAL(KAO_D,JPRB)
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KAO,MTAGRAD,1,CDSTRING='RRTM_KGB15:')
+ENDIF
+
+! Planck fraction mapping level : P = 1053. mb, T = 294.2 K
+      FRACREFAO(:, 1) = (/ &
+     &  1.0689E-01_JPRB,1.1563E-01_JPRB,1.2447E-01_JPRB,1.2921E-01_JPRB,1.2840E-01_JPRB,1.2113E-01_JPRB, &
+     &  1.0643E-01_JPRB,8.4987E-02_JPRB,6.0142E-02_JPRB,6.6798E-03_JPRB,5.5293E-03_JPRB,4.3700E-03_JPRB, &
+     &  3.2061E-03_JPRB,2.0476E-03_JPRB,7.7366E-04_JPRB,1.0897E-04_JPRB/)
+      FRACREFAO(:, 2) = (/ &
+     &  1.0782E-01_JPRB,1.1637E-01_JPRB,1.2290E-01_JPRB,1.2911E-01_JPRB,1.2841E-01_JPRB,1.2113E-01_JPRB, &
+     &  1.0643E-01_JPRB,8.4987E-02_JPRB,6.0142E-02_JPRB,6.6798E-03_JPRB,5.5293E-03_JPRB,4.3700E-03_JPRB, &
+     &  3.2061E-03_JPRB,2.0476E-03_JPRB,7.7366E-04_JPRB,1.0897E-04_JPRB/)
+      FRACREFAO(:, 3) = (/ &
+     &  1.0858E-01_JPRB,1.1860E-01_JPRB,1.2237E-01_JPRB,1.2665E-01_JPRB,1.2841E-01_JPRB,1.2111E-01_JPRB, &
+     &  1.0642E-01_JPRB,8.4987E-02_JPRB,6.0142E-02_JPRB,6.6798E-03_JPRB,5.5293E-03_JPRB,4.3700E-03_JPRB, &
+     &  3.2061E-03_JPRB,2.0476E-03_JPRB,7.7366E-04_JPRB,1.0897E-04_JPRB/)
+      FRACREFAO(:, 4) = (/ &
+     &  1.1022E-01_JPRB,1.1965E-01_JPRB,1.2334E-01_JPRB,1.2383E-01_JPRB,1.2761E-01_JPRB,1.2109E-01_JPRB, &
+     &  1.0642E-01_JPRB,8.4987E-02_JPRB,6.0142E-02_JPRB,6.6798E-03_JPRB,5.5293E-03_JPRB,4.3700E-03_JPRB, &
+     &  3.2061E-03_JPRB,2.0476E-03_JPRB,7.7366E-04_JPRB,1.0897E-04_JPRB/)
+      FRACREFAO(:, 5) = (/ &
+     &  1.1342E-01_JPRB,1.2069E-01_JPRB,1.2360E-01_JPRB,1.2447E-01_JPRB,1.2340E-01_JPRB,1.2020E-01_JPRB, &
+     &  1.0639E-01_JPRB,8.4987E-02_JPRB,6.0142E-02_JPRB,6.6798E-03_JPRB,5.5293E-03_JPRB,4.3700E-03_JPRB, &
+     &  3.2061E-03_JPRB,2.0476E-03_JPRB,7.7366E-04_JPRB,1.0897E-04_JPRB/)
+      FRACREFAO(:, 6) = (/ &
+     &  1.1771E-01_JPRB,1.2280E-01_JPRB,1.2177E-01_JPRB,1.2672E-01_JPRB,1.2398E-01_JPRB,1.1787E-01_JPRB, &
+     &  1.0131E-01_JPRB,8.4987E-02_JPRB,6.0142E-02_JPRB,6.6798E-03_JPRB,5.5293E-03_JPRB,4.3700E-03_JPRB, &
+     &  3.2061E-03_JPRB,2.0476E-03_JPRB,7.7366E-04_JPRB,1.0897E-04_JPRB/)
+      FRACREFAO(:, 7) = (/ &
+     &  1.2320E-01_JPRB,1.2491E-01_JPRB,1.2001E-01_JPRB,1.2936E-01_JPRB,1.2653E-01_JPRB,1.1929E-01_JPRB, &
+     &  9.8955E-02_JPRB,7.4887E-02_JPRB,6.0142E-02_JPRB,6.6798E-03_JPRB,5.5293E-03_JPRB,4.3700E-03_JPRB, &
+     &  3.2061E-03_JPRB,2.0476E-03_JPRB,7.7366E-04_JPRB,1.0897E-04_JPRB/)
+      FRACREFAO(:, 8) = (/ &
+     &  1.3105E-01_JPRB,1.2563E-01_JPRB,1.3055E-01_JPRB,1.2854E-01_JPRB,1.3402E-01_JPRB,1.1571E-01_JPRB, &
+     &  9.4876E-02_JPRB,6.0459E-02_JPRB,5.6457E-02_JPRB,6.6798E-03_JPRB,5.5293E-03_JPRB,4.3700E-03_JPRB, &
+     &  3.2061E-03_JPRB,2.0476E-03_JPRB,7.7366E-04_JPRB,1.0897E-04_JPRB/)
+      FRACREFAO(:, 9) = (/ &
+     &  1.1375E-01_JPRB,1.2090E-01_JPRB,1.2348E-01_JPRB,1.2458E-01_JPRB,1.2406E-01_JPRB,1.1921E-01_JPRB, &
+     &  1.0802E-01_JPRB,8.6613E-02_JPRB,5.8125E-02_JPRB,6.2984E-03_JPRB,5.2359E-03_JPRB,4.0641E-03_JPRB, &
+     &  2.9379E-03_JPRB,1.9001E-03_JPRB,7.2646E-04_JPRB,1.0553E-04_JPRB/)
+
+
+!     ------------------------------------------------------------------
+
+!     The array KAO contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels> ~100mb, temperatures, and binary
+!     species parameters (see taumol.f for definition).  The first 
+!     index in the array, JS, runs from 1 to 9, and corresponds to 
+!     different values of the binary species parameter.  For instance, 
+!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
+!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
+!     in the array, JT, which runs from 1 to 5, corresponds to different
+!     temperatures.  More specifically, JT = 3 means that the data are for
+!     the reference temperature TREF for this  pressure level, JT = 2 refers
+!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
+!     to the JPth reference pressure level (see taumol.f for these levels
+!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
+!     which g-interval the absorption coefficients are for.
+
+
+!     The array KA_Mxx contains the absorption coefficient for 
+!     a minor species at the 16 chosen g-values for a reference pressure
+!     level below 100~ mb.   The first index in the array, JS, runs
+!     from 1 to 10, and corresponds to different gas column amount ratios,
+!     as expressed through the binary species parameter eta, defined as
+!     eta = gas1/(gas1 + (rat) * gas2), where rat is the 
+!     ratio of the reference MLS column amount value of gas 1 
+!     to that of gas2.  The second index refers to temperature 
+!     in 7.2 degree increments.  For instance, JT = 1 refers to a 
+!     temperature of 188.0, JT = 2 refers to 195.2, etc. The third index 
+!     runs over the g-channel (1 to 16).
+
+       KAO_MN2( 1, :, 1) = (/ &
+     & 3.24352E-08_JPRB, 3.39625E-08_JPRB, 3.55618E-08_JPRB, 3.72364E-08_JPRB, 3.89899E-08_JPRB, &
+     & 4.08259E-08_JPRB, 4.27484E-08_JPRB, 4.47614E-08_JPRB, 4.68692E-08_JPRB, 4.90763E-08_JPRB, &
+     & 5.13873E-08_JPRB, 5.38071E-08_JPRB, 5.63409E-08_JPRB, 5.89940E-08_JPRB, 6.17720E-08_JPRB, &
+     & 6.46808E-08_JPRB, 6.77266E-08_JPRB, 7.09158E-08_JPRB, 7.42553E-08_JPRB/)
+       KAO_MN2( 2, :, 1) = (/ &
+     & 3.44203E-08_JPRB, 3.60254E-08_JPRB, 3.77053E-08_JPRB, 3.94636E-08_JPRB, 4.13038E-08_JPRB, &
+     & 4.32299E-08_JPRB, 4.52458E-08_JPRB, 4.73557E-08_JPRB, 4.95640E-08_JPRB, 5.18753E-08_JPRB, &
+     & 5.42943E-08_JPRB, 5.68262E-08_JPRB, 5.94761E-08_JPRB, 6.22496E-08_JPRB, 6.51524E-08_JPRB, &
+     & 6.81906E-08_JPRB, 7.13704E-08_JPRB, 7.46986E-08_JPRB, 7.81819E-08_JPRB/)
+       KAO_MN2( 3, :, 1) = (/ &
+     & 3.44344E-08_JPRB, 3.61485E-08_JPRB, 3.79480E-08_JPRB, 3.98370E-08_JPRB, 4.18201E-08_JPRB, &
+     & 4.39019E-08_JPRB, 4.60873E-08_JPRB, 4.83815E-08_JPRB, 5.07899E-08_JPRB, 5.33182E-08_JPRB, &
+     & 5.59723E-08_JPRB, 5.87586E-08_JPRB, 6.16836E-08_JPRB, 6.47541E-08_JPRB, 6.79776E-08_JPRB, &
+     & 7.13614E-08_JPRB, 7.49138E-08_JPRB, 7.86429E-08_JPRB, 8.25577E-08_JPRB/)
+       KAO_MN2( 4, :, 1) = (/ &
+     & 4.21102E-08_JPRB, 4.38921E-08_JPRB, 4.57493E-08_JPRB, 4.76852E-08_JPRB, 4.97029E-08_JPRB, &
+     & 5.18061E-08_JPRB, 5.39982E-08_JPRB, 5.62831E-08_JPRB, 5.86647E-08_JPRB, 6.11470E-08_JPRB, &
+     & 6.37344E-08_JPRB, 6.64313E-08_JPRB, 6.92422E-08_JPRB, 7.21722E-08_JPRB, 7.52261E-08_JPRB, &
+     & 7.84092E-08_JPRB, 8.17270E-08_JPRB, 8.51852E-08_JPRB, 8.87897E-08_JPRB/)
+       KAO_MN2( 5, :, 1) = (/ &
+     & 4.78813E-08_JPRB, 5.01015E-08_JPRB, 5.24246E-08_JPRB, 5.48554E-08_JPRB, 5.73989E-08_JPRB, &
+     & 6.00603E-08_JPRB, 6.28452E-08_JPRB, 6.57592E-08_JPRB, 6.88083E-08_JPRB, 7.19987E-08_JPRB, &
+     & 7.53371E-08_JPRB, 7.88304E-08_JPRB, 8.24855E-08_JPRB, 8.63102E-08_JPRB, 9.03122E-08_JPRB, &
+     & 9.44997E-08_JPRB, 9.88815E-08_JPRB, 1.03466E-07_JPRB, 1.08264E-07_JPRB/)
+       KAO_MN2( 6, :, 1) = (/ &
+     & 7.03115E-08_JPRB, 7.27877E-08_JPRB, 7.53511E-08_JPRB, 7.80048E-08_JPRB, 8.07519E-08_JPRB, &
+     & 8.35958E-08_JPRB, 8.65398E-08_JPRB, 8.95875E-08_JPRB, 9.27426E-08_JPRB, 9.60087E-08_JPRB, &
+     & 9.93899E-08_JPRB, 1.02890E-07_JPRB, 1.06514E-07_JPRB, 1.10265E-07_JPRB, 1.14148E-07_JPRB, &
+     & 1.18168E-07_JPRB, 1.22330E-07_JPRB, 1.26638E-07_JPRB, 1.31098E-07_JPRB/)
+       KAO_MN2( 7, :, 1) = (/ &
+     & 8.86454E-08_JPRB, 9.20065E-08_JPRB, 9.54951E-08_JPRB, 9.91159E-08_JPRB, 1.02874E-07_JPRB, &
+     & 1.06775E-07_JPRB, 1.10823E-07_JPRB, 1.15025E-07_JPRB, 1.19387E-07_JPRB, 1.23913E-07_JPRB, &
+     & 1.28612E-07_JPRB, 1.33488E-07_JPRB, 1.38550E-07_JPRB, 1.43803E-07_JPRB, 1.49255E-07_JPRB, &
+     & 1.54915E-07_JPRB, 1.60788E-07_JPRB, 1.66885E-07_JPRB, 1.73213E-07_JPRB/)
+       KAO_MN2( 8, :, 1) = (/ &
+     & 1.34118E-07_JPRB, 1.38267E-07_JPRB, 1.42545E-07_JPRB, 1.46955E-07_JPRB, 1.51502E-07_JPRB, &
+     & 1.56189E-07_JPRB, 1.61022E-07_JPRB, 1.66004E-07_JPRB, 1.71140E-07_JPRB, 1.76435E-07_JPRB, &
+     & 1.81893E-07_JPRB, 1.87521E-07_JPRB, 1.93323E-07_JPRB, 1.99304E-07_JPRB, 2.05470E-07_JPRB, &
+     & 2.11827E-07_JPRB, 2.18381E-07_JPRB, 2.25138E-07_JPRB, 2.32103E-07_JPRB/)
+       KAO_MN2( 9, :, 1) = (/ &
+     & 5.08256E-08_JPRB, 5.30384E-08_JPRB, 5.53476E-08_JPRB, 5.77573E-08_JPRB, 6.02718E-08_JPRB, &
+     & 6.28959E-08_JPRB, 6.56342E-08_JPRB, 6.84917E-08_JPRB, 7.14737E-08_JPRB, 7.45854E-08_JPRB, &
+     & 7.78327E-08_JPRB, 8.12213E-08_JPRB, 8.47574E-08_JPRB, 8.84475E-08_JPRB, 9.22983E-08_JPRB, &
+     & 9.63167E-08_JPRB, 1.00510E-07_JPRB, 1.04886E-07_JPRB, 1.09452E-07_JPRB/)
+       KAO_MN2( 1, :, 2) = (/ &
+     & 8.23958E-08_JPRB, 8.39092E-08_JPRB, 8.54504E-08_JPRB, 8.70200E-08_JPRB, 8.86183E-08_JPRB, &
+     & 9.02460E-08_JPRB, 9.19036E-08_JPRB, 9.35917E-08_JPRB, 9.53107E-08_JPRB, 9.70614E-08_JPRB, &
+     & 9.88442E-08_JPRB, 1.00660E-07_JPRB, 1.02509E-07_JPRB, 1.04391E-07_JPRB, 1.06309E-07_JPRB, &
+     & 1.08261E-07_JPRB, 1.10250E-07_JPRB, 1.12275E-07_JPRB, 1.14337E-07_JPRB/)
+       KAO_MN2( 2, :, 2) = (/ &
+     & 8.52335E-08_JPRB, 8.69254E-08_JPRB, 8.86509E-08_JPRB, 9.04107E-08_JPRB, 9.22054E-08_JPRB, &
+     & 9.40357E-08_JPRB, 9.59024E-08_JPRB, 9.78061E-08_JPRB, 9.97476E-08_JPRB, 1.01728E-07_JPRB, &
+     & 1.03747E-07_JPRB, 1.05806E-07_JPRB, 1.07907E-07_JPRB, 1.10049E-07_JPRB, 1.12233E-07_JPRB, &
+     & 1.14461E-07_JPRB, 1.16733E-07_JPRB, 1.19050E-07_JPRB, 1.21414E-07_JPRB/)
+       KAO_MN2( 3, :, 2) = (/ &
+     & 1.04608E-07_JPRB, 1.06067E-07_JPRB, 1.07546E-07_JPRB, 1.09046E-07_JPRB, 1.10567E-07_JPRB, &
+     & 1.12110E-07_JPRB, 1.13673E-07_JPRB, 1.15259E-07_JPRB, 1.16866E-07_JPRB, 1.18496E-07_JPRB, &
+     & 1.20149E-07_JPRB, 1.21825E-07_JPRB, 1.23524E-07_JPRB, 1.25247E-07_JPRB, 1.26994E-07_JPRB, &
+     & 1.28765E-07_JPRB, 1.30561E-07_JPRB, 1.32382E-07_JPRB, 1.34229E-07_JPRB/)
+       KAO_MN2( 4, :, 2) = (/ &
+     & 1.17504E-07_JPRB, 1.18763E-07_JPRB, 1.20036E-07_JPRB, 1.21322E-07_JPRB, 1.22622E-07_JPRB, &
+     & 1.23936E-07_JPRB, 1.25265E-07_JPRB, 1.26607E-07_JPRB, 1.27964E-07_JPRB, 1.29335E-07_JPRB, &
+     & 1.30721E-07_JPRB, 1.32122E-07_JPRB, 1.33538E-07_JPRB, 1.34969E-07_JPRB, 1.36415E-07_JPRB, &
+     & 1.37877E-07_JPRB, 1.39354E-07_JPRB, 1.40848E-07_JPRB, 1.42357E-07_JPRB/)
+       KAO_MN2( 5, :, 2) = (/ &
+     & 1.23552E-07_JPRB, 1.25200E-07_JPRB, 1.26870E-07_JPRB, 1.28562E-07_JPRB, 1.30277E-07_JPRB, &
+     & 1.32015E-07_JPRB, 1.33776E-07_JPRB, 1.35560E-07_JPRB, 1.37368E-07_JPRB, 1.39200E-07_JPRB, &
+     & 1.41057E-07_JPRB, 1.42938E-07_JPRB, 1.44845E-07_JPRB, 1.46777E-07_JPRB, 1.48735E-07_JPRB, &
+     & 1.50718E-07_JPRB, 1.52729E-07_JPRB, 1.54766E-07_JPRB, 1.56830E-07_JPRB/)
+       KAO_MN2( 6, :, 2) = (/ &
+     & 1.29682E-07_JPRB, 1.32226E-07_JPRB, 1.34820E-07_JPRB, 1.37464E-07_JPRB, 1.40161E-07_JPRB, &
+     & 1.42910E-07_JPRB, 1.45713E-07_JPRB, 1.48571E-07_JPRB, 1.51486E-07_JPRB, 1.54457E-07_JPRB, &
+     & 1.57487E-07_JPRB, 1.60576E-07_JPRB, 1.63726E-07_JPRB, 1.66937E-07_JPRB, 1.70212E-07_JPRB, &
+     & 1.73551E-07_JPRB, 1.76955E-07_JPRB, 1.80426E-07_JPRB, 1.83965E-07_JPRB/)
+       KAO_MN2( 7, :, 2) = (/ &
+     & 1.77416E-07_JPRB, 1.78627E-07_JPRB, 1.79846E-07_JPRB, 1.81073E-07_JPRB, 1.82309E-07_JPRB, &
+     & 1.83554E-07_JPRB, 1.84806E-07_JPRB, 1.86068E-07_JPRB, 1.87338E-07_JPRB, 1.88616E-07_JPRB, &
+     & 1.89904E-07_JPRB, 1.91200E-07_JPRB, 1.92505E-07_JPRB, 1.93819E-07_JPRB, 1.95142E-07_JPRB, &
+     & 1.96474E-07_JPRB, 1.97815E-07_JPRB, 1.99165E-07_JPRB, 2.00524E-07_JPRB/)
+       KAO_MN2( 8, :, 2) = (/ &
+     & 2.20695E-07_JPRB, 2.20451E-07_JPRB, 2.20208E-07_JPRB, 2.19965E-07_JPRB, 2.19722E-07_JPRB, &
+     & 2.19480E-07_JPRB, 2.19238E-07_JPRB, 2.18996E-07_JPRB, 2.18754E-07_JPRB, 2.18513E-07_JPRB, &
+     & 2.18272E-07_JPRB, 2.18031E-07_JPRB, 2.17790E-07_JPRB, 2.17550E-07_JPRB, 2.17310E-07_JPRB, &
+     & 2.17070E-07_JPRB, 2.16831E-07_JPRB, 2.16591E-07_JPRB, 2.16352E-07_JPRB/)
+       KAO_MN2( 9, :, 2) = (/ &
+     & 1.23015E-07_JPRB, 1.24808E-07_JPRB, 1.26626E-07_JPRB, 1.28471E-07_JPRB, 1.30343E-07_JPRB, &
+     & 1.32242E-07_JPRB, 1.34168E-07_JPRB, 1.36123E-07_JPRB, 1.38106E-07_JPRB, 1.40118E-07_JPRB, &
+     & 1.42160E-07_JPRB, 1.44231E-07_JPRB, 1.46332E-07_JPRB, 1.48464E-07_JPRB, 1.50627E-07_JPRB, &
+     & 1.52822E-07_JPRB, 1.55048E-07_JPRB, 1.57307E-07_JPRB, 1.59599E-07_JPRB/)
+       KAO_MN2( 1, :, 3) = (/ &
+     & 1.87585E-07_JPRB, 1.89503E-07_JPRB, 1.91440E-07_JPRB, 1.93398E-07_JPRB, 1.95375E-07_JPRB, &
+     & 1.97372E-07_JPRB, 1.99390E-07_JPRB, 2.01429E-07_JPRB, 2.03488E-07_JPRB, 2.05568E-07_JPRB, &
+     & 2.07670E-07_JPRB, 2.09793E-07_JPRB, 2.11938E-07_JPRB, 2.14105E-07_JPRB, 2.16294E-07_JPRB, &
+     & 2.18505E-07_JPRB, 2.20739E-07_JPRB, 2.22996E-07_JPRB, 2.25275E-07_JPRB/)
+       KAO_MN2( 2, :, 3) = (/ &
+     & 1.82585E-07_JPRB, 1.84249E-07_JPRB, 1.85929E-07_JPRB, 1.87624E-07_JPRB, 1.89335E-07_JPRB, &
+     & 1.91061E-07_JPRB, 1.92803E-07_JPRB, 1.94561E-07_JPRB, 1.96335E-07_JPRB, 1.98125E-07_JPRB, &
+     & 1.99932E-07_JPRB, 2.01755E-07_JPRB, 2.03594E-07_JPRB, 2.05451E-07_JPRB, 2.07324E-07_JPRB, &
+     & 2.09214E-07_JPRB, 2.11122E-07_JPRB, 2.13047E-07_JPRB, 2.14989E-07_JPRB/)
+       KAO_MN2( 3, :, 3) = (/ &
+     & 1.64711E-07_JPRB, 1.67539E-07_JPRB, 1.70417E-07_JPRB, 1.73343E-07_JPRB, 1.76321E-07_JPRB, &
+     & 1.79349E-07_JPRB, 1.82429E-07_JPRB, 1.85562E-07_JPRB, 1.88749E-07_JPRB, 1.91990E-07_JPRB, &
+     & 1.95288E-07_JPRB, 1.98642E-07_JPRB, 2.02053E-07_JPRB, 2.05523E-07_JPRB, 2.09053E-07_JPRB, &
+     & 2.12643E-07_JPRB, 2.16295E-07_JPRB, 2.20010E-07_JPRB, 2.23788E-07_JPRB/)
+       KAO_MN2( 4, :, 3) = (/ &
+     & 1.67494E-07_JPRB, 1.71011E-07_JPRB, 1.74601E-07_JPRB, 1.78267E-07_JPRB, 1.82009E-07_JPRB, &
+     & 1.85831E-07_JPRB, 1.89732E-07_JPRB, 1.93715E-07_JPRB, 1.97782E-07_JPRB, 2.01935E-07_JPRB, &
+     & 2.06174E-07_JPRB, 2.10503E-07_JPRB, 2.14922E-07_JPRB, 2.19434E-07_JPRB, 2.24041E-07_JPRB, &
+     & 2.28745E-07_JPRB, 2.33548E-07_JPRB, 2.38451E-07_JPRB, 2.43457E-07_JPRB/)
+       KAO_MN2( 5, :, 3) = (/ &
+     & 1.97399E-07_JPRB, 2.00092E-07_JPRB, 2.02821E-07_JPRB, 2.05588E-07_JPRB, 2.08393E-07_JPRB, &
+     & 2.11236E-07_JPRB, 2.14118E-07_JPRB, 2.17039E-07_JPRB, 2.20000E-07_JPRB, 2.23001E-07_JPRB, &
+     & 2.26043E-07_JPRB, 2.29127E-07_JPRB, 2.32252E-07_JPRB, 2.35421E-07_JPRB, 2.38633E-07_JPRB, &
+     & 2.41888E-07_JPRB, 2.45188E-07_JPRB, 2.48533E-07_JPRB, 2.51923E-07_JPRB/)
+       KAO_MN2( 6, :, 3) = (/ &
+     & 2.24021E-07_JPRB, 2.24970E-07_JPRB, 2.25923E-07_JPRB, 2.26880E-07_JPRB, 2.27840E-07_JPRB, &
+     & 2.28805E-07_JPRB, 2.29774E-07_JPRB, 2.30747E-07_JPRB, 2.31725E-07_JPRB, 2.32706E-07_JPRB, &
+     & 2.33692E-07_JPRB, 2.34681E-07_JPRB, 2.35675E-07_JPRB, 2.36673E-07_JPRB, 2.37675E-07_JPRB, &
+     & 2.38682E-07_JPRB, 2.39693E-07_JPRB, 2.40708E-07_JPRB, 2.41727E-07_JPRB/)
+       KAO_MN2( 7, :, 3) = (/ &
+     & 1.98178E-07_JPRB, 2.00676E-07_JPRB, 2.03205E-07_JPRB, 2.05766E-07_JPRB, 2.08359E-07_JPRB, &
+     & 2.10986E-07_JPRB, 2.13645E-07_JPRB, 2.16337E-07_JPRB, 2.19064E-07_JPRB, 2.21825E-07_JPRB, &
+     & 2.24621E-07_JPRB, 2.27452E-07_JPRB, 2.30319E-07_JPRB, 2.33222E-07_JPRB, 2.36161E-07_JPRB, &
+     & 2.39138E-07_JPRB, 2.42152E-07_JPRB, 2.45204E-07_JPRB, 2.48294E-07_JPRB/)
+       KAO_MN2( 8, :, 3) = (/ &
+     & 2.83042E-07_JPRB, 2.89941E-07_JPRB, 2.97009E-07_JPRB, 3.04250E-07_JPRB, 3.11666E-07_JPRB, &
+     & 3.19264E-07_JPRB, 3.27047E-07_JPRB, 3.35019E-07_JPRB, 3.43186E-07_JPRB, 3.51552E-07_JPRB, &
+     & 3.60122E-07_JPRB, 3.68901E-07_JPRB, 3.77893E-07_JPRB, 3.87105E-07_JPRB, 3.96542E-07_JPRB, &
+     & 4.06208E-07_JPRB, 4.16111E-07_JPRB, 4.26254E-07_JPRB, 4.36645E-07_JPRB/)
+       KAO_MN2( 9, :, 3) = (/ &
+     & 1.98963E-07_JPRB, 2.01576E-07_JPRB, 2.04224E-07_JPRB, 2.06907E-07_JPRB, 2.09626E-07_JPRB, &
+     & 2.12379E-07_JPRB, 2.15169E-07_JPRB, 2.17996E-07_JPRB, 2.20860E-07_JPRB, 2.23761E-07_JPRB, &
+     & 2.26701E-07_JPRB, 2.29679E-07_JPRB, 2.32696E-07_JPRB, 2.35753E-07_JPRB, 2.38851E-07_JPRB, &
+     & 2.41988E-07_JPRB, 2.45167E-07_JPRB, 2.48388E-07_JPRB, 2.51651E-07_JPRB/)
+       KAO_MN2( 1, :, 4) = (/ &
+     & 3.75434E-07_JPRB, 3.79581E-07_JPRB, 3.83775E-07_JPRB, 3.88014E-07_JPRB, 3.92301E-07_JPRB, &
+     & 3.96634E-07_JPRB, 4.01016E-07_JPRB, 4.05446E-07_JPRB, 4.09925E-07_JPRB, 4.14453E-07_JPRB, &
+     & 4.19032E-07_JPRB, 4.23661E-07_JPRB, 4.28341E-07_JPRB, 4.33073E-07_JPRB, 4.37857E-07_JPRB, &
+     & 4.42694E-07_JPRB, 4.47585E-07_JPRB, 4.52529E-07_JPRB, 4.57528E-07_JPRB/)
+       KAO_MN2( 2, :, 4) = (/ &
+     & 3.76756E-07_JPRB, 3.80760E-07_JPRB, 3.84805E-07_JPRB, 3.88894E-07_JPRB, 3.93027E-07_JPRB, &
+     & 3.97203E-07_JPRB, 4.01423E-07_JPRB, 4.05689E-07_JPRB, 4.10000E-07_JPRB, 4.14356E-07_JPRB, &
+     & 4.18759E-07_JPRB, 4.23209E-07_JPRB, 4.27706E-07_JPRB, 4.32250E-07_JPRB, 4.36843E-07_JPRB, &
+     & 4.41485E-07_JPRB, 4.46176E-07_JPRB, 4.50917E-07_JPRB, 4.55708E-07_JPRB/)
+       KAO_MN2( 3, :, 4) = (/ &
+     & 3.76258E-07_JPRB, 3.78929E-07_JPRB, 3.81619E-07_JPRB, 3.84329E-07_JPRB, 3.87057E-07_JPRB, &
+     & 3.89805E-07_JPRB, 3.92572E-07_JPRB, 3.95359E-07_JPRB, 3.98166E-07_JPRB, 4.00993E-07_JPRB, &
+     & 4.03839E-07_JPRB, 4.06706E-07_JPRB, 4.09594E-07_JPRB, 4.12502E-07_JPRB, 4.15430E-07_JPRB, &
+     & 4.18379E-07_JPRB, 4.21349E-07_JPRB, 4.24341E-07_JPRB, 4.27353E-07_JPRB/)
+       KAO_MN2( 4, :, 4) = (/ &
+     & 3.17796E-07_JPRB, 3.22447E-07_JPRB, 3.27166E-07_JPRB, 3.31954E-07_JPRB, 3.36812E-07_JPRB, &
+     & 3.41742E-07_JPRB, 3.46743E-07_JPRB, 3.51818E-07_JPRB, 3.56967E-07_JPRB, 3.62191E-07_JPRB, &
+     & 3.67492E-07_JPRB, 3.72870E-07_JPRB, 3.78328E-07_JPRB, 3.83865E-07_JPRB, 3.89483E-07_JPRB, &
+     & 3.95183E-07_JPRB, 4.00967E-07_JPRB, 4.06835E-07_JPRB, 4.12789E-07_JPRB/)
+       KAO_MN2( 5, :, 4) = (/ &
+     & 3.33793E-07_JPRB, 3.38941E-07_JPRB, 3.44169E-07_JPRB, 3.49478E-07_JPRB, 3.54868E-07_JPRB, &
+     & 3.60342E-07_JPRB, 3.65900E-07_JPRB, 3.71544E-07_JPRB, 3.77275E-07_JPRB, 3.83094E-07_JPRB, &
+     & 3.89003E-07_JPRB, 3.95003E-07_JPRB, 4.01096E-07_JPRB, 4.07283E-07_JPRB, 4.13565E-07_JPRB, &
+     & 4.19944E-07_JPRB, 4.26421E-07_JPRB, 4.32999E-07_JPRB, 4.39677E-07_JPRB/)
+       KAO_MN2( 6, :, 4) = (/ &
+     & 3.60052E-07_JPRB, 3.66686E-07_JPRB, 3.73442E-07_JPRB, 3.80323E-07_JPRB, 3.87330E-07_JPRB, &
+     & 3.94466E-07_JPRB, 4.01734E-07_JPRB, 4.09136E-07_JPRB, 4.16674E-07_JPRB, 4.24351E-07_JPRB, &
+     & 4.32169E-07_JPRB, 4.40132E-07_JPRB, 4.48241E-07_JPRB, 4.56500E-07_JPRB, 4.64910E-07_JPRB, &
+     & 4.73476E-07_JPRB, 4.82200E-07_JPRB, 4.91084E-07_JPRB, 5.00132E-07_JPRB/)
+       KAO_MN2( 7, :, 4) = (/ &
+     & 4.14713E-07_JPRB, 4.21885E-07_JPRB, 4.29181E-07_JPRB, 4.36603E-07_JPRB, 4.44153E-07_JPRB, &
+     & 4.51834E-07_JPRB, 4.59648E-07_JPRB, 4.67598E-07_JPRB, 4.75684E-07_JPRB, 4.83910E-07_JPRB, &
+     & 4.92279E-07_JPRB, 5.00793E-07_JPRB, 5.09453E-07_JPRB, 5.18264E-07_JPRB, 5.27226E-07_JPRB, &
+     & 5.36344E-07_JPRB, 5.45620E-07_JPRB, 5.55055E-07_JPRB, 5.64654E-07_JPRB/)
+       KAO_MN2( 8, :, 4) = (/ &
+     & 4.15352E-07_JPRB, 4.24386E-07_JPRB, 4.33617E-07_JPRB, 4.43049E-07_JPRB, 4.52685E-07_JPRB, &
+     & 4.62532E-07_JPRB, 4.72592E-07_JPRB, 4.82872E-07_JPRB, 4.93374E-07_JPRB, 5.04106E-07_JPRB, &
+     & 5.15071E-07_JPRB, 5.26274E-07_JPRB, 5.37721E-07_JPRB, 5.49417E-07_JPRB, 5.61367E-07_JPRB, &
+     & 5.73577E-07_JPRB, 5.86053E-07_JPRB, 5.98800E-07_JPRB, 6.11825E-07_JPRB/)
+       KAO_MN2( 9, :, 4) = (/ &
+     & 3.33820E-07_JPRB, 3.39144E-07_JPRB, 3.44553E-07_JPRB, 3.50048E-07_JPRB, 3.55631E-07_JPRB, &
+     & 3.61302E-07_JPRB, 3.67065E-07_JPRB, 3.72919E-07_JPRB, 3.78866E-07_JPRB, 3.84908E-07_JPRB, &
+     & 3.91047E-07_JPRB, 3.97284E-07_JPRB, 4.03620E-07_JPRB, 4.10057E-07_JPRB, 4.16597E-07_JPRB, &
+     & 4.23241E-07_JPRB, 4.29991E-07_JPRB, 4.36849E-07_JPRB, 4.43816E-07_JPRB/)
+       KAO_MN2( 1, :, 5) = (/ &
+     & 6.99819E-07_JPRB, 7.04629E-07_JPRB, 7.09472E-07_JPRB, 7.14349E-07_JPRB, 7.19258E-07_JPRB, &
+     & 7.24202E-07_JPRB, 7.29180E-07_JPRB, 7.34192E-07_JPRB, 7.39238E-07_JPRB, 7.44319E-07_JPRB, &
+     & 7.49435E-07_JPRB, 7.54586E-07_JPRB, 7.59773E-07_JPRB, 7.64995E-07_JPRB, 7.70253E-07_JPRB, &
+     & 7.75547E-07_JPRB, 7.80877E-07_JPRB, 7.86245E-07_JPRB, 7.91649E-07_JPRB/)
+       KAO_MN2( 2, :, 5) = (/ &
+     & 6.98257E-07_JPRB, 7.03182E-07_JPRB, 7.08143E-07_JPRB, 7.13138E-07_JPRB, 7.18169E-07_JPRB, &
+     & 7.23235E-07_JPRB, 7.28336E-07_JPRB, 7.33474E-07_JPRB, 7.38648E-07_JPRB, 7.43858E-07_JPRB, &
+     & 7.49106E-07_JPRB, 7.54390E-07_JPRB, 7.59711E-07_JPRB, 7.65071E-07_JPRB, 7.70467E-07_JPRB, &
+     & 7.75902E-07_JPRB, 7.81376E-07_JPRB, 7.86887E-07_JPRB, 7.92438E-07_JPRB/)
+       KAO_MN2( 3, :, 5) = (/ &
+     & 6.98531E-07_JPRB, 7.03429E-07_JPRB, 7.08361E-07_JPRB, 7.13328E-07_JPRB, 7.18329E-07_JPRB, &
+     & 7.23365E-07_JPRB, 7.28437E-07_JPRB, 7.33545E-07_JPRB, 7.38688E-07_JPRB, 7.43867E-07_JPRB, &
+     & 7.49082E-07_JPRB, 7.54335E-07_JPRB, 7.59623E-07_JPRB, 7.64950E-07_JPRB, 7.70313E-07_JPRB, &
+     & 7.75714E-07_JPRB, 7.81153E-07_JPRB, 7.86630E-07_JPRB, 7.92145E-07_JPRB/)
+       KAO_MN2( 4, :, 5) = (/ &
+     & 7.37210E-07_JPRB, 7.38869E-07_JPRB, 7.40532E-07_JPRB, 7.42198E-07_JPRB, 7.43868E-07_JPRB, &
+     & 7.45542E-07_JPRB, 7.47219E-07_JPRB, 7.48901E-07_JPRB, 7.50586E-07_JPRB, 7.52275E-07_JPRB, &
+     & 7.53967E-07_JPRB, 7.55664E-07_JPRB, 7.57364E-07_JPRB, 7.59068E-07_JPRB, 7.60777E-07_JPRB, &
+     & 7.62488E-07_JPRB, 7.64204E-07_JPRB, 7.65924E-07_JPRB, 7.67647E-07_JPRB/)
+       KAO_MN2( 5, :, 5) = (/ &
+     & 6.07063E-07_JPRB, 6.12893E-07_JPRB, 6.18779E-07_JPRB, 6.24722E-07_JPRB, 6.30721E-07_JPRB, &
+     & 6.36778E-07_JPRB, 6.42893E-07_JPRB, 6.49067E-07_JPRB, 6.55301E-07_JPRB, 6.61594E-07_JPRB, &
+     & 6.67947E-07_JPRB, 6.74362E-07_JPRB, 6.80838E-07_JPRB, 6.87376E-07_JPRB, 6.93978E-07_JPRB, &
+     & 7.00642E-07_JPRB, 7.07371E-07_JPRB, 7.14164E-07_JPRB, 7.21022E-07_JPRB/)
+       KAO_MN2( 6, :, 5) = (/ &
+     & 6.13354E-07_JPRB, 6.20147E-07_JPRB, 6.27016E-07_JPRB, 6.33961E-07_JPRB, 6.40983E-07_JPRB, &
+     & 6.48082E-07_JPRB, 6.55260E-07_JPRB, 6.62518E-07_JPRB, 6.69856E-07_JPRB, 6.77276E-07_JPRB, &
+     & 6.84777E-07_JPRB, 6.92362E-07_JPRB, 7.00030E-07_JPRB, 7.07784E-07_JPRB, 7.15624E-07_JPRB, &
+     & 7.23550E-07_JPRB, 7.31564E-07_JPRB, 7.39667E-07_JPRB, 7.47859E-07_JPRB/)
+       KAO_MN2( 7, :, 5) = (/ &
+     & 6.86666E-07_JPRB, 6.92902E-07_JPRB, 6.99195E-07_JPRB, 7.05545E-07_JPRB, 7.11952E-07_JPRB, &
+     & 7.18418E-07_JPRB, 7.24943E-07_JPRB, 7.31526E-07_JPRB, 7.38170E-07_JPRB, 7.44874E-07_JPRB, &
+     & 7.51639E-07_JPRB, 7.58465E-07_JPRB, 7.65353E-07_JPRB, 7.72304E-07_JPRB, 7.79318E-07_JPRB, &
+     & 7.86395E-07_JPRB, 7.93537E-07_JPRB, 8.00744E-07_JPRB, 8.08016E-07_JPRB/)
+       KAO_MN2( 8, :, 5) = (/ &
+     & 9.39664E-07_JPRB, 9.39765E-07_JPRB, 9.39866E-07_JPRB, 9.39966E-07_JPRB, 9.40067E-07_JPRB, &
+     & 9.40168E-07_JPRB, 9.40268E-07_JPRB, 9.40369E-07_JPRB, 9.40470E-07_JPRB, 9.40571E-07_JPRB, &
+     & 9.40671E-07_JPRB, 9.40772E-07_JPRB, 9.40873E-07_JPRB, 9.40974E-07_JPRB, 9.41074E-07_JPRB, &
+     & 9.41175E-07_JPRB, 9.41276E-07_JPRB, 9.41377E-07_JPRB, 9.41478E-07_JPRB/)
+       KAO_MN2( 9, :, 5) = (/ &
+     & 6.02847E-07_JPRB, 6.09726E-07_JPRB, 6.16684E-07_JPRB, 6.23722E-07_JPRB, 6.30839E-07_JPRB, &
+     & 6.38038E-07_JPRB, 6.45320E-07_JPRB, 6.52684E-07_JPRB, 6.60132E-07_JPRB, 6.67665E-07_JPRB, &
+     & 6.75284E-07_JPRB, 6.82991E-07_JPRB, 6.90785E-07_JPRB, 6.98668E-07_JPRB, 7.06641E-07_JPRB, &
+     & 7.14705E-07_JPRB, 7.22861E-07_JPRB, 7.31110E-07_JPRB, 7.39453E-07_JPRB/)
+       KAO_MN2( 1, :, 6) = (/ &
+     & 1.13692E-06_JPRB, 1.13231E-06_JPRB, 1.12772E-06_JPRB, 1.12315E-06_JPRB, 1.11859E-06_JPRB, &
+     & 1.11406E-06_JPRB, 1.10954E-06_JPRB, 1.10505E-06_JPRB, 1.10057E-06_JPRB, 1.09610E-06_JPRB, &
+     & 1.09166E-06_JPRB, 1.08724E-06_JPRB, 1.08283E-06_JPRB, 1.07844E-06_JPRB, 1.07407E-06_JPRB, &
+     & 1.06971E-06_JPRB, 1.06538E-06_JPRB, 1.06106E-06_JPRB, 1.05676E-06_JPRB/)
+       KAO_MN2( 2, :, 6) = (/ &
+     & 1.13682E-06_JPRB, 1.13221E-06_JPRB, 1.12762E-06_JPRB, 1.12305E-06_JPRB, 1.11849E-06_JPRB, &
+     & 1.11396E-06_JPRB, 1.10944E-06_JPRB, 1.10495E-06_JPRB, 1.10047E-06_JPRB, 1.09600E-06_JPRB, &
+     & 1.09156E-06_JPRB, 1.08714E-06_JPRB, 1.08273E-06_JPRB, 1.07834E-06_JPRB, 1.07397E-06_JPRB, &
+     & 1.06961E-06_JPRB, 1.06528E-06_JPRB, 1.06096E-06_JPRB, 1.05666E-06_JPRB/)
+       KAO_MN2( 3, :, 6) = (/ &
+     & 1.13642E-06_JPRB, 1.13181E-06_JPRB, 1.12722E-06_JPRB, 1.12265E-06_JPRB, 1.11809E-06_JPRB, &
+     & 1.11356E-06_JPRB, 1.10904E-06_JPRB, 1.10455E-06_JPRB, 1.10007E-06_JPRB, 1.09560E-06_JPRB, &
+     & 1.09116E-06_JPRB, 1.08674E-06_JPRB, 1.08233E-06_JPRB, 1.07794E-06_JPRB, 1.07357E-06_JPRB, &
+     & 1.06921E-06_JPRB, 1.06488E-06_JPRB, 1.06056E-06_JPRB, 1.05626E-06_JPRB/)
+       KAO_MN2( 4, :, 6) = (/ &
+     & 1.13626E-06_JPRB, 1.13160E-06_JPRB, 1.12696E-06_JPRB, 1.12233E-06_JPRB, 1.11773E-06_JPRB, &
+     & 1.11314E-06_JPRB, 1.10858E-06_JPRB, 1.10403E-06_JPRB, 1.09950E-06_JPRB, 1.09498E-06_JPRB, &
+     & 1.09049E-06_JPRB, 1.08602E-06_JPRB, 1.08156E-06_JPRB, 1.07712E-06_JPRB, 1.07270E-06_JPRB, &
+     & 1.06830E-06_JPRB, 1.06392E-06_JPRB, 1.05955E-06_JPRB, 1.05520E-06_JPRB/)
+       KAO_MN2( 5, :, 6) = (/ &
+     & 1.22429E-06_JPRB, 1.21163E-06_JPRB, 1.19909E-06_JPRB, 1.18669E-06_JPRB, 1.17441E-06_JPRB, &
+     & 1.16226E-06_JPRB, 1.15024E-06_JPRB, 1.13834E-06_JPRB, 1.12656E-06_JPRB, 1.11491E-06_JPRB, &
+     & 1.10338E-06_JPRB, 1.09196E-06_JPRB, 1.08067E-06_JPRB, 1.06949E-06_JPRB, 1.05842E-06_JPRB, &
+     & 1.04747E-06_JPRB, 1.03664E-06_JPRB, 1.02591E-06_JPRB, 1.01530E-06_JPRB/)
+       KAO_MN2( 6, :, 6) = (/ &
+     & 1.02400E-06_JPRB, 1.02238E-06_JPRB, 1.02077E-06_JPRB, 1.01916E-06_JPRB, 1.01755E-06_JPRB, &
+     & 1.01594E-06_JPRB, 1.01433E-06_JPRB, 1.01273E-06_JPRB, 1.01113E-06_JPRB, 1.00953E-06_JPRB, &
+     & 1.00794E-06_JPRB, 1.00635E-06_JPRB, 1.00476E-06_JPRB, 1.00317E-06_JPRB, 1.00159E-06_JPRB, &
+     & 1.00000E-06_JPRB, 9.98425E-07_JPRB, 9.96848E-07_JPRB, 9.95273E-07_JPRB/)
+       KAO_MN2( 7, :, 6) = (/ &
+     & 1.08594E-06_JPRB, 1.08185E-06_JPRB, 1.07778E-06_JPRB, 1.07373E-06_JPRB, 1.06969E-06_JPRB, &
+     & 1.06566E-06_JPRB, 1.06165E-06_JPRB, 1.05766E-06_JPRB, 1.05368E-06_JPRB, 1.04971E-06_JPRB, &
+     & 1.04576E-06_JPRB, 1.04183E-06_JPRB, 1.03791E-06_JPRB, 1.03400E-06_JPRB, 1.03011E-06_JPRB, &
+     & 1.02623E-06_JPRB, 1.02237E-06_JPRB, 1.01852E-06_JPRB, 1.01469E-06_JPRB/)
+       KAO_MN2( 8, :, 6) = (/ &
+     & 1.25029E-06_JPRB, 1.22508E-06_JPRB, 1.20038E-06_JPRB, 1.17618E-06_JPRB, 1.15247E-06_JPRB, &
+     & 1.12924E-06_JPRB, 1.10647E-06_JPRB, 1.08416E-06_JPRB, 1.06231E-06_JPRB, 1.04089E-06_JPRB, &
+     & 1.01990E-06_JPRB, 9.99343E-07_JPRB, 9.79196E-07_JPRB, 9.59454E-07_JPRB, 9.40111E-07_JPRB, &
+     & 9.21158E-07_JPRB, 9.02587E-07_JPRB, 8.84390E-07_JPRB, 8.66560E-07_JPRB/)
+       KAO_MN2( 9, :, 6) = (/ &
+     & 1.21299E-06_JPRB, 1.19953E-06_JPRB, 1.18622E-06_JPRB, 1.17305E-06_JPRB, 1.16003E-06_JPRB, &
+     & 1.14716E-06_JPRB, 1.13443E-06_JPRB, 1.12184E-06_JPRB, 1.10939E-06_JPRB, 1.09708E-06_JPRB, &
+     & 1.08491E-06_JPRB, 1.07287E-06_JPRB, 1.06096E-06_JPRB, 1.04919E-06_JPRB, 1.03755E-06_JPRB, &
+     & 1.02603E-06_JPRB, 1.01465E-06_JPRB, 1.00339E-06_JPRB, 9.92253E-07_JPRB/)
+       KAO_MN2( 1, :, 7) = (/ &
+     & 1.53893E-06_JPRB, 1.51743E-06_JPRB, 1.49623E-06_JPRB, 1.47532E-06_JPRB, 1.45471E-06_JPRB, &
+     & 1.43438E-06_JPRB, 1.41434E-06_JPRB, 1.39458E-06_JPRB, 1.37509E-06_JPRB, 1.35588E-06_JPRB, &
+     & 1.33694E-06_JPRB, 1.31826E-06_JPRB, 1.29984E-06_JPRB, 1.28167E-06_JPRB, 1.26377E-06_JPRB, &
+     & 1.24611E-06_JPRB, 1.22870E-06_JPRB, 1.21153E-06_JPRB, 1.19460E-06_JPRB/)
+       KAO_MN2( 2, :, 7) = (/ &
+     & 1.53809E-06_JPRB, 1.51665E-06_JPRB, 1.49552E-06_JPRB, 1.47467E-06_JPRB, 1.45412E-06_JPRB, &
+     & 1.43386E-06_JPRB, 1.41388E-06_JPRB, 1.39418E-06_JPRB, 1.37475E-06_JPRB, 1.35559E-06_JPRB, &
+     & 1.33670E-06_JPRB, 1.31807E-06_JPRB, 1.29970E-06_JPRB, 1.28159E-06_JPRB, 1.26373E-06_JPRB, &
+     & 1.24612E-06_JPRB, 1.22875E-06_JPRB, 1.21163E-06_JPRB, 1.19475E-06_JPRB/)
+       KAO_MN2( 3, :, 7) = (/ &
+     & 1.53883E-06_JPRB, 1.51733E-06_JPRB, 1.49613E-06_JPRB, 1.47522E-06_JPRB, 1.45461E-06_JPRB, &
+     & 1.43428E-06_JPRB, 1.41424E-06_JPRB, 1.39448E-06_JPRB, 1.37499E-06_JPRB, 1.35578E-06_JPRB, &
+     & 1.33684E-06_JPRB, 1.31816E-06_JPRB, 1.29974E-06_JPRB, 1.28157E-06_JPRB, 1.26367E-06_JPRB, &
+     & 1.24601E-06_JPRB, 1.22860E-06_JPRB, 1.21143E-06_JPRB, 1.19450E-06_JPRB/)
+       KAO_MN2( 4, :, 7) = (/ &
+     & 1.53789E-06_JPRB, 1.51645E-06_JPRB, 1.49532E-06_JPRB, 1.47448E-06_JPRB, 1.45393E-06_JPRB, &
+     & 1.43366E-06_JPRB, 1.41368E-06_JPRB, 1.39398E-06_JPRB, 1.37455E-06_JPRB, 1.35539E-06_JPRB, &
+     & 1.33650E-06_JPRB, 1.31787E-06_JPRB, 1.29950E-06_JPRB, 1.28139E-06_JPRB, 1.26353E-06_JPRB, &
+     & 1.24592E-06_JPRB, 1.22856E-06_JPRB, 1.21143E-06_JPRB, 1.19455E-06_JPRB/)
+       KAO_MN2( 5, :, 7) = (/ &
+     & 1.54059E-06_JPRB, 1.51888E-06_JPRB, 1.49747E-06_JPRB, 1.47637E-06_JPRB, 1.45557E-06_JPRB, &
+     & 1.43505E-06_JPRB, 1.41483E-06_JPRB, 1.39489E-06_JPRB, 1.37523E-06_JPRB, 1.35585E-06_JPRB, &
+     & 1.33675E-06_JPRB, 1.31791E-06_JPRB, 1.29934E-06_JPRB, 1.28103E-06_JPRB, 1.26297E-06_JPRB, &
+     & 1.24517E-06_JPRB, 1.22763E-06_JPRB, 1.21033E-06_JPRB, 1.19327E-06_JPRB/)
+       KAO_MN2( 6, :, 7) = (/ &
+     & 1.70605E-06_JPRB, 1.65759E-06_JPRB, 1.61052E-06_JPRB, 1.56478E-06_JPRB, 1.52034E-06_JPRB, &
+     & 1.47716E-06_JPRB, 1.43521E-06_JPRB, 1.39445E-06_JPRB, 1.35485E-06_JPRB, 1.31637E-06_JPRB, &
+     & 1.27898E-06_JPRB, 1.24266E-06_JPRB, 1.20737E-06_JPRB, 1.17308E-06_JPRB, 1.13976E-06_JPRB, &
+     & 1.10739E-06_JPRB, 1.07594E-06_JPRB, 1.04539E-06_JPRB, 1.01570E-06_JPRB/)
+       KAO_MN2( 7, :, 7) = (/ &
+     & 1.39128E-06_JPRB, 1.36388E-06_JPRB, 1.33702E-06_JPRB, 1.31068E-06_JPRB, 1.28487E-06_JPRB, &
+     & 1.25956E-06_JPRB, 1.23475E-06_JPRB, 1.21044E-06_JPRB, 1.18659E-06_JPRB, 1.16322E-06_JPRB, &
+     & 1.14031E-06_JPRB, 1.11785E-06_JPRB, 1.09584E-06_JPRB, 1.07425E-06_JPRB, 1.05309E-06_JPRB, &
+     & 1.03235E-06_JPRB, 1.01202E-06_JPRB, 9.92088E-07_JPRB, 9.72548E-07_JPRB/)
+       KAO_MN2( 8, :, 7) = (/ &
+     & 1.15676E-06_JPRB, 1.13709E-06_JPRB, 1.11775E-06_JPRB, 1.09874E-06_JPRB, 1.08005E-06_JPRB, &
+     & 1.06168E-06_JPRB, 1.04362E-06_JPRB, 1.02587E-06_JPRB, 1.00842E-06_JPRB, 9.91271E-07_JPRB, &
+     & 9.74411E-07_JPRB, 9.57838E-07_JPRB, 9.41547E-07_JPRB, 9.25532E-07_JPRB, 9.09791E-07_JPRB, &
+     & 8.94316E-07_JPRB, 8.79105E-07_JPRB, 8.64153E-07_JPRB, 8.49455E-07_JPRB/)
+       KAO_MN2( 9, :, 7) = (/ &
+     & 1.53483E-06_JPRB, 1.51352E-06_JPRB, 1.49252E-06_JPRB, 1.47180E-06_JPRB, 1.45138E-06_JPRB, &
+     & 1.43123E-06_JPRB, 1.41137E-06_JPRB, 1.39178E-06_JPRB, 1.37246E-06_JPRB, 1.35341E-06_JPRB, &
+     & 1.33463E-06_JPRB, 1.31610E-06_JPRB, 1.29784E-06_JPRB, 1.27982E-06_JPRB, 1.26206E-06_JPRB, &
+     & 1.24454E-06_JPRB, 1.22727E-06_JPRB, 1.21024E-06_JPRB, 1.19344E-06_JPRB/)
+       KAO_MN2( 1, :, 8) = (/ &
+     & 1.70380E-06_JPRB, 1.67470E-06_JPRB, 1.64609E-06_JPRB, 1.61796E-06_JPRB, 1.59032E-06_JPRB, &
+     & 1.56315E-06_JPRB, 1.53645E-06_JPRB, 1.51020E-06_JPRB, 1.48440E-06_JPRB, 1.45904E-06_JPRB, &
+     & 1.43411E-06_JPRB, 1.40961E-06_JPRB, 1.38553E-06_JPRB, 1.36186E-06_JPRB, 1.33859E-06_JPRB, &
+     & 1.31572E-06_JPRB, 1.29324E-06_JPRB, 1.27115E-06_JPRB, 1.24943E-06_JPRB/)
+       KAO_MN2( 2, :, 8) = (/ &
+     & 1.70380E-06_JPRB, 1.67470E-06_JPRB, 1.64609E-06_JPRB, 1.61796E-06_JPRB, 1.59032E-06_JPRB, &
+     & 1.56315E-06_JPRB, 1.53645E-06_JPRB, 1.51020E-06_JPRB, 1.48440E-06_JPRB, 1.45904E-06_JPRB, &
+     & 1.43411E-06_JPRB, 1.40961E-06_JPRB, 1.38553E-06_JPRB, 1.36186E-06_JPRB, 1.33859E-06_JPRB, &
+     & 1.31572E-06_JPRB, 1.29324E-06_JPRB, 1.27115E-06_JPRB, 1.24943E-06_JPRB/)
+       KAO_MN2( 3, :, 8) = (/ &
+     & 1.70380E-06_JPRB, 1.67470E-06_JPRB, 1.64609E-06_JPRB, 1.61796E-06_JPRB, 1.59032E-06_JPRB, &
+     & 1.56315E-06_JPRB, 1.53645E-06_JPRB, 1.51020E-06_JPRB, 1.48440E-06_JPRB, 1.45904E-06_JPRB, &
+     & 1.43411E-06_JPRB, 1.40961E-06_JPRB, 1.38553E-06_JPRB, 1.36186E-06_JPRB, 1.33859E-06_JPRB, &
+     & 1.31572E-06_JPRB, 1.29324E-06_JPRB, 1.27115E-06_JPRB, 1.24943E-06_JPRB/)
+       KAO_MN2( 4, :, 8) = (/ &
+     & 1.70380E-06_JPRB, 1.67470E-06_JPRB, 1.64609E-06_JPRB, 1.61796E-06_JPRB, 1.59032E-06_JPRB, &
+     & 1.56315E-06_JPRB, 1.53645E-06_JPRB, 1.51020E-06_JPRB, 1.48440E-06_JPRB, 1.45904E-06_JPRB, &
+     & 1.43411E-06_JPRB, 1.40961E-06_JPRB, 1.38553E-06_JPRB, 1.36186E-06_JPRB, 1.33859E-06_JPRB, &
+     & 1.31572E-06_JPRB, 1.29324E-06_JPRB, 1.27115E-06_JPRB, 1.24943E-06_JPRB/)
+       KAO_MN2( 5, :, 8) = (/ &
+     & 1.70380E-06_JPRB, 1.67470E-06_JPRB, 1.64609E-06_JPRB, 1.61796E-06_JPRB, 1.59032E-06_JPRB, &
+     & 1.56315E-06_JPRB, 1.53645E-06_JPRB, 1.51020E-06_JPRB, 1.48440E-06_JPRB, 1.45904E-06_JPRB, &
+     & 1.43411E-06_JPRB, 1.40961E-06_JPRB, 1.38553E-06_JPRB, 1.36186E-06_JPRB, 1.33859E-06_JPRB, &
+     & 1.31572E-06_JPRB, 1.29324E-06_JPRB, 1.27115E-06_JPRB, 1.24943E-06_JPRB/)
+       KAO_MN2( 6, :, 8) = (/ &
+     & 1.70380E-06_JPRB, 1.67470E-06_JPRB, 1.64609E-06_JPRB, 1.61796E-06_JPRB, 1.59032E-06_JPRB, &
+     & 1.56315E-06_JPRB, 1.53645E-06_JPRB, 1.51020E-06_JPRB, 1.48440E-06_JPRB, 1.45904E-06_JPRB, &
+     & 1.43411E-06_JPRB, 1.40961E-06_JPRB, 1.38553E-06_JPRB, 1.36186E-06_JPRB, 1.33859E-06_JPRB, &
+     & 1.31572E-06_JPRB, 1.29324E-06_JPRB, 1.27115E-06_JPRB, 1.24943E-06_JPRB/)
+       KAO_MN2( 7, :, 8) = (/ &
+     & 1.71827E-06_JPRB, 1.65481E-06_JPRB, 1.59370E-06_JPRB, 1.53484E-06_JPRB, 1.47816E-06_JPRB, &
+     & 1.42357E-06_JPRB, 1.37099E-06_JPRB, 1.32036E-06_JPRB, 1.27160E-06_JPRB, 1.22464E-06_JPRB, &
+     & 1.17941E-06_JPRB, 1.13585E-06_JPRB, 1.09390E-06_JPRB, 1.05350E-06_JPRB, 1.01459E-06_JPRB, &
+     & 9.77124E-07_JPRB, 9.41037E-07_JPRB, 9.06284E-07_JPRB, 8.72813E-07_JPRB/)
+       KAO_MN2( 8, :, 8) = (/ &
+     & 1.77169E-06_JPRB, 1.62858E-06_JPRB, 1.49703E-06_JPRB, 1.37610E-06_JPRB, 1.26494E-06_JPRB, &
+     & 1.16276E-06_JPRB, 1.06883E-06_JPRB, 9.82495E-07_JPRB, 9.03131E-07_JPRB, 8.30177E-07_JPRB, &
+     & 7.63117E-07_JPRB, 7.01473E-07_JPRB, 6.44810E-07_JPRB, 5.92723E-07_JPRB, 5.44844E-07_JPRB, &
+     & 5.00832E-07_JPRB, 4.60376E-07_JPRB, 4.23187E-07_JPRB, 3.89003E-07_JPRB/)
+       KAO_MN2( 9, :, 8) = (/ &
+     & 1.70025E-06_JPRB, 1.67042E-06_JPRB, 1.64110E-06_JPRB, 1.61231E-06_JPRB, 1.58401E-06_JPRB, &
+     & 1.55622E-06_JPRB, 1.52891E-06_JPRB, 1.50208E-06_JPRB, 1.47572E-06_JPRB, 1.44982E-06_JPRB, &
+     & 1.42438E-06_JPRB, 1.39939E-06_JPRB, 1.37483E-06_JPRB, 1.35071E-06_JPRB, 1.32700E-06_JPRB, &
+     & 1.30372E-06_JPRB, 1.28084E-06_JPRB, 1.25836E-06_JPRB, 1.23628E-06_JPRB/)
+       KAO_MN2( 1, :, 9) = (/ &
+     & 1.74004E-06_JPRB, 1.70661E-06_JPRB, 1.67383E-06_JPRB, 1.64167E-06_JPRB, 1.61014E-06_JPRB, &
+     & 1.57921E-06_JPRB, 1.54887E-06_JPRB, 1.51912E-06_JPRB, 1.48994E-06_JPRB, 1.46132E-06_JPRB, &
+     & 1.43325E-06_JPRB, 1.40572E-06_JPRB, 1.37871E-06_JPRB, 1.35223E-06_JPRB, 1.32625E-06_JPRB, &
+     & 1.30078E-06_JPRB, 1.27579E-06_JPRB, 1.25128E-06_JPRB, 1.22725E-06_JPRB/)
+       KAO_MN2( 2, :, 9) = (/ &
+     & 1.74004E-06_JPRB, 1.70661E-06_JPRB, 1.67383E-06_JPRB, 1.64167E-06_JPRB, 1.61014E-06_JPRB, &
+     & 1.57921E-06_JPRB, 1.54887E-06_JPRB, 1.51912E-06_JPRB, 1.48994E-06_JPRB, 1.46132E-06_JPRB, &
+     & 1.43325E-06_JPRB, 1.40572E-06_JPRB, 1.37871E-06_JPRB, 1.35223E-06_JPRB, 1.32625E-06_JPRB, &
+     & 1.30078E-06_JPRB, 1.27579E-06_JPRB, 1.25128E-06_JPRB, 1.22725E-06_JPRB/)
+       KAO_MN2( 3, :, 9) = (/ &
+     & 1.74004E-06_JPRB, 1.70661E-06_JPRB, 1.67383E-06_JPRB, 1.64167E-06_JPRB, 1.61014E-06_JPRB, &
+     & 1.57921E-06_JPRB, 1.54887E-06_JPRB, 1.51912E-06_JPRB, 1.48994E-06_JPRB, 1.46132E-06_JPRB, &
+     & 1.43325E-06_JPRB, 1.40572E-06_JPRB, 1.37871E-06_JPRB, 1.35223E-06_JPRB, 1.32625E-06_JPRB, &
+     & 1.30078E-06_JPRB, 1.27579E-06_JPRB, 1.25128E-06_JPRB, 1.22725E-06_JPRB/)
+       KAO_MN2( 4, :, 9) = (/ &
+     & 1.74004E-06_JPRB, 1.70661E-06_JPRB, 1.67383E-06_JPRB, 1.64167E-06_JPRB, 1.61014E-06_JPRB, &
+     & 1.57921E-06_JPRB, 1.54887E-06_JPRB, 1.51912E-06_JPRB, 1.48994E-06_JPRB, 1.46132E-06_JPRB, &
+     & 1.43325E-06_JPRB, 1.40572E-06_JPRB, 1.37871E-06_JPRB, 1.35223E-06_JPRB, 1.32625E-06_JPRB, &
+     & 1.30078E-06_JPRB, 1.27579E-06_JPRB, 1.25128E-06_JPRB, 1.22725E-06_JPRB/)
+       KAO_MN2( 5, :, 9) = (/ &
+     & 1.74004E-06_JPRB, 1.70661E-06_JPRB, 1.67383E-06_JPRB, 1.64167E-06_JPRB, 1.61014E-06_JPRB, &
+     & 1.57921E-06_JPRB, 1.54887E-06_JPRB, 1.51912E-06_JPRB, 1.48994E-06_JPRB, 1.46132E-06_JPRB, &
+     & 1.43325E-06_JPRB, 1.40572E-06_JPRB, 1.37871E-06_JPRB, 1.35223E-06_JPRB, 1.32625E-06_JPRB, &
+     & 1.30078E-06_JPRB, 1.27579E-06_JPRB, 1.25128E-06_JPRB, 1.22725E-06_JPRB/)
+       KAO_MN2( 6, :, 9) = (/ &
+     & 1.74004E-06_JPRB, 1.70661E-06_JPRB, 1.67383E-06_JPRB, 1.64167E-06_JPRB, 1.61014E-06_JPRB, &
+     & 1.57921E-06_JPRB, 1.54887E-06_JPRB, 1.51912E-06_JPRB, 1.48994E-06_JPRB, 1.46132E-06_JPRB, &
+     & 1.43325E-06_JPRB, 1.40572E-06_JPRB, 1.37871E-06_JPRB, 1.35223E-06_JPRB, 1.32625E-06_JPRB, &
+     & 1.30078E-06_JPRB, 1.27579E-06_JPRB, 1.25128E-06_JPRB, 1.22725E-06_JPRB/)
+       KAO_MN2( 7, :, 9) = (/ &
+     & 1.74004E-06_JPRB, 1.70661E-06_JPRB, 1.67383E-06_JPRB, 1.64167E-06_JPRB, 1.61014E-06_JPRB, &
+     & 1.57921E-06_JPRB, 1.54887E-06_JPRB, 1.51912E-06_JPRB, 1.48994E-06_JPRB, 1.46132E-06_JPRB, &
+     & 1.43325E-06_JPRB, 1.40572E-06_JPRB, 1.37871E-06_JPRB, 1.35223E-06_JPRB, 1.32625E-06_JPRB, &
+     & 1.30078E-06_JPRB, 1.27579E-06_JPRB, 1.25128E-06_JPRB, 1.22725E-06_JPRB/)
+       KAO_MN2( 8, :, 9) = (/ &
+     & 1.08654E-06_JPRB, 1.09039E-06_JPRB, 1.09425E-06_JPRB, 1.09812E-06_JPRB, 1.10201E-06_JPRB, &
+     & 1.10592E-06_JPRB, 1.10983E-06_JPRB, 1.11376E-06_JPRB, 1.11771E-06_JPRB, 1.12167E-06_JPRB, &
+     & 1.12564E-06_JPRB, 1.12962E-06_JPRB, 1.13363E-06_JPRB, 1.13764E-06_JPRB, 1.14167E-06_JPRB, &
+     & 1.14571E-06_JPRB, 1.14977E-06_JPRB, 1.15384E-06_JPRB, 1.15793E-06_JPRB/)
+       KAO_MN2( 9, :, 9) = (/ &
+     & 1.74382E-06_JPRB, 1.71092E-06_JPRB, 1.67864E-06_JPRB, 1.64697E-06_JPRB, 1.61589E-06_JPRB, &
+     & 1.58541E-06_JPRB, 1.55549E-06_JPRB, 1.52615E-06_JPRB, 1.49735E-06_JPRB, 1.46910E-06_JPRB, &
+     & 1.44138E-06_JPRB, 1.41419E-06_JPRB, 1.38751E-06_JPRB, 1.36133E-06_JPRB, 1.33564E-06_JPRB, &
+     & 1.31045E-06_JPRB, 1.28572E-06_JPRB, 1.26146E-06_JPRB, 1.23766E-06_JPRB/)
+       KAO_MN2( 1, :,10) = (/ &
+     & 1.73703E-06_JPRB, 1.70249E-06_JPRB, 1.66863E-06_JPRB, 1.63544E-06_JPRB, 1.60292E-06_JPRB, &
+     & 1.57104E-06_JPRB, 1.53980E-06_JPRB, 1.50917E-06_JPRB, 1.47916E-06_JPRB, 1.44974E-06_JPRB, &
+     & 1.42091E-06_JPRB, 1.39265E-06_JPRB, 1.36496E-06_JPRB, 1.33781E-06_JPRB, 1.31121E-06_JPRB, &
+     & 1.28513E-06_JPRB, 1.25957E-06_JPRB, 1.23452E-06_JPRB, 1.20997E-06_JPRB/)
+       KAO_MN2( 2, :,10) = (/ &
+     & 1.73703E-06_JPRB, 1.70249E-06_JPRB, 1.66863E-06_JPRB, 1.63544E-06_JPRB, 1.60292E-06_JPRB, &
+     & 1.57104E-06_JPRB, 1.53980E-06_JPRB, 1.50917E-06_JPRB, 1.47916E-06_JPRB, 1.44974E-06_JPRB, &
+     & 1.42091E-06_JPRB, 1.39265E-06_JPRB, 1.36496E-06_JPRB, 1.33781E-06_JPRB, 1.31121E-06_JPRB, &
+     & 1.28513E-06_JPRB, 1.25957E-06_JPRB, 1.23452E-06_JPRB, 1.20997E-06_JPRB/)
+       KAO_MN2( 3, :,10) = (/ &
+     & 1.73703E-06_JPRB, 1.70249E-06_JPRB, 1.66863E-06_JPRB, 1.63544E-06_JPRB, 1.60292E-06_JPRB, &
+     & 1.57104E-06_JPRB, 1.53980E-06_JPRB, 1.50917E-06_JPRB, 1.47916E-06_JPRB, 1.44974E-06_JPRB, &
+     & 1.42091E-06_JPRB, 1.39265E-06_JPRB, 1.36496E-06_JPRB, 1.33781E-06_JPRB, 1.31121E-06_JPRB, &
+     & 1.28513E-06_JPRB, 1.25957E-06_JPRB, 1.23452E-06_JPRB, 1.20997E-06_JPRB/)
+       KAO_MN2( 4, :,10) = (/ &
+     & 1.73703E-06_JPRB, 1.70249E-06_JPRB, 1.66863E-06_JPRB, 1.63544E-06_JPRB, 1.60292E-06_JPRB, &
+     & 1.57104E-06_JPRB, 1.53980E-06_JPRB, 1.50917E-06_JPRB, 1.47916E-06_JPRB, 1.44974E-06_JPRB, &
+     & 1.42091E-06_JPRB, 1.39265E-06_JPRB, 1.36496E-06_JPRB, 1.33781E-06_JPRB, 1.31121E-06_JPRB, &
+     & 1.28513E-06_JPRB, 1.25957E-06_JPRB, 1.23452E-06_JPRB, 1.20997E-06_JPRB/)
+       KAO_MN2( 5, :,10) = (/ &
+     & 1.73703E-06_JPRB, 1.70249E-06_JPRB, 1.66863E-06_JPRB, 1.63544E-06_JPRB, 1.60292E-06_JPRB, &
+     & 1.57104E-06_JPRB, 1.53980E-06_JPRB, 1.50917E-06_JPRB, 1.47916E-06_JPRB, 1.44974E-06_JPRB, &
+     & 1.42091E-06_JPRB, 1.39265E-06_JPRB, 1.36496E-06_JPRB, 1.33781E-06_JPRB, 1.31121E-06_JPRB, &
+     & 1.28513E-06_JPRB, 1.25957E-06_JPRB, 1.23452E-06_JPRB, 1.20997E-06_JPRB/)
+       KAO_MN2( 6, :,10) = (/ &
+     & 1.73703E-06_JPRB, 1.70249E-06_JPRB, 1.66863E-06_JPRB, 1.63544E-06_JPRB, 1.60292E-06_JPRB, &
+     & 1.57104E-06_JPRB, 1.53980E-06_JPRB, 1.50917E-06_JPRB, 1.47916E-06_JPRB, 1.44974E-06_JPRB, &
+     & 1.42091E-06_JPRB, 1.39265E-06_JPRB, 1.36496E-06_JPRB, 1.33781E-06_JPRB, 1.31121E-06_JPRB, &
+     & 1.28513E-06_JPRB, 1.25957E-06_JPRB, 1.23452E-06_JPRB, 1.20997E-06_JPRB/)
+       KAO_MN2( 7, :,10) = (/ &
+     & 1.73703E-06_JPRB, 1.70249E-06_JPRB, 1.66863E-06_JPRB, 1.63544E-06_JPRB, 1.60292E-06_JPRB, &
+     & 1.57104E-06_JPRB, 1.53980E-06_JPRB, 1.50917E-06_JPRB, 1.47916E-06_JPRB, 1.44974E-06_JPRB, &
+     & 1.42091E-06_JPRB, 1.39265E-06_JPRB, 1.36496E-06_JPRB, 1.33781E-06_JPRB, 1.31121E-06_JPRB, &
+     & 1.28513E-06_JPRB, 1.25957E-06_JPRB, 1.23452E-06_JPRB, 1.20997E-06_JPRB/)
+       KAO_MN2( 8, :,10) = (/ &
+     & 1.73703E-06_JPRB, 1.70249E-06_JPRB, 1.66863E-06_JPRB, 1.63544E-06_JPRB, 1.60292E-06_JPRB, &
+     & 1.57104E-06_JPRB, 1.53980E-06_JPRB, 1.50917E-06_JPRB, 1.47916E-06_JPRB, 1.44974E-06_JPRB, &
+     & 1.42091E-06_JPRB, 1.39265E-06_JPRB, 1.36496E-06_JPRB, 1.33781E-06_JPRB, 1.31121E-06_JPRB, &
+     & 1.28513E-06_JPRB, 1.25957E-06_JPRB, 1.23452E-06_JPRB, 1.20997E-06_JPRB/)
+       KAO_MN2( 9, :,10) = (/ &
+     & 1.82903E-06_JPRB, 1.78673E-06_JPRB, 1.74541E-06_JPRB, 1.70505E-06_JPRB, 1.66562E-06_JPRB, &
+     & 1.62710E-06_JPRB, 1.58947E-06_JPRB, 1.55271E-06_JPRB, 1.51680E-06_JPRB, 1.48172E-06_JPRB, &
+     & 1.44745E-06_JPRB, 1.41398E-06_JPRB, 1.38128E-06_JPRB, 1.34933E-06_JPRB, 1.31813E-06_JPRB, &
+     & 1.28765E-06_JPRB, 1.25787E-06_JPRB, 1.22878E-06_JPRB, 1.20036E-06_JPRB/)
+       KAO_MN2( 1, :,11) = (/ &
+     & 1.73118E-06_JPRB, 1.69710E-06_JPRB, 1.66370E-06_JPRB, 1.63095E-06_JPRB, 1.59885E-06_JPRB, &
+     & 1.56737E-06_JPRB, 1.53652E-06_JPRB, 1.50628E-06_JPRB, 1.47663E-06_JPRB, 1.44756E-06_JPRB, &
+     & 1.41907E-06_JPRB, 1.39114E-06_JPRB, 1.36376E-06_JPRB, 1.33691E-06_JPRB, 1.31060E-06_JPRB, &
+     & 1.28480E-06_JPRB, 1.25951E-06_JPRB, 1.23472E-06_JPRB, 1.21041E-06_JPRB/)
+       KAO_MN2( 2, :,11) = (/ &
+     & 1.73118E-06_JPRB, 1.69710E-06_JPRB, 1.66370E-06_JPRB, 1.63095E-06_JPRB, 1.59885E-06_JPRB, &
+     & 1.56737E-06_JPRB, 1.53652E-06_JPRB, 1.50628E-06_JPRB, 1.47663E-06_JPRB, 1.44756E-06_JPRB, &
+     & 1.41907E-06_JPRB, 1.39114E-06_JPRB, 1.36376E-06_JPRB, 1.33691E-06_JPRB, 1.31060E-06_JPRB, &
+     & 1.28480E-06_JPRB, 1.25951E-06_JPRB, 1.23472E-06_JPRB, 1.21041E-06_JPRB/)
+       KAO_MN2( 3, :,11) = (/ &
+     & 1.73118E-06_JPRB, 1.69710E-06_JPRB, 1.66370E-06_JPRB, 1.63095E-06_JPRB, 1.59885E-06_JPRB, &
+     & 1.56737E-06_JPRB, 1.53652E-06_JPRB, 1.50628E-06_JPRB, 1.47663E-06_JPRB, 1.44756E-06_JPRB, &
+     & 1.41907E-06_JPRB, 1.39114E-06_JPRB, 1.36376E-06_JPRB, 1.33691E-06_JPRB, 1.31060E-06_JPRB, &
+     & 1.28480E-06_JPRB, 1.25951E-06_JPRB, 1.23472E-06_JPRB, 1.21041E-06_JPRB/)
+       KAO_MN2( 4, :,11) = (/ &
+     & 1.73118E-06_JPRB, 1.69710E-06_JPRB, 1.66370E-06_JPRB, 1.63095E-06_JPRB, 1.59885E-06_JPRB, &
+     & 1.56737E-06_JPRB, 1.53652E-06_JPRB, 1.50628E-06_JPRB, 1.47663E-06_JPRB, 1.44756E-06_JPRB, &
+     & 1.41907E-06_JPRB, 1.39114E-06_JPRB, 1.36376E-06_JPRB, 1.33691E-06_JPRB, 1.31060E-06_JPRB, &
+     & 1.28480E-06_JPRB, 1.25951E-06_JPRB, 1.23472E-06_JPRB, 1.21041E-06_JPRB/)
+       KAO_MN2( 5, :,11) = (/ &
+     & 1.73118E-06_JPRB, 1.69710E-06_JPRB, 1.66370E-06_JPRB, 1.63095E-06_JPRB, 1.59885E-06_JPRB, &
+     & 1.56737E-06_JPRB, 1.53652E-06_JPRB, 1.50628E-06_JPRB, 1.47663E-06_JPRB, 1.44756E-06_JPRB, &
+     & 1.41907E-06_JPRB, 1.39114E-06_JPRB, 1.36376E-06_JPRB, 1.33691E-06_JPRB, 1.31060E-06_JPRB, &
+     & 1.28480E-06_JPRB, 1.25951E-06_JPRB, 1.23472E-06_JPRB, 1.21041E-06_JPRB/)
+       KAO_MN2( 6, :,11) = (/ &
+     & 1.73118E-06_JPRB, 1.69710E-06_JPRB, 1.66370E-06_JPRB, 1.63095E-06_JPRB, 1.59885E-06_JPRB, &
+     & 1.56737E-06_JPRB, 1.53652E-06_JPRB, 1.50628E-06_JPRB, 1.47663E-06_JPRB, 1.44756E-06_JPRB, &
+     & 1.41907E-06_JPRB, 1.39114E-06_JPRB, 1.36376E-06_JPRB, 1.33691E-06_JPRB, 1.31060E-06_JPRB, &
+     & 1.28480E-06_JPRB, 1.25951E-06_JPRB, 1.23472E-06_JPRB, 1.21041E-06_JPRB/)
+       KAO_MN2( 7, :,11) = (/ &
+     & 1.73118E-06_JPRB, 1.69710E-06_JPRB, 1.66370E-06_JPRB, 1.63095E-06_JPRB, 1.59885E-06_JPRB, &
+     & 1.56737E-06_JPRB, 1.53652E-06_JPRB, 1.50628E-06_JPRB, 1.47663E-06_JPRB, 1.44756E-06_JPRB, &
+     & 1.41907E-06_JPRB, 1.39114E-06_JPRB, 1.36376E-06_JPRB, 1.33691E-06_JPRB, 1.31060E-06_JPRB, &
+     & 1.28480E-06_JPRB, 1.25951E-06_JPRB, 1.23472E-06_JPRB, 1.21041E-06_JPRB/)
+       KAO_MN2( 8, :,11) = (/ &
+     & 1.73118E-06_JPRB, 1.69710E-06_JPRB, 1.66370E-06_JPRB, 1.63095E-06_JPRB, 1.59885E-06_JPRB, &
+     & 1.56737E-06_JPRB, 1.53652E-06_JPRB, 1.50628E-06_JPRB, 1.47663E-06_JPRB, 1.44756E-06_JPRB, &
+     & 1.41907E-06_JPRB, 1.39114E-06_JPRB, 1.36376E-06_JPRB, 1.33691E-06_JPRB, 1.31060E-06_JPRB, &
+     & 1.28480E-06_JPRB, 1.25951E-06_JPRB, 1.23472E-06_JPRB, 1.21041E-06_JPRB/)
+       KAO_MN2( 9, :,11) = (/ &
+     & 1.81037E-06_JPRB, 1.76948E-06_JPRB, 1.72952E-06_JPRB, 1.69045E-06_JPRB, 1.65228E-06_JPRB, &
+     & 1.61496E-06_JPRB, 1.57848E-06_JPRB, 1.54283E-06_JPRB, 1.50799E-06_JPRB, 1.47393E-06_JPRB, &
+     & 1.44064E-06_JPRB, 1.40810E-06_JPRB, 1.37630E-06_JPRB, 1.34522E-06_JPRB, 1.31484E-06_JPRB, &
+     & 1.28514E-06_JPRB, 1.25611E-06_JPRB, 1.22774E-06_JPRB, 1.20002E-06_JPRB/)
+       KAO_MN2( 1, :,12) = (/ &
+     & 1.73338E-06_JPRB, 1.69915E-06_JPRB, 1.66560E-06_JPRB, 1.63271E-06_JPRB, 1.60046E-06_JPRB, &
+     & 1.56886E-06_JPRB, 1.53788E-06_JPRB, 1.50751E-06_JPRB, 1.47774E-06_JPRB, 1.44856E-06_JPRB, &
+     & 1.41995E-06_JPRB, 1.39191E-06_JPRB, 1.36442E-06_JPRB, 1.33748E-06_JPRB, 1.31107E-06_JPRB, &
+     & 1.28518E-06_JPRB, 1.25980E-06_JPRB, 1.23492E-06_JPRB, 1.21053E-06_JPRB/)
+       KAO_MN2( 2, :,12) = (/ &
+     & 1.73338E-06_JPRB, 1.69915E-06_JPRB, 1.66560E-06_JPRB, 1.63271E-06_JPRB, 1.60046E-06_JPRB, &
+     & 1.56886E-06_JPRB, 1.53788E-06_JPRB, 1.50751E-06_JPRB, 1.47774E-06_JPRB, 1.44856E-06_JPRB, &
+     & 1.41995E-06_JPRB, 1.39191E-06_JPRB, 1.36442E-06_JPRB, 1.33748E-06_JPRB, 1.31107E-06_JPRB, &
+     & 1.28518E-06_JPRB, 1.25980E-06_JPRB, 1.23492E-06_JPRB, 1.21053E-06_JPRB/)
+       KAO_MN2( 3, :,12) = (/ &
+     & 1.73338E-06_JPRB, 1.69915E-06_JPRB, 1.66560E-06_JPRB, 1.63271E-06_JPRB, 1.60046E-06_JPRB, &
+     & 1.56886E-06_JPRB, 1.53788E-06_JPRB, 1.50751E-06_JPRB, 1.47774E-06_JPRB, 1.44856E-06_JPRB, &
+     & 1.41995E-06_JPRB, 1.39191E-06_JPRB, 1.36442E-06_JPRB, 1.33748E-06_JPRB, 1.31107E-06_JPRB, &
+     & 1.28518E-06_JPRB, 1.25980E-06_JPRB, 1.23492E-06_JPRB, 1.21053E-06_JPRB/)
+       KAO_MN2( 4, :,12) = (/ &
+     & 1.73338E-06_JPRB, 1.69915E-06_JPRB, 1.66560E-06_JPRB, 1.63271E-06_JPRB, 1.60046E-06_JPRB, &
+     & 1.56886E-06_JPRB, 1.53788E-06_JPRB, 1.50751E-06_JPRB, 1.47774E-06_JPRB, 1.44856E-06_JPRB, &
+     & 1.41995E-06_JPRB, 1.39191E-06_JPRB, 1.36442E-06_JPRB, 1.33748E-06_JPRB, 1.31107E-06_JPRB, &
+     & 1.28518E-06_JPRB, 1.25980E-06_JPRB, 1.23492E-06_JPRB, 1.21053E-06_JPRB/)
+       KAO_MN2( 5, :,12) = (/ &
+     & 1.73338E-06_JPRB, 1.69915E-06_JPRB, 1.66560E-06_JPRB, 1.63271E-06_JPRB, 1.60046E-06_JPRB, &
+     & 1.56886E-06_JPRB, 1.53788E-06_JPRB, 1.50751E-06_JPRB, 1.47774E-06_JPRB, 1.44856E-06_JPRB, &
+     & 1.41995E-06_JPRB, 1.39191E-06_JPRB, 1.36442E-06_JPRB, 1.33748E-06_JPRB, 1.31107E-06_JPRB, &
+     & 1.28518E-06_JPRB, 1.25980E-06_JPRB, 1.23492E-06_JPRB, 1.21053E-06_JPRB/)
+       KAO_MN2( 6, :,12) = (/ &
+     & 1.73338E-06_JPRB, 1.69915E-06_JPRB, 1.66560E-06_JPRB, 1.63271E-06_JPRB, 1.60046E-06_JPRB, &
+     & 1.56886E-06_JPRB, 1.53788E-06_JPRB, 1.50751E-06_JPRB, 1.47774E-06_JPRB, 1.44856E-06_JPRB, &
+     & 1.41995E-06_JPRB, 1.39191E-06_JPRB, 1.36442E-06_JPRB, 1.33748E-06_JPRB, 1.31107E-06_JPRB, &
+     & 1.28518E-06_JPRB, 1.25980E-06_JPRB, 1.23492E-06_JPRB, 1.21053E-06_JPRB/)
+       KAO_MN2( 7, :,12) = (/ &
+     & 1.73338E-06_JPRB, 1.69915E-06_JPRB, 1.66560E-06_JPRB, 1.63271E-06_JPRB, 1.60046E-06_JPRB, &
+     & 1.56886E-06_JPRB, 1.53788E-06_JPRB, 1.50751E-06_JPRB, 1.47774E-06_JPRB, 1.44856E-06_JPRB, &
+     & 1.41995E-06_JPRB, 1.39191E-06_JPRB, 1.36442E-06_JPRB, 1.33748E-06_JPRB, 1.31107E-06_JPRB, &
+     & 1.28518E-06_JPRB, 1.25980E-06_JPRB, 1.23492E-06_JPRB, 1.21053E-06_JPRB/)
+       KAO_MN2( 8, :,12) = (/ &
+     & 1.73338E-06_JPRB, 1.69915E-06_JPRB, 1.66560E-06_JPRB, 1.63271E-06_JPRB, 1.60046E-06_JPRB, &
+     & 1.56886E-06_JPRB, 1.53788E-06_JPRB, 1.50751E-06_JPRB, 1.47774E-06_JPRB, 1.44856E-06_JPRB, &
+     & 1.41995E-06_JPRB, 1.39191E-06_JPRB, 1.36442E-06_JPRB, 1.33748E-06_JPRB, 1.31107E-06_JPRB, &
+     & 1.28518E-06_JPRB, 1.25980E-06_JPRB, 1.23492E-06_JPRB, 1.21053E-06_JPRB/)
+       KAO_MN2( 9, :,12) = (/ &
+     & 2.04857E-06_JPRB, 1.98353E-06_JPRB, 1.92055E-06_JPRB, 1.85957E-06_JPRB, 1.80053E-06_JPRB, &
+     & 1.74336E-06_JPRB, 1.68800E-06_JPRB, 1.63441E-06_JPRB, 1.58251E-06_JPRB, 1.53227E-06_JPRB, &
+     & 1.48362E-06_JPRB, 1.43651E-06_JPRB, 1.39090E-06_JPRB, 1.34674E-06_JPRB, 1.30398E-06_JPRB, &
+     & 1.26257E-06_JPRB, 1.22249E-06_JPRB, 1.18367E-06_JPRB, 1.14609E-06_JPRB/)
+       KAO_MN2( 1, :,13) = (/ &
+     & 1.73511E-06_JPRB, 1.70072E-06_JPRB, 1.66702E-06_JPRB, 1.63398E-06_JPRB, 1.60159E-06_JPRB, &
+     & 1.56985E-06_JPRB, 1.53874E-06_JPRB, 1.50824E-06_JPRB, 1.47835E-06_JPRB, 1.44905E-06_JPRB, &
+     & 1.42033E-06_JPRB, 1.39218E-06_JPRB, 1.36459E-06_JPRB, 1.33755E-06_JPRB, 1.31104E-06_JPRB, &
+     & 1.28505E-06_JPRB, 1.25958E-06_JPRB, 1.23462E-06_JPRB, 1.21015E-06_JPRB/)
+       KAO_MN2( 2, :,13) = (/ &
+     & 1.73511E-06_JPRB, 1.70072E-06_JPRB, 1.66702E-06_JPRB, 1.63398E-06_JPRB, 1.60159E-06_JPRB, &
+     & 1.56985E-06_JPRB, 1.53874E-06_JPRB, 1.50824E-06_JPRB, 1.47835E-06_JPRB, 1.44905E-06_JPRB, &
+     & 1.42033E-06_JPRB, 1.39218E-06_JPRB, 1.36459E-06_JPRB, 1.33755E-06_JPRB, 1.31104E-06_JPRB, &
+     & 1.28505E-06_JPRB, 1.25958E-06_JPRB, 1.23462E-06_JPRB, 1.21015E-06_JPRB/)
+       KAO_MN2( 3, :,13) = (/ &
+     & 1.73511E-06_JPRB, 1.70072E-06_JPRB, 1.66702E-06_JPRB, 1.63398E-06_JPRB, 1.60159E-06_JPRB, &
+     & 1.56985E-06_JPRB, 1.53874E-06_JPRB, 1.50824E-06_JPRB, 1.47835E-06_JPRB, 1.44905E-06_JPRB, &
+     & 1.42033E-06_JPRB, 1.39218E-06_JPRB, 1.36459E-06_JPRB, 1.33755E-06_JPRB, 1.31104E-06_JPRB, &
+     & 1.28505E-06_JPRB, 1.25958E-06_JPRB, 1.23462E-06_JPRB, 1.21015E-06_JPRB/)
+       KAO_MN2( 4, :,13) = (/ &
+     & 1.73511E-06_JPRB, 1.70072E-06_JPRB, 1.66702E-06_JPRB, 1.63398E-06_JPRB, 1.60159E-06_JPRB, &
+     & 1.56985E-06_JPRB, 1.53874E-06_JPRB, 1.50824E-06_JPRB, 1.47835E-06_JPRB, 1.44905E-06_JPRB, &
+     & 1.42033E-06_JPRB, 1.39218E-06_JPRB, 1.36459E-06_JPRB, 1.33755E-06_JPRB, 1.31104E-06_JPRB, &
+     & 1.28505E-06_JPRB, 1.25958E-06_JPRB, 1.23462E-06_JPRB, 1.21015E-06_JPRB/)
+       KAO_MN2( 5, :,13) = (/ &
+     & 1.73511E-06_JPRB, 1.70072E-06_JPRB, 1.66702E-06_JPRB, 1.63398E-06_JPRB, 1.60159E-06_JPRB, &
+     & 1.56985E-06_JPRB, 1.53874E-06_JPRB, 1.50824E-06_JPRB, 1.47835E-06_JPRB, 1.44905E-06_JPRB, &
+     & 1.42033E-06_JPRB, 1.39218E-06_JPRB, 1.36459E-06_JPRB, 1.33755E-06_JPRB, 1.31104E-06_JPRB, &
+     & 1.28505E-06_JPRB, 1.25958E-06_JPRB, 1.23462E-06_JPRB, 1.21015E-06_JPRB/)
+       KAO_MN2( 6, :,13) = (/ &
+     & 1.73511E-06_JPRB, 1.70072E-06_JPRB, 1.66702E-06_JPRB, 1.63398E-06_JPRB, 1.60159E-06_JPRB, &
+     & 1.56985E-06_JPRB, 1.53874E-06_JPRB, 1.50824E-06_JPRB, 1.47835E-06_JPRB, 1.44905E-06_JPRB, &
+     & 1.42033E-06_JPRB, 1.39218E-06_JPRB, 1.36459E-06_JPRB, 1.33755E-06_JPRB, 1.31104E-06_JPRB, &
+     & 1.28505E-06_JPRB, 1.25958E-06_JPRB, 1.23462E-06_JPRB, 1.21015E-06_JPRB/)
+       KAO_MN2( 7, :,13) = (/ &
+     & 1.73511E-06_JPRB, 1.70072E-06_JPRB, 1.66702E-06_JPRB, 1.63398E-06_JPRB, 1.60159E-06_JPRB, &
+     & 1.56985E-06_JPRB, 1.53874E-06_JPRB, 1.50824E-06_JPRB, 1.47835E-06_JPRB, 1.44905E-06_JPRB, &
+     & 1.42033E-06_JPRB, 1.39218E-06_JPRB, 1.36459E-06_JPRB, 1.33755E-06_JPRB, 1.31104E-06_JPRB, &
+     & 1.28505E-06_JPRB, 1.25958E-06_JPRB, 1.23462E-06_JPRB, 1.21015E-06_JPRB/)
+       KAO_MN2( 8, :,13) = (/ &
+     & 1.73511E-06_JPRB, 1.70072E-06_JPRB, 1.66702E-06_JPRB, 1.63398E-06_JPRB, 1.60159E-06_JPRB, &
+     & 1.56985E-06_JPRB, 1.53874E-06_JPRB, 1.50824E-06_JPRB, 1.47835E-06_JPRB, 1.44905E-06_JPRB, &
+     & 1.42033E-06_JPRB, 1.39218E-06_JPRB, 1.36459E-06_JPRB, 1.33755E-06_JPRB, 1.31104E-06_JPRB, &
+     & 1.28505E-06_JPRB, 1.25958E-06_JPRB, 1.23462E-06_JPRB, 1.21015E-06_JPRB/)
+       KAO_MN2( 9, :,13) = (/ &
+     & 2.13403E-06_JPRB, 2.05906E-06_JPRB, 1.98673E-06_JPRB, 1.91694E-06_JPRB, 1.84961E-06_JPRB, &
+     & 1.78463E-06_JPRB, 1.72194E-06_JPRB, 1.66145E-06_JPRB, 1.60309E-06_JPRB, 1.54678E-06_JPRB, &
+     & 1.49244E-06_JPRB, 1.44002E-06_JPRB, 1.38943E-06_JPRB, 1.34062E-06_JPRB, 1.29353E-06_JPRB, &
+     & 1.24809E-06_JPRB, 1.20425E-06_JPRB, 1.16195E-06_JPRB, 1.12113E-06_JPRB/)
+       KAO_MN2( 1, :,14) = (/ &
+     & 1.73398E-06_JPRB, 1.69941E-06_JPRB, 1.66553E-06_JPRB, 1.63233E-06_JPRB, 1.59979E-06_JPRB, &
+     & 1.56790E-06_JPRB, 1.53664E-06_JPRB, 1.50601E-06_JPRB, 1.47598E-06_JPRB, 1.44656E-06_JPRB, &
+     & 1.41772E-06_JPRB, 1.38946E-06_JPRB, 1.36176E-06_JPRB, 1.33461E-06_JPRB, 1.30801E-06_JPRB, &
+     & 1.28193E-06_JPRB, 1.25637E-06_JPRB, 1.23133E-06_JPRB, 1.20678E-06_JPRB/)
+       KAO_MN2( 2, :,14) = (/ &
+     & 1.73398E-06_JPRB, 1.69941E-06_JPRB, 1.66553E-06_JPRB, 1.63233E-06_JPRB, 1.59979E-06_JPRB, &
+     & 1.56790E-06_JPRB, 1.53664E-06_JPRB, 1.50601E-06_JPRB, 1.47598E-06_JPRB, 1.44656E-06_JPRB, &
+     & 1.41772E-06_JPRB, 1.38946E-06_JPRB, 1.36176E-06_JPRB, 1.33461E-06_JPRB, 1.30801E-06_JPRB, &
+     & 1.28193E-06_JPRB, 1.25637E-06_JPRB, 1.23133E-06_JPRB, 1.20678E-06_JPRB/)
+       KAO_MN2( 3, :,14) = (/ &
+     & 1.73398E-06_JPRB, 1.69941E-06_JPRB, 1.66553E-06_JPRB, 1.63233E-06_JPRB, 1.59979E-06_JPRB, &
+     & 1.56790E-06_JPRB, 1.53664E-06_JPRB, 1.50601E-06_JPRB, 1.47598E-06_JPRB, 1.44656E-06_JPRB, &
+     & 1.41772E-06_JPRB, 1.38946E-06_JPRB, 1.36176E-06_JPRB, 1.33461E-06_JPRB, 1.30801E-06_JPRB, &
+     & 1.28193E-06_JPRB, 1.25637E-06_JPRB, 1.23133E-06_JPRB, 1.20678E-06_JPRB/)
+       KAO_MN2( 4, :,14) = (/ &
+     & 1.73398E-06_JPRB, 1.69941E-06_JPRB, 1.66553E-06_JPRB, 1.63233E-06_JPRB, 1.59979E-06_JPRB, &
+     & 1.56790E-06_JPRB, 1.53664E-06_JPRB, 1.50601E-06_JPRB, 1.47598E-06_JPRB, 1.44656E-06_JPRB, &
+     & 1.41772E-06_JPRB, 1.38946E-06_JPRB, 1.36176E-06_JPRB, 1.33461E-06_JPRB, 1.30801E-06_JPRB, &
+     & 1.28193E-06_JPRB, 1.25637E-06_JPRB, 1.23133E-06_JPRB, 1.20678E-06_JPRB/)
+       KAO_MN2( 5, :,14) = (/ &
+     & 1.73398E-06_JPRB, 1.69941E-06_JPRB, 1.66553E-06_JPRB, 1.63233E-06_JPRB, 1.59979E-06_JPRB, &
+     & 1.56790E-06_JPRB, 1.53664E-06_JPRB, 1.50601E-06_JPRB, 1.47598E-06_JPRB, 1.44656E-06_JPRB, &
+     & 1.41772E-06_JPRB, 1.38946E-06_JPRB, 1.36176E-06_JPRB, 1.33461E-06_JPRB, 1.30801E-06_JPRB, &
+     & 1.28193E-06_JPRB, 1.25637E-06_JPRB, 1.23133E-06_JPRB, 1.20678E-06_JPRB/)
+       KAO_MN2( 6, :,14) = (/ &
+     & 1.73398E-06_JPRB, 1.69941E-06_JPRB, 1.66553E-06_JPRB, 1.63233E-06_JPRB, 1.59979E-06_JPRB, &
+     & 1.56790E-06_JPRB, 1.53664E-06_JPRB, 1.50601E-06_JPRB, 1.47598E-06_JPRB, 1.44656E-06_JPRB, &
+     & 1.41772E-06_JPRB, 1.38946E-06_JPRB, 1.36176E-06_JPRB, 1.33461E-06_JPRB, 1.30801E-06_JPRB, &
+     & 1.28193E-06_JPRB, 1.25637E-06_JPRB, 1.23133E-06_JPRB, 1.20678E-06_JPRB/)
+       KAO_MN2( 7, :,14) = (/ &
+     & 1.73398E-06_JPRB, 1.69941E-06_JPRB, 1.66553E-06_JPRB, 1.63233E-06_JPRB, 1.59979E-06_JPRB, &
+     & 1.56790E-06_JPRB, 1.53664E-06_JPRB, 1.50601E-06_JPRB, 1.47598E-06_JPRB, 1.44656E-06_JPRB, &
+     & 1.41772E-06_JPRB, 1.38946E-06_JPRB, 1.36176E-06_JPRB, 1.33461E-06_JPRB, 1.30801E-06_JPRB, &
+     & 1.28193E-06_JPRB, 1.25637E-06_JPRB, 1.23133E-06_JPRB, 1.20678E-06_JPRB/)
+       KAO_MN2( 8, :,14) = (/ &
+     & 1.73398E-06_JPRB, 1.69941E-06_JPRB, 1.66553E-06_JPRB, 1.63233E-06_JPRB, 1.59979E-06_JPRB, &
+     & 1.56790E-06_JPRB, 1.53664E-06_JPRB, 1.50601E-06_JPRB, 1.47598E-06_JPRB, 1.44656E-06_JPRB, &
+     & 1.41772E-06_JPRB, 1.38946E-06_JPRB, 1.36176E-06_JPRB, 1.33461E-06_JPRB, 1.30801E-06_JPRB, &
+     & 1.28193E-06_JPRB, 1.25637E-06_JPRB, 1.23133E-06_JPRB, 1.20678E-06_JPRB/)
+       KAO_MN2( 9, :,14) = (/ &
+     & 1.83423E-06_JPRB, 1.79123E-06_JPRB, 1.74923E-06_JPRB, 1.70821E-06_JPRB, 1.66816E-06_JPRB, &
+     & 1.62904E-06_JPRB, 1.59085E-06_JPRB, 1.55354E-06_JPRB, 1.51712E-06_JPRB, 1.48154E-06_JPRB, &
+     & 1.44681E-06_JPRB, 1.41288E-06_JPRB, 1.37975E-06_JPRB, 1.34740E-06_JPRB, 1.31581E-06_JPRB, &
+     & 1.28496E-06_JPRB, 1.25483E-06_JPRB, 1.22540E-06_JPRB, 1.19667E-06_JPRB/)
+       KAO_MN2( 1, :,15) = (/ &
+     & 1.73231E-06_JPRB, 1.69765E-06_JPRB, 1.66368E-06_JPRB, 1.63039E-06_JPRB, 1.59776E-06_JPRB, &
+     & 1.56579E-06_JPRB, 1.53445E-06_JPRB, 1.50375E-06_JPRB, 1.47366E-06_JPRB, 1.44417E-06_JPRB, &
+     & 1.41527E-06_JPRB, 1.38695E-06_JPRB, 1.35919E-06_JPRB, 1.33199E-06_JPRB, 1.30534E-06_JPRB, &
+     & 1.27922E-06_JPRB, 1.25362E-06_JPRB, 1.22853E-06_JPRB, 1.20395E-06_JPRB/)
+       KAO_MN2( 2, :,15) = (/ &
+     & 1.73231E-06_JPRB, 1.69765E-06_JPRB, 1.66368E-06_JPRB, 1.63039E-06_JPRB, 1.59776E-06_JPRB, &
+     & 1.56579E-06_JPRB, 1.53445E-06_JPRB, 1.50375E-06_JPRB, 1.47366E-06_JPRB, 1.44417E-06_JPRB, &
+     & 1.41527E-06_JPRB, 1.38695E-06_JPRB, 1.35919E-06_JPRB, 1.33199E-06_JPRB, 1.30534E-06_JPRB, &
+     & 1.27922E-06_JPRB, 1.25362E-06_JPRB, 1.22853E-06_JPRB, 1.20395E-06_JPRB/)
+       KAO_MN2( 3, :,15) = (/ &
+     & 1.73231E-06_JPRB, 1.69765E-06_JPRB, 1.66368E-06_JPRB, 1.63039E-06_JPRB, 1.59776E-06_JPRB, &
+     & 1.56579E-06_JPRB, 1.53445E-06_JPRB, 1.50375E-06_JPRB, 1.47366E-06_JPRB, 1.44417E-06_JPRB, &
+     & 1.41527E-06_JPRB, 1.38695E-06_JPRB, 1.35919E-06_JPRB, 1.33199E-06_JPRB, 1.30534E-06_JPRB, &
+     & 1.27922E-06_JPRB, 1.25362E-06_JPRB, 1.22853E-06_JPRB, 1.20395E-06_JPRB/)
+       KAO_MN2( 4, :,15) = (/ &
+     & 1.73231E-06_JPRB, 1.69765E-06_JPRB, 1.66368E-06_JPRB, 1.63039E-06_JPRB, 1.59776E-06_JPRB, &
+     & 1.56579E-06_JPRB, 1.53445E-06_JPRB, 1.50375E-06_JPRB, 1.47366E-06_JPRB, 1.44417E-06_JPRB, &
+     & 1.41527E-06_JPRB, 1.38695E-06_JPRB, 1.35919E-06_JPRB, 1.33199E-06_JPRB, 1.30534E-06_JPRB, &
+     & 1.27922E-06_JPRB, 1.25362E-06_JPRB, 1.22853E-06_JPRB, 1.20395E-06_JPRB/)
+       KAO_MN2( 5, :,15) = (/ &
+     & 1.73231E-06_JPRB, 1.69765E-06_JPRB, 1.66368E-06_JPRB, 1.63039E-06_JPRB, 1.59776E-06_JPRB, &
+     & 1.56579E-06_JPRB, 1.53445E-06_JPRB, 1.50375E-06_JPRB, 1.47366E-06_JPRB, 1.44417E-06_JPRB, &
+     & 1.41527E-06_JPRB, 1.38695E-06_JPRB, 1.35919E-06_JPRB, 1.33199E-06_JPRB, 1.30534E-06_JPRB, &
+     & 1.27922E-06_JPRB, 1.25362E-06_JPRB, 1.22853E-06_JPRB, 1.20395E-06_JPRB/)
+       KAO_MN2( 6, :,15) = (/ &
+     & 1.73231E-06_JPRB, 1.69765E-06_JPRB, 1.66368E-06_JPRB, 1.63039E-06_JPRB, 1.59776E-06_JPRB, &
+     & 1.56579E-06_JPRB, 1.53445E-06_JPRB, 1.50375E-06_JPRB, 1.47366E-06_JPRB, 1.44417E-06_JPRB, &
+     & 1.41527E-06_JPRB, 1.38695E-06_JPRB, 1.35919E-06_JPRB, 1.33199E-06_JPRB, 1.30534E-06_JPRB, &
+     & 1.27922E-06_JPRB, 1.25362E-06_JPRB, 1.22853E-06_JPRB, 1.20395E-06_JPRB/)
+       KAO_MN2( 7, :,15) = (/ &
+     & 1.73231E-06_JPRB, 1.69765E-06_JPRB, 1.66368E-06_JPRB, 1.63039E-06_JPRB, 1.59776E-06_JPRB, &
+     & 1.56579E-06_JPRB, 1.53445E-06_JPRB, 1.50375E-06_JPRB, 1.47366E-06_JPRB, 1.44417E-06_JPRB, &
+     & 1.41527E-06_JPRB, 1.38695E-06_JPRB, 1.35919E-06_JPRB, 1.33199E-06_JPRB, 1.30534E-06_JPRB, &
+     & 1.27922E-06_JPRB, 1.25362E-06_JPRB, 1.22853E-06_JPRB, 1.20395E-06_JPRB/)
+       KAO_MN2( 8, :,15) = (/ &
+     & 1.73231E-06_JPRB, 1.69765E-06_JPRB, 1.66368E-06_JPRB, 1.63039E-06_JPRB, 1.59776E-06_JPRB, &
+     & 1.56579E-06_JPRB, 1.53445E-06_JPRB, 1.50375E-06_JPRB, 1.47366E-06_JPRB, 1.44417E-06_JPRB, &
+     & 1.41527E-06_JPRB, 1.38695E-06_JPRB, 1.35919E-06_JPRB, 1.33199E-06_JPRB, 1.30534E-06_JPRB, &
+     & 1.27922E-06_JPRB, 1.25362E-06_JPRB, 1.22853E-06_JPRB, 1.20395E-06_JPRB/)
+       KAO_MN2( 9, :,15) = (/ &
+     & 1.71602E-06_JPRB, 1.68499E-06_JPRB, 1.65452E-06_JPRB, 1.62461E-06_JPRB, 1.59523E-06_JPRB, &
+     & 1.56639E-06_JPRB, 1.53807E-06_JPRB, 1.51026E-06_JPRB, 1.48295E-06_JPRB, 1.45614E-06_JPRB, &
+     & 1.42981E-06_JPRB, 1.40395E-06_JPRB, 1.37857E-06_JPRB, 1.35364E-06_JPRB, 1.32917E-06_JPRB, &
+     & 1.30513E-06_JPRB, 1.28153E-06_JPRB, 1.25836E-06_JPRB, 1.23561E-06_JPRB/)
+       KAO_MN2( 1, :,16) = (/ &
+     & 1.73310E-06_JPRB, 1.69826E-06_JPRB, 1.66413E-06_JPRB, 1.63069E-06_JPRB, 1.59791E-06_JPRB, &
+     & 1.56580E-06_JPRB, 1.53433E-06_JPRB, 1.50349E-06_JPRB, 1.47328E-06_JPRB, 1.44367E-06_JPRB, &
+     & 1.41465E-06_JPRB, 1.38622E-06_JPRB, 1.35836E-06_JPRB, 1.33106E-06_JPRB, 1.30431E-06_JPRB, &
+     & 1.27810E-06_JPRB, 1.25241E-06_JPRB, 1.22724E-06_JPRB, 1.20257E-06_JPRB/)
+       KAO_MN2( 2, :,16) = (/ &
+     & 1.73310E-06_JPRB, 1.69826E-06_JPRB, 1.66413E-06_JPRB, 1.63069E-06_JPRB, 1.59791E-06_JPRB, &
+     & 1.56580E-06_JPRB, 1.53433E-06_JPRB, 1.50349E-06_JPRB, 1.47328E-06_JPRB, 1.44367E-06_JPRB, &
+     & 1.41465E-06_JPRB, 1.38622E-06_JPRB, 1.35836E-06_JPRB, 1.33106E-06_JPRB, 1.30431E-06_JPRB, &
+     & 1.27810E-06_JPRB, 1.25241E-06_JPRB, 1.22724E-06_JPRB, 1.20257E-06_JPRB/)
+       KAO_MN2( 3, :,16) = (/ &
+     & 1.73310E-06_JPRB, 1.69826E-06_JPRB, 1.66413E-06_JPRB, 1.63069E-06_JPRB, 1.59791E-06_JPRB, &
+     & 1.56580E-06_JPRB, 1.53433E-06_JPRB, 1.50349E-06_JPRB, 1.47328E-06_JPRB, 1.44367E-06_JPRB, &
+     & 1.41465E-06_JPRB, 1.38622E-06_JPRB, 1.35836E-06_JPRB, 1.33106E-06_JPRB, 1.30431E-06_JPRB, &
+     & 1.27810E-06_JPRB, 1.25241E-06_JPRB, 1.22724E-06_JPRB, 1.20257E-06_JPRB/)
+       KAO_MN2( 4, :,16) = (/ &
+     & 1.73310E-06_JPRB, 1.69826E-06_JPRB, 1.66413E-06_JPRB, 1.63069E-06_JPRB, 1.59791E-06_JPRB, &
+     & 1.56580E-06_JPRB, 1.53433E-06_JPRB, 1.50349E-06_JPRB, 1.47328E-06_JPRB, 1.44367E-06_JPRB, &
+     & 1.41465E-06_JPRB, 1.38622E-06_JPRB, 1.35836E-06_JPRB, 1.33106E-06_JPRB, 1.30431E-06_JPRB, &
+     & 1.27810E-06_JPRB, 1.25241E-06_JPRB, 1.22724E-06_JPRB, 1.20257E-06_JPRB/)
+       KAO_MN2( 5, :,16) = (/ &
+     & 1.73310E-06_JPRB, 1.69826E-06_JPRB, 1.66413E-06_JPRB, 1.63069E-06_JPRB, 1.59791E-06_JPRB, &
+     & 1.56580E-06_JPRB, 1.53433E-06_JPRB, 1.50349E-06_JPRB, 1.47328E-06_JPRB, 1.44367E-06_JPRB, &
+     & 1.41465E-06_JPRB, 1.38622E-06_JPRB, 1.35836E-06_JPRB, 1.33106E-06_JPRB, 1.30431E-06_JPRB, &
+     & 1.27810E-06_JPRB, 1.25241E-06_JPRB, 1.22724E-06_JPRB, 1.20257E-06_JPRB/)
+       KAO_MN2( 6, :,16) = (/ &
+     & 1.73310E-06_JPRB, 1.69826E-06_JPRB, 1.66413E-06_JPRB, 1.63069E-06_JPRB, 1.59791E-06_JPRB, &
+     & 1.56580E-06_JPRB, 1.53433E-06_JPRB, 1.50349E-06_JPRB, 1.47328E-06_JPRB, 1.44367E-06_JPRB, &
+     & 1.41465E-06_JPRB, 1.38622E-06_JPRB, 1.35836E-06_JPRB, 1.33106E-06_JPRB, 1.30431E-06_JPRB, &
+     & 1.27810E-06_JPRB, 1.25241E-06_JPRB, 1.22724E-06_JPRB, 1.20257E-06_JPRB/)
+       KAO_MN2( 7, :,16) = (/ &
+     & 1.73310E-06_JPRB, 1.69826E-06_JPRB, 1.66413E-06_JPRB, 1.63069E-06_JPRB, 1.59791E-06_JPRB, &
+     & 1.56580E-06_JPRB, 1.53433E-06_JPRB, 1.50349E-06_JPRB, 1.47328E-06_JPRB, 1.44367E-06_JPRB, &
+     & 1.41465E-06_JPRB, 1.38622E-06_JPRB, 1.35836E-06_JPRB, 1.33106E-06_JPRB, 1.30431E-06_JPRB, &
+     & 1.27810E-06_JPRB, 1.25241E-06_JPRB, 1.22724E-06_JPRB, 1.20257E-06_JPRB/)
+       KAO_MN2( 8, :,16) = (/ &
+     & 1.73310E-06_JPRB, 1.69826E-06_JPRB, 1.66413E-06_JPRB, 1.63069E-06_JPRB, 1.59791E-06_JPRB, &
+     & 1.56580E-06_JPRB, 1.53433E-06_JPRB, 1.50349E-06_JPRB, 1.47328E-06_JPRB, 1.44367E-06_JPRB, &
+     & 1.41465E-06_JPRB, 1.38622E-06_JPRB, 1.35836E-06_JPRB, 1.33106E-06_JPRB, 1.30431E-06_JPRB, &
+     & 1.27810E-06_JPRB, 1.25241E-06_JPRB, 1.22724E-06_JPRB, 1.20257E-06_JPRB/)
+       KAO_MN2( 9, :,16) = (/ &
+     & 1.79375E-06_JPRB, 1.75599E-06_JPRB, 1.71903E-06_JPRB, 1.68284E-06_JPRB, 1.64741E-06_JPRB, &
+     & 1.61273E-06_JPRB, 1.57878E-06_JPRB, 1.54554E-06_JPRB, 1.51301E-06_JPRB, 1.48116E-06_JPRB, &
+     & 1.44998E-06_JPRB, 1.41945E-06_JPRB, 1.38957E-06_JPRB, 1.36032E-06_JPRB, 1.33168E-06_JPRB, &
+     & 1.30365E-06_JPRB, 1.27620E-06_JPRB, 1.24934E-06_JPRB, 1.22304E-06_JPRB/)
+
+!     The array FORREFO contains the coefficient of the water vapor
+!     foreign-continuum (including the energy term).  The first 
+!     index refers to reference temperature (296,260,224,260) and 
+!     pressure (970,475,219,3 mbar) levels.  The second index 
+!     runs over the g-channel (1 to 16).
+
+      FORREFO(1,:) = (/ &
+     &1.1755E-06_JPRB,6.5398E-07_JPRB,4.3915E-07_JPRB,3.0753E-07_JPRB,1.9677E-07_JPRB,1.4362E-07_JPRB, &
+     &9.4598E-08_JPRB,1.1848E-07_JPRB,1.4280E-07_JPRB,1.5821E-07_JPRB,1.5816E-07_JPRB,1.5769E-07_JPRB, &
+     &1.5844E-07_JPRB,1.6016E-07_JPRB,1.6232E-07_JPRB,1.6320E-07_JPRB/)
+      FORREFO(2,:) = (/ &
+     &1.0703E-06_JPRB,6.2783E-07_JPRB,4.7122E-07_JPRB,2.6300E-07_JPRB,1.8538E-07_JPRB,1.5076E-07_JPRB, &
+     &1.9474E-07_JPRB,2.9543E-07_JPRB,2.0093E-07_JPRB,1.5819E-07_JPRB,1.5826E-07_JPRB,1.5737E-07_JPRB, &
+     &1.5751E-07_JPRB,1.5910E-07_JPRB,1.6181E-07_JPRB,1.6320E-07_JPRB/)
+      FORREFO(3,:) = (/ &
+     &1.0470E-06_JPRB,5.8184E-07_JPRB,4.8218E-07_JPRB,2.7771E-07_JPRB,1.9036E-07_JPRB,1.5737E-07_JPRB, &
+     &1.8633E-07_JPRB,2.5754E-07_JPRB,4.0647E-07_JPRB,1.5839E-07_JPRB,1.5914E-07_JPRB,1.5788E-07_JPRB, &
+     &1.5731E-07_JPRB,1.5836E-07_JPRB,1.6103E-07_JPRB,1.6320E-07_JPRB/)
+      FORREFO(4,:) = (/ &
+     &1.3891E-06_JPRB,5.4901E-07_JPRB,2.8850E-07_JPRB,1.9176E-07_JPRB,1.4549E-07_JPRB,1.3603E-07_JPRB, &
+     &1.7472E-07_JPRB,2.9796E-07_JPRB,3.2452E-07_JPRB,2.5231E-07_JPRB,2.8195E-07_JPRB,1.5527E-07_JPRB, &
+     &1.5507E-07_JPRB,1.5442E-07_JPRB,1.5275E-07_JPRB,1.6057E-07_JPRB/)
+
+
+!     The array SELFREFO contains the coefficient of the water vapor
+!     self-continuum (including the energy term).  The first index
+!     refers to temperature in 7.2 degree increments.  For instance,
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+!     etc.  The second index runs over the g-channel (1 to 16).
+
+     SELFREFO(:, 1) = (/ &
+     & 1.73980E-03_JPRB, 1.41928E-03_JPRB, 1.15780E-03_JPRB, 9.44496E-04_JPRB, 7.70490E-04_JPRB, &
+     & 6.28541E-04_JPRB, 5.12744E-04_JPRB, 4.18280E-04_JPRB, 3.41219E-04_JPRB, 2.78356E-04_JPRB/)
+      SELFREFO(:, 2) = (/ &
+     & 1.84082E-03_JPRB, 1.50228E-03_JPRB, 1.22600E-03_JPRB, 1.00053E-03_JPRB, 8.16525E-04_JPRB, &
+     & 6.66359E-04_JPRB, 5.43811E-04_JPRB, 4.43800E-04_JPRB, 3.62182E-04_JPRB, 2.95574E-04_JPRB/)
+      SELFREFO(:, 3) = (/ &
+     & 1.92957E-03_JPRB, 1.57727E-03_JPRB, 1.28930E-03_JPRB, 1.05390E-03_JPRB, 8.61484E-04_JPRB, &
+     & 7.04197E-04_JPRB, 5.75627E-04_JPRB, 4.70530E-04_JPRB, 3.84622E-04_JPRB, 3.14399E-04_JPRB/)
+      SELFREFO(:, 4) = (/ &
+     & 2.12958E-03_JPRB, 1.73572E-03_JPRB, 1.41470E-03_JPRB, 1.15305E-03_JPRB, 9.39798E-04_JPRB, &
+     & 7.65984E-04_JPRB, 6.24317E-04_JPRB, 5.08850E-04_JPRB, 4.14739E-04_JPRB, 3.38034E-04_JPRB/)
+      SELFREFO(:, 5) = (/ &
+     & 2.30636E-03_JPRB, 1.88401E-03_JPRB, 1.53900E-03_JPRB, 1.25717E-03_JPRB, 1.02695E-03_JPRB, &
+     & 8.38891E-04_JPRB, 6.85270E-04_JPRB, 5.59780E-04_JPRB, 4.57270E-04_JPRB, 3.73533E-04_JPRB/)
+      SELFREFO(:, 6) = (/ &
+     & 2.47824E-03_JPRB, 2.03278E-03_JPRB, 1.66740E-03_JPRB, 1.36769E-03_JPRB, 1.12185E-03_JPRB, &
+     & 9.20206E-04_JPRB, 7.54803E-04_JPRB, 6.19130E-04_JPRB, 5.07844E-04_JPRB, 4.16561E-04_JPRB/)
+      SELFREFO(:, 7) = (/ &
+     & 2.54196E-03_JPRB, 2.10768E-03_JPRB, 1.74760E-03_JPRB, 1.44904E-03_JPRB, 1.20148E-03_JPRB, &
+     & 9.96215E-04_JPRB, 8.26019E-04_JPRB, 6.84900E-04_JPRB, 5.67890E-04_JPRB, 4.70870E-04_JPRB/)
+      SELFREFO(:, 8) = (/ &
+     & 2.52650E-03_JPRB, 2.11773E-03_JPRB, 1.77510E-03_JPRB, 1.48790E-03_JPRB, 1.24717E-03_JPRB, &
+     & 1.04539E-03_JPRB, 8.76251E-04_JPRB, 7.34480E-04_JPRB, 6.15646E-04_JPRB, 5.16039E-04_JPRB/)
+      SELFREFO(:, 9) = (/ &
+     & 2.82351E-03_JPRB, 2.34652E-03_JPRB, 1.95010E-03_JPRB, 1.62065E-03_JPRB, 1.34686E-03_JPRB, &
+     & 1.11933E-03_JPRB, 9.30232E-04_JPRB, 7.73080E-04_JPRB, 6.42477E-04_JPRB, 5.33939E-04_JPRB/)
+      SELFREFO(:,10) = (/ &
+     & 2.98189E-03_JPRB, 2.46741E-03_JPRB, 2.04170E-03_JPRB, 1.68944E-03_JPRB, 1.39795E-03_JPRB, &
+     & 1.15676E-03_JPRB, 9.57176E-04_JPRB, 7.92030E-04_JPRB, 6.55377E-04_JPRB, 5.42302E-04_JPRB/)
+      SELFREFO(:,11) = (/ &
+     & 2.98239E-03_JPRB, 2.46774E-03_JPRB, 2.04190E-03_JPRB, 1.68954E-03_JPRB, 1.39799E-03_JPRB, &
+     & 1.15675E-03_JPRB, 9.57137E-04_JPRB, 7.91970E-04_JPRB, 6.55305E-04_JPRB, 5.42224E-04_JPRB/)
+      SELFREFO(:,12) = (/ &
+     & 2.97833E-03_JPRB, 2.46461E-03_JPRB, 2.03950E-03_JPRB, 1.68772E-03_JPRB, 1.39661E-03_JPRB, &
+     & 1.15571E-03_JPRB, 9.56370E-04_JPRB, 7.91410E-04_JPRB, 6.54903E-04_JPRB, 5.41942E-04_JPRB/)
+      SELFREFO(:,13) = (/ &
+     & 2.97779E-03_JPRB, 2.46463E-03_JPRB, 2.03990E-03_JPRB, 1.68836E-03_JPRB, 1.39741E-03_JPRB, &
+     & 1.15659E-03_JPRB, 9.57278E-04_JPRB, 7.92310E-04_JPRB, 6.55771E-04_JPRB, 5.42762E-04_JPRB/)
+      SELFREFO(:,14) = (/ &
+     & 2.98326E-03_JPRB, 2.46943E-03_JPRB, 2.04410E-03_JPRB, 1.69203E-03_JPRB, 1.40060E-03_JPRB, &
+     & 1.15936E-03_JPRB, 9.59673E-04_JPRB, 7.94380E-04_JPRB, 6.57557E-04_JPRB, 5.44301E-04_JPRB/)
+      SELFREFO(:,15) = (/ &
+     & 2.99407E-03_JPRB, 2.47825E-03_JPRB, 2.05130E-03_JPRB, 1.69790E-03_JPRB, 1.40539E-03_JPRB, &
+     & 1.16327E-03_JPRB, 9.62862E-04_JPRB, 7.96980E-04_JPRB, 6.59676E-04_JPRB, 5.46028E-04_JPRB/)
+      SELFREFO(:,16) = (/ &
+     & 3.00005E-03_JPRB, 2.48296E-03_JPRB, 2.05500E-03_JPRB, 1.70080E-03_JPRB, 1.40765E-03_JPRB, &
+     & 1.16503E-03_JPRB, 9.64224E-04_JPRB, 7.98030E-04_JPRB, 6.60481E-04_JPRB, 5.46641E-04_JPRB/)
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB15',1,ZHOOK_HANDLE)
+RETURN
+
+1001 CONTINUE
+CALL ABOR1("RRTM_KGB15:ERROR READING FILE RADRRTM")
+
+END SUBROUTINE RRTM_KGB15
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb15.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb15.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb15.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_KGB15
+END SUBROUTINE RRTM_KGB15
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb16.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb16.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb16.F90	(revision 3908)
@@ -0,0 +1,208 @@
+SUBROUTINE RRTM_KGB16
+
+!     Originally by Eli J. Mlawer, Atmospheric & Environmental Research.
+!     BAND 16:  2600-3000 cm-1 (low - H2O,CH4; high - nothing)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+!     G.Mozdzynski March 2011 read constants from files
+!     ABozzo 201306 updated to rrtmg v4.85
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+USE YOMLUN    ,ONLY : NULRAD
+USE MPL_MODULE,ONLY : MPL_BROADCAST
+USE YOMTAG    ,ONLY : MTAGRAD
+
+USE YOERRTO16, ONLY : KAO,KBO ,KAO_D,KBO_D,SELFREFO,FORREFO ,FRACREFAO,FRACREFBO
+USE YOMMP0    , ONLY : NPROC, MYPROC
+
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB16',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+  READ(NULRAD,ERR=1001) KAO_D,KBO_D
+   ! Convert the data into model actual precision.
+  KAO = REAL(KAO_D,JPRB)
+  KBO = REAL(KBO_D,JPRB) 
+  CLOSE(NULRAD,ERR=1000)
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KAO,MTAGRAD,1,CDSTRING='RRTM_KGB16:')
+  CALL MPL_BROADCAST (KBO,MTAGRAD,1,CDSTRING='RRTM_KGB16:')
+ENDIF
+
+! Planck fraction mapping level: P = 387.6100 mbar, T = 250.17 K
+      FRACREFAO(:, 1) = (/ &
+     &  1.1593E-01_JPRB,2.3390E-01_JPRB,1.9120E-01_JPRB,1.3121E-01_JPRB,1.0590E-01_JPRB,8.4852E-02_JPRB, &
+     &  6.4168E-02_JPRB,4.2537E-02_JPRB,2.3220E-02_JPRB,2.1767E-03_JPRB,1.8203E-03_JPRB,1.3724E-03_JPRB, &
+     &  9.5452E-04_JPRB,5.5015E-04_JPRB,1.9348E-04_JPRB,2.7344E-05_JPRB/)
+      FRACREFAO(:, 2) = (/ &
+     &  2.8101E-01_JPRB,1.9773E-01_JPRB,1.4749E-01_JPRB,1.1399E-01_JPRB,8.8190E-02_JPRB,7.0531E-02_JPRB, &
+     &  4.6356E-02_JPRB,3.0774E-02_JPRB,1.7332E-02_JPRB,2.0054E-03_JPRB,1.5950E-03_JPRB,1.2760E-03_JPRB, &
+     &  9.5034E-04_JPRB,5.4992E-04_JPRB,1.9349E-04_JPRB,2.7309E-05_JPRB/)
+      FRACREFAO(:, 3) = (/ &
+     &  2.9054E-01_JPRB,2.1263E-01_JPRB,1.4133E-01_JPRB,1.1083E-01_JPRB,8.5107E-02_JPRB,6.5247E-02_JPRB, &
+     &  4.4542E-02_JPRB,2.7205E-02_JPRB,1.6495E-02_JPRB,1.8453E-03_JPRB,1.5222E-03_JPRB,1.1884E-03_JPRB, &
+     &  8.1094E-04_JPRB,4.9173E-04_JPRB,1.9344E-04_JPRB,2.7286E-05_JPRB/)
+      FRACREFAO(:, 4) = (/ &
+     &  2.9641E-01_JPRB,2.1738E-01_JPRB,1.4228E-01_JPRB,1.0830E-01_JPRB,8.2837E-02_JPRB,6.1359E-02_JPRB, &
+     &  4.4683E-02_JPRB,2.5027E-02_JPRB,1.6057E-02_JPRB,1.7558E-03_JPRB,1.4193E-03_JPRB,1.0970E-03_JPRB, &
+     &  7.8281E-04_JPRB,4.3260E-04_JPRB,1.4837E-04_JPRB,2.2958E-05_JPRB/)
+      FRACREFAO(:, 5) = (/ &
+     &  2.9553E-01_JPRB,2.2139E-01_JPRB,1.4816E-01_JPRB,1.0601E-01_JPRB,8.0048E-02_JPRB,6.0082E-02_JPRB, &
+     &  4.3952E-02_JPRB,2.3788E-02_JPRB,1.5734E-02_JPRB,1.6586E-03_JPRB,1.3434E-03_JPRB,1.0281E-03_JPRB, &
+     &  7.0256E-04_JPRB,4.2577E-04_JPRB,1.2803E-04_JPRB,1.3315E-05_JPRB/)
+      FRACREFAO(:, 6) = (/ &
+     &  2.9313E-01_JPRB,2.2476E-01_JPRB,1.5470E-01_JPRB,1.0322E-01_JPRB,7.8904E-02_JPRB,5.8175E-02_JPRB, &
+     &  4.3097E-02_JPRB,2.3618E-02_JPRB,1.5385E-02_JPRB,1.5942E-03_JPRB,1.2702E-03_JPRB,9.5566E-04_JPRB, &
+     &  6.5421E-04_JPRB,4.0165E-04_JPRB,1.2805E-04_JPRB,1.3355E-05_JPRB/)
+      FRACREFAO(:, 7) = (/ &
+     &  2.9069E-01_JPRB,2.2823E-01_JPRB,1.5995E-01_JPRB,1.0170E-01_JPRB,7.7287E-02_JPRB,5.6780E-02_JPRB, &
+     &  4.1752E-02_JPRB,2.3899E-02_JPRB,1.4937E-02_JPRB,1.4916E-03_JPRB,1.1909E-03_JPRB,9.1307E-04_JPRB, &
+     &  6.3518E-04_JPRB,3.9866E-04_JPRB,1.2805E-04_JPRB,1.3298E-05_JPRB/)
+      FRACREFAO(:, 8) = (/ &
+     &  2.8446E-01_JPRB,2.2651E-01_JPRB,1.7133E-01_JPRB,1.0299E-01_JPRB,7.4231E-02_JPRB,5.6031E-02_JPRB, &
+     &  4.1368E-02_JPRB,2.4318E-02_JPRB,1.4135E-02_JPRB,1.4216E-03_JPRB,1.1465E-03_JPRB,8.9800E-04_JPRB, &
+     &  6.3553E-04_JPRB,3.9536E-04_JPRB,1.2749E-04_JPRB,1.3298E-05_JPRB/)
+      FRACREFAO(:, 9) = (/ &
+     &  2.0568E-01_JPRB,2.5049E-01_JPRB,2.0568E-01_JPRB,1.1781E-01_JPRB,7.5579E-02_JPRB,5.8136E-02_JPRB, &
+     &  4.2397E-02_JPRB,2.6544E-02_JPRB,1.3067E-02_JPRB,1.4061E-03_JPRB,1.1455E-03_JPRB,8.9408E-04_JPRB, &
+     &  6.3652E-04_JPRB,3.9450E-04_JPRB,1.2841E-04_JPRB,1.3315E-05_JPRB/)
+
+! Planck fraction mapping level : P=95.58350 mb, T = 215.70 K
+      FRACREFBO(:) = (/ &
+     &  1.8111E-01_JPRB,2.2612E-01_JPRB,1.6226E-01_JPRB,1.1872E-01_JPRB,9.9048E-02_JPRB,8.0390E-02_JPRB, &
+     &  6.1648E-02_JPRB,4.1704E-02_JPRB,2.2976E-02_JPRB,1.9263E-03_JPRB,1.4694E-03_JPRB,1.1498E-03_JPRB, &
+     &  7.9906E-04_JPRB,4.8310E-04_JPRB,1.6188E-04_JPRB,2.2651E-05_JPRB/)
+
+
+!     ------------------------------------------------------------------
+
+!     The array KAO contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels> ~100mb, temperatures, and binary
+!     species parameters (see taumol.f for definition).  The first 
+!     index in the array, JS, runs from 1 to 9, and corresponds to 
+!     different values of the binary species parameter.  For instance, 
+!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
+!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
+!     in the array, JT, which runs from 1 to 5, corresponds to different
+!     temperatures.  More specifically, JT = 3 means that the data are for
+!     the reference temperature TREF for this  pressure level, JT = 2 refers
+!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
+!     to the JPth reference pressure level (see taumol.f for these levels
+!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
+!     which g-interval the absorption coefficients are for.
+
+
+!     The array KBO contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels < ~100mb and temperatures. The first 
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the reference temperature TREF for this pressure 
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
+!     The second index, JP, runs from 13 to 59 and refers to the JPth
+!     reference pressure level (see taumol.f for the value of these
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
+!     and tells us which g-interval the absorption coefficients are for.
+
+
+!     The array FORREFO contains the coefficient of the water vapor
+!     foreign-continuum (including the energy term).  The first 
+!     index refers to reference temperature (296,260,224,260) and 
+!     pressure (970,475,219,3 mbar) levels.  The second index 
+!     runs over the g-channel (1 to 16).
+
+      FORREFO(1,:) = (/ &
+     &5.1629E-06_JPRB,7.7578E-06_JPRB,1.9043E-05_JPRB,1.4802E-04_JPRB,2.2980E-04_JPRB,2.8057E-04_JPRB, &
+     &3.2824E-04_JPRB,3.4913E-04_JPRB,3.6515E-04_JPRB,3.8271E-04_JPRB,3.7499E-04_JPRB,3.6966E-04_JPRB, &
+     &3.7424E-04_JPRB,3.8884E-04_JPRB,3.7117E-04_JPRB,4.3710E-04_JPRB/)
+      FORREFO(2,:) = (/ &
+     &5.0804E-06_JPRB,1.3466E-05_JPRB,7.2606E-05_JPRB,1.6940E-04_JPRB,2.1022E-04_JPRB,2.5900E-04_JPRB, &
+     &2.9106E-04_JPRB,3.2261E-04_JPRB,3.2066E-04_JPRB,3.5421E-04_JPRB,3.7128E-04_JPRB,3.8144E-04_JPRB, &
+     &3.7854E-04_JPRB,3.8347E-04_JPRB,3.8921E-04_JPRB,3.7339E-04_JPRB/)
+      FORREFO(3,:) = (/ &
+     &5.4797E-05_JPRB,1.0026E-04_JPRB,1.2422E-04_JPRB,1.6386E-04_JPRB,1.8378E-04_JPRB,1.9616E-04_JPRB, &
+     &2.0711E-04_JPRB,2.2492E-04_JPRB,2.5240E-04_JPRB,2.6187E-04_JPRB,2.6058E-04_JPRB,2.4892E-04_JPRB, &
+     &2.6526E-04_JPRB,3.2105E-04_JPRB,3.6903E-04_JPRB,3.7213E-04_JPRB/)
+      FORREFO(4,:) = (/ &
+     &4.2782E-05_JPRB,1.4775E-04_JPRB,1.4588E-04_JPRB,1.6964E-04_JPRB,1.6667E-04_JPRB,1.7192E-04_JPRB, &
+     &1.9057E-04_JPRB,2.0180E-04_JPRB,2.1177E-04_JPRB,2.2326E-04_JPRB,2.3801E-04_JPRB,2.9308E-04_JPRB, &
+     &3.1130E-04_JPRB,3.1829E-04_JPRB,3.5035E-04_JPRB,3.7782E-04_JPRB/)
+
+
+!     The array SELFREFO contains the coefficient of the water vapor
+!     self-continuum (including the energy term).  The first index
+!     refers to temperature in 7.2 degree increments.  For instance,
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+!     etc.  The second index runs over the g-channel (1 to 16).
+
+      SELFREFO(:, 1) = (/ &
+     & 1.27793E-03_JPRB, 1.05944E-03_JPRB, 8.78300E-04_JPRB, 7.28133E-04_JPRB, 6.03641E-04_JPRB, &
+     & 5.00434E-04_JPRB, 4.14873E-04_JPRB, 3.43940E-04_JPRB, 2.85135E-04_JPRB, 2.36384E-04_JPRB/)
+      SELFREFO(:, 2) = (/ &
+     & 1.42785E-03_JPRB, 1.17602E-03_JPRB, 9.68600E-04_JPRB, 7.97765E-04_JPRB, 6.57060E-04_JPRB, &
+     & 5.41172E-04_JPRB, 4.45724E-04_JPRB, 3.67110E-04_JPRB, 3.02361E-04_JPRB, 2.49033E-04_JPRB/)
+      SELFREFO(:, 3) = (/ &
+     & 2.94095E-03_JPRB, 2.27102E-03_JPRB, 1.75370E-03_JPRB, 1.35422E-03_JPRB, 1.04574E-03_JPRB, &
+     & 8.07525E-04_JPRB, 6.23577E-04_JPRB, 4.81530E-04_JPRB, 3.71841E-04_JPRB, 2.87138E-04_JPRB/)
+      SELFREFO(:, 4) = (/ &
+     & 3.94894E-03_JPRB, 3.48184E-03_JPRB, 3.07000E-03_JPRB, 2.70687E-03_JPRB, 2.38669E-03_JPRB, &
+     & 2.10439E-03_JPRB, 1.85547E-03_JPRB, 1.63600E-03_JPRB, 1.44249E-03_JPRB, 1.27187E-03_JPRB/)
+      SELFREFO(:, 5) = (/ &
+     & 4.19971E-03_JPRB, 3.86333E-03_JPRB, 3.55390E-03_JPRB, 3.26925E-03_JPRB, 3.00740E-03_JPRB, &
+     & 2.76652E-03_JPRB, 2.54494E-03_JPRB, 2.34110E-03_JPRB, 2.15359E-03_JPRB, 1.98110E-03_JPRB/)
+      SELFREFO(:, 6) = (/ &
+     & 4.95922E-03_JPRB, 4.57134E-03_JPRB, 4.21380E-03_JPRB, 3.88422E-03_JPRB, 3.58042E-03_JPRB, &
+     & 3.30038E-03_JPRB, 3.04225E-03_JPRB, 2.80430E-03_JPRB, 2.58496E-03_JPRB, 2.38278E-03_JPRB/)
+      SELFREFO(:, 7) = (/ &
+     & 5.27379E-03_JPRB, 4.91005E-03_JPRB, 4.57140E-03_JPRB, 4.25611E-03_JPRB, 3.96256E-03_JPRB, &
+     & 3.68925E-03_JPRB, 3.43480E-03_JPRB, 3.19790E-03_JPRB, 2.97734E-03_JPRB, 2.77199E-03_JPRB/)
+      SELFREFO(:, 8) = (/ &
+     & 5.75341E-03_JPRB, 5.31533E-03_JPRB, 4.91060E-03_JPRB, 4.53669E-03_JPRB, 4.19126E-03_JPRB, &
+     & 3.87212E-03_JPRB, 3.57729E-03_JPRB, 3.30490E-03_JPRB, 3.05325E-03_JPRB, 2.82077E-03_JPRB/)
+      SELFREFO(:, 9) = (/ &
+     & 5.49849E-03_JPRB, 5.14295E-03_JPRB, 4.81040E-03_JPRB, 4.49935E-03_JPRB, 4.20842E-03_JPRB, &
+     & 3.93629E-03_JPRB, 3.68177E-03_JPRB, 3.44370E-03_JPRB, 3.22102E-03_JPRB, 3.01275E-03_JPRB/)
+      SELFREFO(:,10) = (/ &
+     & 6.04962E-03_JPRB, 5.60945E-03_JPRB, 5.20130E-03_JPRB, 4.82285E-03_JPRB, 4.47194E-03_JPRB, &
+     & 4.14656E-03_JPRB, 3.84485E-03_JPRB, 3.56510E-03_JPRB, 3.30570E-03_JPRB, 3.06518E-03_JPRB/)
+      SELFREFO(:,11) = (/ &
+     & 6.40108E-03_JPRB, 5.87551E-03_JPRB, 5.39310E-03_JPRB, 4.95029E-03_JPRB, 4.54385E-03_JPRB, &
+     & 4.17077E-03_JPRB, 3.82833E-03_JPRB, 3.51400E-03_JPRB, 3.22548E-03_JPRB, 2.96065E-03_JPRB/)
+      SELFREFO(:,12) = (/ &
+     & 6.77938E-03_JPRB, 6.15713E-03_JPRB, 5.59200E-03_JPRB, 5.07874E-03_JPRB, 4.61259E-03_JPRB, &
+     & 4.18922E-03_JPRB, 3.80472E-03_JPRB, 3.45550E-03_JPRB, 3.13834E-03_JPRB, 2.85029E-03_JPRB/)
+      SELFREFO(:,13) = (/ &
+     & 6.90020E-03_JPRB, 6.26766E-03_JPRB, 5.69310E-03_JPRB, 5.17121E-03_JPRB, 4.69717E-03_JPRB, &
+     & 4.26658E-03_JPRB, 3.87546E-03_JPRB, 3.52020E-03_JPRB, 3.19750E-03_JPRB, 2.90439E-03_JPRB/)
+      SELFREFO(:,14) = (/ &
+     & 6.92759E-03_JPRB, 6.32882E-03_JPRB, 5.78180E-03_JPRB, 5.28206E-03_JPRB, 4.82552E-03_JPRB, &
+     & 4.40843E-03_JPRB, 4.02740E-03_JPRB, 3.67930E-03_JPRB, 3.36129E-03_JPRB, 3.07076E-03_JPRB/)
+      SELFREFO(:,15) = (/ &
+     & 7.54539E-03_JPRB, 6.81161E-03_JPRB, 6.14920E-03_JPRB, 5.55120E-03_JPRB, 5.01136E-03_JPRB, &
+     & 4.52402E-03_JPRB, 4.08407E-03_JPRB, 3.68690E-03_JPRB, 3.32836E-03_JPRB, 3.00468E-03_JPRB/)
+      SELFREFO(:,16) = (/ &
+     & 7.62039E-03_JPRB, 7.10834E-03_JPRB, 6.63070E-03_JPRB, 6.18515E-03_JPRB, 5.76955E-03_JPRB, &
+     & 5.38186E-03_JPRB, 5.02023E-03_JPRB, 4.68290E-03_JPRB, 4.36823E-03_JPRB, 4.07471E-03_JPRB/)
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB16',1,ZHOOK_HANDLE)
+RETURN
+
+1000 CONTINUE
+CALL ABOR1("RRTM_KGB16:ERROR CLOSING FILE RADRRTM")
+1001 CONTINUE
+CALL ABOR1("RRTM_KGB16:ERROR READING FILE RADRRTM")
+
+END SUBROUTINE RRTM_KGB16
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb16.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb16.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb16.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_KGB16
+END SUBROUTINE RRTM_KGB16
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb2.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb2.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb2.F90	(revision 3908)
@@ -0,0 +1,182 @@
+SUBROUTINE RRTM_KGB2
+
+!     Originally by Eli J. Mlawer, Atmospheric & Environmental Research.
+!     BAND 2:  250-500 cm-1 (low - H2O; high - H2O)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+!     G.Mozdzynski March 2011 read constants from files
+!     ABozzo May 2013 update to RRTMG v4.85
+!     band 2:  350-500 cm-1 
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+USE YOMLUN    ,ONLY : NULRAD
+USE MPL_MODULE,ONLY : MPL_BROADCAST
+USE YOMTAG    ,ONLY : MTAGRAD
+
+USE YOERRTO2 , ONLY : KAO     ,KBO     ,KAO_D,KBO_D,SELFREFO   ,FRACREFAO  ,&
+ & FRACREFBO  ,FORREFO  
+USE YOMMP0    , ONLY : NPROC, MYPROC
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB2',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+  READ(NULRAD,ERR=1001) KAO_D,KBO_D
+ ! Convert the data into model actual precision.
+  KAO = REAL(KAO_D,JPRB)
+  KBO = REAL(KBO_D,JPRB) 
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KAO,MTAGRAD,1,CDSTRING='RRTM_KGB2:')
+  CALL MPL_BROADCAST (KBO,MTAGRAD,1,CDSTRING='RRTM_KGB2:')
+ENDIF
+
+
+! Planck fraction mapping level: P = 1053.630 mbar, T = 294.2 K
+      FRACREFAO(:) = (/ &
+      &  1.6388e-01_JPRB, 1.5241e-01_JPRB, 1.4290e-01_JPRB, 1.2864e-01_JPRB, &
+      &  1.1615e-01_JPRB, 1.0047e-01_JPRB, 8.0013e-02_JPRB, 6.0445e-02_JPRB, &
+      &  4.0530e-02_JPRB, 4.3879e-03_JPRB, 3.5726e-03_JPRB, 2.7669e-03_JPRB, &
+      &  2.0078e-03_JPRB, 1.2864e-03_JPRB, 4.7630e-04_JPRB, 6.9109e-05_JPRB/)
+
+! Planck fraction mapping level: P = 3.206e-2 mb, T = 197.92 K
+      FRACREFBO(:) = (/ &
+      &  1.4697e-01_JPRB, 1.4826e-01_JPRB, 1.4278e-01_JPRB, 1.3320e-01_JPRB, &
+      &  1.1965e-01_JPRB, 1.0297e-01_JPRB, 8.4170e-02_JPRB, 6.3282e-02_JPRB, &
+      &  4.2868e-02_JPRB, 4.6644e-03_JPRB, 3.8619e-03_JPRB, 3.0533e-03_JPRB, &
+      &  2.2359e-03_JPRB, 1.4226e-03_JPRB, 5.3642e-04_JPRB, 7.6316e-05_JPRB/)
+
+!     The array FORREFO contains the coefficient of the water vapor
+!     foreign-continuum (including the energy term).  The first 
+!     index refers to reference temperature (296,260,224,260) and 
+!     pressure (970,475,219,3 mbar) levels.  The second index 
+!     runs over the g-channel (1 to 16).
+
+      FORREFO(1,:) = (/ &
+     & 2.8549e-03_JPRB,4.8281e-03_JPRB,6.2570e-03_JPRB,8.2731e-03_JPRB,7.9056e-03_JPRB,7.7840e-03_JPRB, &
+     & 1.0115e-02_JPRB,9.6599e-03_JPRB,1.0153e-02_JPRB,1.0921e-02_JPRB,1.2408e-02_JPRB,1.3496e-02_JPRB, &
+     & 1.5059e-02_JPRB,1.4636e-02_JPRB,1.6483e-02_JPRB,1.2394e-02_JPRB/)
+      FORREFO(2,:) = (/ &
+     & 3.0036e-03_JPRB,5.1093e-03_JPRB,5.7317e-03_JPRB,9.2246e-03_JPRB,8.9829e-03_JPRB,8.6477e-03_JPRB, &
+     & 1.1448e-02_JPRB,1.0391e-02_JPRB,1.0211e-02_JPRB,1.2921e-02_JPRB,1.2726e-02_JPRB,1.2426e-02_JPRB, &
+     & 1.4609e-02_JPRB,1.5783e-02_JPRB,1.6617e-02_JPRB,1.6858e-02_JPRB/)
+      FORREFO(3,:) = (/ &
+     & 3.0771e-03_JPRB,5.1206e-03_JPRB,5.8426e-03_JPRB,9.5727e-03_JPRB,1.0338e-02_JPRB,9.3737e-03_JPRB, &
+     & 1.2805e-02_JPRB,1.1272e-02_JPRB,1.1353e-02_JPRB,1.1837e-02_JPRB,1.1550e-02_JPRB,1.3020e-02_JPRB, &
+     & 1.3536e-02_JPRB,1.6226e-02_JPRB,1.6039e-02_JPRB,2.2578e-02_JPRB/)
+      FORREFO(4,:) = (/ &
+     & 3.3072e-03_JPRB,5.0240e-03_JPRB,6.8474e-03_JPRB,8.2736e-03_JPRB,8.6151e-03_JPRB,8.6762e-03_JPRB, &
+     & 1.1476e-02_JPRB,1.0246e-02_JPRB,1.0819e-02_JPRB,1.0640e-02_JPRB,1.0545e-02_JPRB,1.0533e-02_JPRB, &
+     & 1.0496e-02_JPRB,1.0142e-02_JPRB,9.7979e-03_JPRB,1.5255e-02_JPRB/)
+
+
+!     The following are parameters related to the reference water vapor
+!     mixing ratios by REFPARAM(I) = REFH2O(I) / (.002+REFH2O(I)).
+!     These parameters are used for the Planck function interpolation.
+!REFPARAM( :) = (/&
+! & 0.903661_JPRB   , 0.859386_JPRB   , 0.746542_JPRB   , 0.580496_JPRB   , 0.412889_JPRB   ,&
+! & 0.275283_JPRB   , 0.162745_JPRB   , 7.63929E-02_JPRB, 1.82553E-02_JPRB, 3.72432E-03_JPRB, &
+! & 2.14946E-03_JPRB, 1.66320E-03_JPRB, 1.59940E-03_JPRB/)  
+
+!     ------------------------------------------------------------------
+
+!     The array KAO contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels > ~100mb and temperatures.  The first
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the corresponding TREF for this  pressure level, 
+!     JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, 
+!     JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  The second 
+!     index, JP, runs from 1 to 13 and refers to the corresponding 
+!     pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).  
+!     The third index, IG, goes from 1 to 16, and tells us which 
+!     g-interval the absorption coefficients are for.
+
+
+
+!     The array KBO contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels < ~100mb and temperatures. The first 
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the reference temperature TREF for this pressure 
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
+!     The second index, JP, runs from 13 to 59 and refers to the JPth
+!     reference pressure level (see taumol.f for the value of these
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
+!     and tells us which g-interval the absorption coefficients are for.
+
+
+
+!     The array SELFREFO contains the coefficient of the water vapor
+!     self-continuum (including the energy term).  The first index
+!     refers to temperature in 7.2 degree increments.  For instance,
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+!     etc.  The second index runs over the g-channel (1 to 16).
+
+    SELFREFO(:, 1) = (/ &
+     & 7.25695e-01_JPRB, 6.53591e-01_JPRB, 5.88650e-01_JPRB, 5.30162e-01_JPRB, 4.77485e-01_JPRB, &
+     & 4.30042e-01_JPRB, 3.87313e-01_JPRB, 3.48830e-01_JPRB, 3.14170e-01_JPRB, 2.82954e-01_JPRB/)
+      SELFREFO(:, 2) = (/ &
+     & 9.61996e-01_JPRB, 8.77853e-01_JPRB, 8.01070e-01_JPRB, 7.31003e-01_JPRB, 6.67064e-01_JPRB, &
+     & 6.08718e-01_JPRB, 5.55476e-01_JPRB, 5.06890e-01_JPRB, 4.62554e-01_JPRB, 4.22096e-01_JPRB/)
+      SELFREFO(:, 3) = (/ &
+     & 9.72584e-01_JPRB, 9.02658e-01_JPRB, 8.37760e-01_JPRB, 7.77527e-01_JPRB, 7.21626e-01_JPRB, &
+     & 6.69743e-01_JPRB, 6.21591e-01_JPRB, 5.76900e-01_JPRB, 5.35423e-01_JPRB, 4.96927e-01_JPRB/)
+      SELFREFO(:, 4) = (/ &
+     & 1.24790e+00_JPRB, 1.14353e+00_JPRB, 1.04790e+00_JPRB, 9.60263e-01_JPRB, 8.79956e-01_JPRB, &
+     & 8.06364e-01_JPRB, 7.38927e-01_JPRB, 6.77130e-01_JPRB, 6.20501e-01_JPRB, 5.68608e-01_JPRB/)
+      SELFREFO(:, 5) = (/ &
+     & 1.23574e+00_JPRB, 1.12928e+00_JPRB, 1.03200e+00_JPRB, 9.43096e-01_JPRB, 8.61851e-01_JPRB, &
+     & 7.87605e-01_JPRB, 7.19755e-01_JPRB, 6.57750e-01_JPRB, 6.01087e-01_JPRB, 5.49305e-01_JPRB/)
+      SELFREFO(:, 6) = (/ &
+     & 1.20921e+00_JPRB, 1.10660e+00_JPRB, 1.01270e+00_JPRB, 9.26766e-01_JPRB, 8.48124e-01_JPRB, &
+     & 7.76155e-01_JPRB, 7.10293e-01_JPRB, 6.50020e-01_JPRB, 5.94861e-01_JPRB, 5.44384e-01_JPRB/)
+      SELFREFO(:, 7) = (/ &
+     & 1.38112e+00_JPRB, 1.26727e+00_JPRB, 1.16280e+00_JPRB, 1.06694e+00_JPRB, 9.78990e-01_JPRB, &
+     & 8.98287e-01_JPRB, 8.24236e-01_JPRB, 7.56290e-01_JPRB, 6.93945e-01_JPRB, 6.36739e-01_JPRB/)
+      SELFREFO(:, 8) = (/ &
+     & 1.30321e+00_JPRB, 1.20127e+00_JPRB, 1.10730e+00_JPRB, 1.02068e+00_JPRB, 9.40840e-01_JPRB, &
+     & 8.67243e-01_JPRB, 7.99403e-01_JPRB, 7.36870e-01_JPRB, 6.79229e-01_JPRB, 6.26096e-01_JPRB/)
+      SELFREFO(:, 9) = (/ &
+     & 1.26713e+00_JPRB, 1.17927e+00_JPRB, 1.09750e+00_JPRB, 1.02140e+00_JPRB, 9.50575e-01_JPRB, &
+     & 8.84662e-01_JPRB, 8.23319e-01_JPRB, 7.66230e-01_JPRB, 7.13099e-01_JPRB, 6.63653e-01_JPRB/)
+      SELFREFO(:,10) = (/ &
+     & 1.49824e+00_JPRB, 1.37053e+00_JPRB, 1.25370e+00_JPRB, 1.14683e+00_JPRB, 1.04908e+00_JPRB, &
+     & 9.59651e-01_JPRB, 8.77849e-01_JPRB, 8.03020e-01_JPRB, 7.34569e-01_JPRB, 6.71954e-01_JPRB/)
+      SELFREFO(:,11) = (/ &
+     & 1.44786e+00_JPRB, 1.34594e+00_JPRB, 1.25120e+00_JPRB, 1.16313e+00_JPRB, 1.08125e+00_JPRB, &
+     & 1.00514e+00_JPRB, 9.34392e-01_JPRB, 8.68620e-01_JPRB, 8.07477e-01_JPRB, 7.50639e-01_JPRB/)
+      SELFREFO(:,12) = (/ &
+     & 1.38460e+00_JPRB, 1.30437e+00_JPRB, 1.22880e+00_JPRB, 1.15760e+00_JPRB, 1.09053e+00_JPRB, &
+     & 1.02735e+00_JPRB, 9.67825e-01_JPRB, 9.11750e-01_JPRB, 8.58924e-01_JPRB, 8.09159e-01_JPRB/)
+      SELFREFO(:,13) = (/ &
+     & 1.51953e+00_JPRB, 1.42822e+00_JPRB, 1.34240e+00_JPRB, 1.26173e+00_JPRB, 1.18592e+00_JPRB, &
+     & 1.11465e+00_JPRB, 1.04768e+00_JPRB, 9.84720e-01_JPRB, 9.25548e-01_JPRB, 8.69932e-01_JPRB/)
+      SELFREFO(:,14) = (/ &
+     & 1.62608e+00_JPRB, 1.51021e+00_JPRB, 1.40260e+00_JPRB, 1.30266e+00_JPRB, 1.20983e+00_JPRB, &
+     & 1.12363e+00_JPRB, 1.04356e+00_JPRB, 9.69200e-01_JPRB, 9.00138e-01_JPRB, 8.35998e-01_JPRB/)
+      SELFREFO(:,15) = (/ &
+     & 1.65383e+00_JPRB, 1.54808e+00_JPRB, 1.44910e+00_JPRB, 1.35644e+00_JPRB, 1.26971e+00_JPRB, &
+     & 1.18853e+00_JPRB, 1.11254e+00_JPRB, 1.04140e+00_JPRB, 9.74813e-01_JPRB, 9.12484e-01_JPRB/)
+      SELFREFO(:,16) = (/ &
+     & 1.78105e+00_JPRB, 1.61421e+00_JPRB, 1.46300e+00_JPRB, 1.32595e+00_JPRB, 1.20174e+00_JPRB, &
+     & 1.08917e+00_JPRB, 9.87141e-01_JPRB, 8.94670e-01_JPRB, 8.10861e-01_JPRB, 7.34904e-01_JPRB/)
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB2',1,ZHOOK_HANDLE)
+RETURN
+
+1001 CONTINUE
+CALL ABOR1("RRTM_KGB2:ERROR READING FILE RADRRTM")
+
+END SUBROUTINE RRTM_KGB2
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb2.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb2.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb2.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_KGB2
+END SUBROUTINE RRTM_KGB2
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb3.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb3.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb3.F90	(revision 3908)
@@ -0,0 +1,1381 @@
+SUBROUTINE RRTM_KGB3
+
+!     Originally by Eli J. Mlawer, Atmospheric & Environmental Research.
+!     BAND 3:  500-630 cm-1 (low - H2O,CO2; high - H2O,CO2)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+!     G.Mozdzynski March 2011 read constants from files
+!     ABozzo 201305 updated to rrtmg_lw_v4.85:
+!     band 3:  500-630 cm-1 (low key - h2o,co2; low minor - n2o)
+!                           (high key - h2o,co2; high minor - n2o)     
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+USE YOMLUN    ,ONLY : NULRAD
+USE MPL_MODULE,ONLY : MPL_BROADCAST
+USE YOMTAG    ,ONLY : MTAGRAD
+USE YOMMP0    , ONLY : NPROC, MYPROC
+
+USE YOERRTO3 , ONLY : KAO     ,KBO     ,KAO_D,KBO_D,SELFREFO   ,FRACREFAO  ,&
+ & FRACREFBO  ,FORREFO    ,KAO_MN2O,KBO_MN2O
+!USE YOERRTA3 , ONLY :    ETAREF    ,H2OREF     ,&
+! & N2OREF     ,CO2REF     ,STRRAT  
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB3',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+  READ(NULRAD,ERR=1001) KAO_D,KBO_D
+ ! Convert the data into model actual precision.
+  KAO = REAL(KAO_D,JPRB)
+  KBO = REAL(KBO_D,JPRB) 
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KAO,MTAGRAD,1,CDSTRING='RRTM_KGB3:')
+  CALL MPL_BROADCAST (KBO,MTAGRAD,1,CDSTRING='RRTM_KGB3:')
+ENDIF
+
+
+! Planck fraction mapping level: P=212.7250 mbar, T = 223.06 K
+      fracrefao(:, 1) = (/ &
+     &   1.6251e-01_JPRB,1.5572e-01_JPRB,1.4557e-01_JPRB,1.3208e-01_JPRB,1.1582e-01_JPRB,9.6895e-02_JPRB, &
+     &   7.8720e-02_JPRB,5.8462e-02_JPRB,3.9631e-02_JPRB,4.3001e-03_JPRB,3.5555e-03_JPRB,2.8101e-03_JPRB, &
+     &   2.0547e-03_JPRB,1.3109e-03_JPRB,4.9403e-04_JPRB,6.9515e-05_JPRB/)
+      fracrefao(:, 2) = (/ &
+     &   1.6006e-01_JPRB,1.5576e-01_JPRB,1.4609e-01_JPRB,1.3276e-01_JPRB,1.1594e-01_JPRB,9.7336e-02_JPRB, &
+     &   7.9035e-02_JPRB,5.8696e-02_JPRB,3.9723e-02_JPRB,4.3001e-03_JPRB,3.5555e-03_JPRB,2.8101e-03_JPRB, &
+     &   2.0547e-03_JPRB,1.3109e-03_JPRB,4.9403e-04_JPRB,6.9515e-05_JPRB/)
+      fracrefao(:, 3) = (/ &
+     &   1.5952e-01_JPRB,1.5566e-01_JPRB,1.4590e-01_JPRB,1.3294e-01_JPRB,1.1599e-01_JPRB,9.7511e-02_JPRB, &
+     &   7.9127e-02_JPRB,5.8888e-02_JPRB,3.9874e-02_JPRB,4.3001e-03_JPRB,3.5555e-03_JPRB,2.8102e-03_JPRB, &
+     &   2.0547e-03_JPRB,1.3109e-03_JPRB,4.9403e-04_JPRB,6.9515e-05_JPRB/)
+      fracrefao(:, 4) = (/ &
+     &   1.5907e-01_JPRB,1.5541e-01_JPRB,1.4585e-01_JPRB,1.3316e-01_JPRB,1.1596e-01_JPRB,9.7647e-02_JPRB, &
+     &   7.9243e-02_JPRB,5.9024e-02_JPRB,4.0028e-02_JPRB,4.3112e-03_JPRB,3.5555e-03_JPRB,2.8102e-03_JPRB, &
+     &   2.0547e-03_JPRB,1.3109e-03_JPRB,4.9403e-04_JPRB,6.9515e-05_JPRB/)
+      fracrefao(:, 5) = (/ &
+     &   1.5862e-01_JPRB,1.5517e-01_JPRB,1.4588e-01_JPRB,1.3328e-01_JPRB,1.1585e-01_JPRB,9.7840e-02_JPRB, &
+     &   7.9364e-02_JPRB,5.9174e-02_JPRB,4.0160e-02_JPRB,4.3403e-03_JPRB,3.5900e-03_JPRB,2.8102e-03_JPRB, &
+     &   2.0547e-03_JPRB,1.3109e-03_JPRB,4.9403e-04_JPRB,6.9515e-05_JPRB/)
+      fracrefao(:, 6) = (/ &
+     &   1.5830e-01_JPRB,1.5490e-01_JPRB,1.4582e-01_JPRB,1.3331e-01_JPRB,1.1567e-01_JPRB,9.8079e-02_JPRB, &
+     &   7.9510e-02_JPRB,5.9369e-02_JPRB,4.0326e-02_JPRB,4.3343e-03_JPRB,3.5908e-03_JPRB,2.8527e-03_JPRB, &
+     &   2.0655e-03_JPRB,1.3109e-03_JPRB,4.9403e-04_JPRB,6.9515e-05_JPRB/)
+      fracrefao(:, 7) = (/ &
+     &   1.5789e-01_JPRB,1.5435e-01_JPRB,1.4595e-01_JPRB,1.3304e-01_JPRB,1.1566e-01_JPRB,9.8426e-02_JPRB, &
+     &   7.9704e-02_JPRB,5.9618e-02_JPRB,4.0520e-02_JPRB,4.3812e-03_JPRB,3.6147e-03_JPRB,2.8395e-03_JPRB, &
+     &   2.1301e-03_JPRB,1.3145e-03_JPRB,4.9403e-04_JPRB,6.9515e-05_JPRB/)
+      fracrefao(:, 8) = (/ &
+     &   1.5704e-01_JPRB,1.5398e-01_JPRB,1.4564e-01_JPRB,1.3222e-01_JPRB,1.1586e-01_JPRB,9.9230e-02_JPRB, &
+     &   8.0011e-02_JPRB,6.0149e-02_JPRB,4.0790e-02_JPRB,4.4253e-03_JPRB,3.6534e-03_JPRB,2.9191e-03_JPRB, &
+     &   2.1373e-03_JPRB,1.3558e-03_JPRB,5.1631e-04_JPRB,7.8794e-05_JPRB/)
+      fracrefao(:, 9) = (/ &
+     &   1.5270e-01_JPRB,1.5126e-01_JPRB,1.4264e-01_JPRB,1.3106e-01_JPRB,1.1740e-01_JPRB,1.0137e-01_JPRB, &
+     &   8.3057e-02_JPRB,6.2282e-02_JPRB,4.2301e-02_JPRB,4.6486e-03_JPRB,3.8159e-03_JPRB,3.0472e-03_JPRB, &
+     &   2.2870e-03_JPRB,1.4818e-03_JPRB,5.6773e-04_JPRB,7.8794e-05_JPRB/)
+
+! Planck fraction mapping level: p = 95.8 mbar, t = 215.7 k
+      fracrefbo(:, 1) = (/ &
+     &   1.6413e-01_JPRB,1.5665e-01_JPRB,1.4606e-01_JPRB,1.3184e-01_JPRB,1.1517e-01_JPRB,9.6243e-02_JPRB, &
+     &   7.7982e-02_JPRB,5.8165e-02_JPRB,3.9311e-02_JPRB,4.2586e-03_JPRB,3.5189e-03_JPRB,2.7793e-03_JPRB, &
+     &   2.0376e-03_JPRB,1.2938e-03_JPRB,4.8853e-04_JPRB,6.8745e-05_JPRB/)
+      fracrefbo(:, 2) = (/ &
+     &   1.6254e-01_JPRB,1.5674e-01_JPRB,1.4652e-01_JPRB,1.3221e-01_JPRB,1.1535e-01_JPRB,9.6439e-02_JPRB, &
+     &   7.8155e-02_JPRB,5.8254e-02_JPRB,3.9343e-02_JPRB,4.2586e-03_JPRB,3.5189e-03_JPRB,2.7793e-03_JPRB, &
+     &   2.0376e-03_JPRB,1.2938e-03_JPRB,4.8853e-04_JPRB,6.8745e-05_JPRB/)
+      fracrefbo(:, 3) = (/ &
+     &   1.6177e-01_JPRB,1.5664e-01_JPRB,1.4669e-01_JPRB,1.3242e-01_JPRB,1.1541e-01_JPRB,9.6536e-02_JPRB, &
+     &   7.8257e-02_JPRB,5.8387e-02_JPRB,3.9431e-02_JPRB,4.2587e-03_JPRB,3.5189e-03_JPRB,2.7793e-03_JPRB, &
+     &   2.0376e-03_JPRB,1.2938e-03_JPRB,4.8853e-04_JPRB,6.8745e-05_JPRB/)
+      fracrefbo(:, 4) = (/ &
+     &   1.6077e-01_JPRB,1.5679e-01_JPRB,1.4648e-01_JPRB,1.3273e-01_JPRB,1.1546e-01_JPRB,9.6779e-02_JPRB, &
+     &   7.8371e-02_JPRB,5.8546e-02_JPRB,3.9611e-02_JPRB,4.2772e-03_JPRB,3.5190e-03_JPRB,2.7793e-03_JPRB, &
+     &   2.0376e-03_JPRB,1.2938e-03_JPRB,4.8853e-04_JPRB,6.8745e-05_JPRB/)
+      fracrefbo(:, 5) = (/ &
+     &   1.6067e-01_JPRB,1.5608e-01_JPRB,1.4247e-01_JPRB,1.2881e-01_JPRB,1.1449e-01_JPRB,9.8802e-02_JPRB, &
+     &   8.0828e-02_JPRB,6.0977e-02_JPRB,4.1494e-02_JPRB,4.5116e-03_JPRB,3.7290e-03_JPRB,2.9460e-03_JPRB, &
+     &   2.1948e-03_JPRB,1.3778e-03_JPRB,5.4552e-04_JPRB,7.9969e-05_JPRB/)
+
+
+
+
+!     ------------------------------------------------------------------
+
+!     The array KAO contains absorption coefs for each of the 16 g-intervals
+!     for a range of pressure levels > ~100mb, temperatures, and ratios
+!     of water vapor to CO2.  The first index in the array, JS, runs
+!     from 1 to 10, and corresponds to different water vapor to CO2 ratios,
+!     as expressed through the binary species parameter eta, defined as
+!     eta = h2o/(h20 + (rat) * co2), where rat is the ratio of the integrated
+!     line strength in the band of co2 to that of h2o.  For instance,
+!     JS=1 refers to dry air (eta = 0), JS = 10 corresponds to eta = 1.0.
+!     The 2nd index in the array, JT, which runs from 1 to 5, corresponds 
+!     to different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the reference temperature TREF for this  pressure 
+!     level, JT = 2 refers to the temperature
+!     TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
+!     to the reference pressure level (e.g. JP = 1 is for a
+!     pressure of 1053.63 mb).  The fourth index, IG, goes from 1 to 16,
+!     and tells us which g-interval the absorption coefficients are for.
+
+
+
+!     The array KBO contains absorption coefs for each of the 16 g-intervals
+!     for a range of pressure levels  < ~100mb, temperatures, and ratios
+!     of H2O to CO2.  The first index in the array, JS, runs from 1 to 5, 
+!     and corresponds to different H2O to CO2 ratios, as expressed through 
+!     the binary species parameter eta, defined as eta = H2O/(H2O+RAT*CO2), 
+!     where RAT is the ratio of the integrated line strength in the band 
+!     of CO2 to that of H2O.  For instance, JS=1 refers to no H2O, 
+!     JS = 2 corresponds to eta = 0.25, etc.  The second index, JT, which
+!     runs from 1 to 5, corresponds to different temperatures.  More 
+!     specifically, JT = 3 means that the data are for the corresponding 
+!     reference temperature TREF for this  pressure level, JT = 2 refers 
+!     to the TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and
+!     JT = 5 is for TREF+30.  The third index, JP, runs from 13 to 59 and
+!     refers to the corresponding pressure level in PREF (e.g. JP = 13 is
+!     for a pressure of 95.5835 mb).  The fourth index, IG, goes from 1 to
+!     16, and tells us which g-interval the absorption coefficients are for.
+
+
+!     The array KAO_Mxx contains the absorption coefficient for 
+!     a minor species at the 16 chosen g-values for a reference pressure
+!     level below 100~ mb.   The first index in the array, JS, runs
+!     from 1 to 10, and corresponds to different gas column amount ratios,
+!     as expressed through the binary species parameter eta, defined as
+!     eta = gas1/(gas1 + (rat) * gas2), where rat is the 
+!     ratio of the reference MLS column amount value of gas 1 
+!     to that of gas2.  The second index refers to temperature 
+!     in 7.2 degree increments.  For instance, JT = 1 refers to a 
+!     temperature of 188.0, JT = 2 refers to 195.2, etc. The third index 
+!     runs over the g-channel (1 to 16).
+
+      kao_mn2o( 1, :, 1) = (/ &
+     & 1.28178e-05_JPRB, 1.55472e-05_JPRB, 1.88578e-05_JPRB, 2.28735e-05_JPRB, 2.77442e-05_JPRB, &
+     & 3.36520e-05_JPRB, 4.08179e-05_JPRB, 4.95098e-05_JPRB, 6.00525e-05_JPRB, 7.28401e-05_JPRB, &
+     & 8.83508e-05_JPRB, 1.07164e-04_JPRB, 1.29984e-04_JPRB, 1.57663e-04_JPRB, 1.91236e-04_JPRB, &
+     & 2.31958e-04_JPRB, 2.81352e-04_JPRB, 3.41263e-04_JPRB, 4.13932e-04_JPRB/)
+      kao_mn2o( 2, :, 1) = (/ &
+     & 1.00725e-01_JPRB, 1.04470e-01_JPRB, 1.08355e-01_JPRB, 1.12384e-01_JPRB, 1.16563e-01_JPRB, &
+     & 1.20898e-01_JPRB, 1.25394e-01_JPRB, 1.30057e-01_JPRB, 1.34893e-01_JPRB, 1.39909e-01_JPRB, &
+     & 1.45112e-01_JPRB, 1.50508e-01_JPRB, 1.56104e-01_JPRB, 1.61909e-01_JPRB, 1.67930e-01_JPRB, &
+     & 1.74175e-01_JPRB, 1.80652e-01_JPRB, 1.87369e-01_JPRB, 1.94337e-01_JPRB/)
+      kao_mn2o( 3, :, 1) = (/ &
+     & 1.94143e-01_JPRB, 1.97380e-01_JPRB, 2.00670e-01_JPRB, 2.04016e-01_JPRB, 2.07417e-01_JPRB, &
+     & 2.10875e-01_JPRB, 2.14390e-01_JPRB, 2.17964e-01_JPRB, 2.21598e-01_JPRB, 2.25292e-01_JPRB, &
+     & 2.29048e-01_JPRB, 2.32867e-01_JPRB, 2.36749e-01_JPRB, 2.40696e-01_JPRB, 2.44708e-01_JPRB, &
+     & 2.48788e-01_JPRB, 2.52936e-01_JPRB, 2.57152e-01_JPRB, 2.61439e-01_JPRB/)
+      kao_mn2o( 4, :, 1) = (/ &
+     & 2.98127e-01_JPRB, 3.00016e-01_JPRB, 3.01916e-01_JPRB, 3.03829e-01_JPRB, 3.05754e-01_JPRB, &
+     & 3.07691e-01_JPRB, 3.09640e-01_JPRB, 3.11601e-01_JPRB, 3.13575e-01_JPRB, 3.15562e-01_JPRB, &
+     & 3.17561e-01_JPRB, 3.19572e-01_JPRB, 3.21597e-01_JPRB, 3.23634e-01_JPRB, 3.25684e-01_JPRB, &
+     & 3.27748e-01_JPRB, 3.29824e-01_JPRB, 3.31913e-01_JPRB, 3.34016e-01_JPRB/)
+      kao_mn2o( 5, :, 1) = (/ &
+     & 4.45029e-01_JPRB, 4.45243e-01_JPRB, 4.45458e-01_JPRB, 4.45673e-01_JPRB, 4.45889e-01_JPRB, &
+     & 4.46104e-01_JPRB, 4.46319e-01_JPRB, 4.46535e-01_JPRB, 4.46750e-01_JPRB, 4.46966e-01_JPRB, &
+     & 4.47182e-01_JPRB, 4.47398e-01_JPRB, 4.47614e-01_JPRB, 4.47830e-01_JPRB, 4.48046e-01_JPRB, &
+     & 4.48262e-01_JPRB, 4.48479e-01_JPRB, 4.48695e-01_JPRB, 4.48912e-01_JPRB/)
+      kao_mn2o( 6, :, 1) = (/ &
+     & 7.15677e-01_JPRB, 7.14564e-01_JPRB, 7.13452e-01_JPRB, 7.12342e-01_JPRB, 7.11234e-01_JPRB, &
+     & 7.10127e-01_JPRB, 7.09022e-01_JPRB, 7.07919e-01_JPRB, 7.06818e-01_JPRB, 7.05718e-01_JPRB, &
+     & 7.04620e-01_JPRB, 7.03524e-01_JPRB, 7.02429e-01_JPRB, 7.01336e-01_JPRB, 7.00245e-01_JPRB, &
+     & 6.99156e-01_JPRB, 6.98068e-01_JPRB, 6.96982e-01_JPRB, 6.95898e-01_JPRB/)
+      kao_mn2o( 7, :, 1) = (/ &
+     & 9.89605e-01_JPRB, 9.85128e-01_JPRB, 9.80671e-01_JPRB, 9.76234e-01_JPRB, 9.71817e-01_JPRB, &
+     & 9.67421e-01_JPRB, 9.63044e-01_JPRB, 9.58687e-01_JPRB, 9.54350e-01_JPRB, 9.50032e-01_JPRB, &
+     & 9.45734e-01_JPRB, 9.41455e-01_JPRB, 9.37196e-01_JPRB, 9.32956e-01_JPRB, 9.28735e-01_JPRB, &
+     & 9.24533e-01_JPRB, 9.20350e-01_JPRB, 9.16187e-01_JPRB, 9.12042e-01_JPRB/)
+      kao_mn2o( 8, :, 1) = (/ &
+     & 1.12229e+00_JPRB, 1.11502e+00_JPRB, 1.10779e+00_JPRB, 1.10061e+00_JPRB, 1.09348e+00_JPRB, &
+     & 1.08639e+00_JPRB, 1.07935e+00_JPRB, 1.07235e+00_JPRB, 1.06540e+00_JPRB, 1.05850e+00_JPRB, &
+     & 1.05164e+00_JPRB, 1.04482e+00_JPRB, 1.03805e+00_JPRB, 1.03132e+00_JPRB, 1.02464e+00_JPRB, &
+     & 1.01799e+00_JPRB, 1.01140e+00_JPRB, 1.00484e+00_JPRB, 9.98328e-01_JPRB/)
+      kao_mn2o( 9, :, 1) = (/ &
+     & 7.20959e-01_JPRB, 7.22839e-01_JPRB, 7.24723e-01_JPRB, 7.26612e-01_JPRB, 7.28506e-01_JPRB, &
+     & 7.30405e-01_JPRB, 7.32309e-01_JPRB, 7.34218e-01_JPRB, 7.36132e-01_JPRB, 7.38051e-01_JPRB, &
+     & 7.39975e-01_JPRB, 7.41904e-01_JPRB, 7.43838e-01_JPRB, 7.45777e-01_JPRB, 7.47721e-01_JPRB, &
+     & 7.49670e-01_JPRB, 7.51624e-01_JPRB, 7.53584e-01_JPRB, 7.55548e-01_JPRB/)
+      kao_mn2o( 1, :, 2) = (/ &
+     & 1.62152e-03_JPRB, 1.81627e-03_JPRB, 2.03443e-03_JPRB, 2.27878e-03_JPRB, 2.55248e-03_JPRB, &
+     & 2.85906e-03_JPRB, 3.20245e-03_JPRB, 3.58710e-03_JPRB, 4.01794e-03_JPRB, 4.50053e-03_JPRB, &
+     & 5.04109e-03_JPRB, 5.64657e-03_JPRB, 6.32477e-03_JPRB, 7.08444e-03_JPRB, 7.93534e-03_JPRB, &
+     & 8.88845e-03_JPRB, 9.95603e-03_JPRB, 1.11518e-02_JPRB, 1.24913e-02_JPRB/)
+      kao_mn2o( 2, :, 2) = (/ &
+     & 3.73716e-01_JPRB, 3.72491e-01_JPRB, 3.71271e-01_JPRB, 3.70054e-01_JPRB, 3.68841e-01_JPRB, &
+     & 3.67633e-01_JPRB, 3.66428e-01_JPRB, 3.65227e-01_JPRB, 3.64031e-01_JPRB, 3.62838e-01_JPRB, &
+     & 3.61649e-01_JPRB, 3.60464e-01_JPRB, 3.59283e-01_JPRB, 3.58106e-01_JPRB, 3.56932e-01_JPRB, &
+     & 3.55763e-01_JPRB, 3.54597e-01_JPRB, 3.53435e-01_JPRB, 3.52277e-01_JPRB/)
+      kao_mn2o( 3, :, 2) = (/ &
+     & 5.46240e-01_JPRB, 5.42972e-01_JPRB, 5.39724e-01_JPRB, 5.36495e-01_JPRB, 5.33285e-01_JPRB, &
+     & 5.30095e-01_JPRB, 5.26923e-01_JPRB, 5.23771e-01_JPRB, 5.20637e-01_JPRB, 5.17523e-01_JPRB, &
+     & 5.14426e-01_JPRB, 5.11349e-01_JPRB, 5.08290e-01_JPRB, 5.05249e-01_JPRB, 5.02226e-01_JPRB, &
+     & 4.99221e-01_JPRB, 4.96235e-01_JPRB, 4.93266e-01_JPRB, 4.90315e-01_JPRB/)
+      kao_mn2o( 4, :, 2) = (/ &
+     & 8.35399e-01_JPRB, 8.36766e-01_JPRB, 8.38135e-01_JPRB, 8.39507e-01_JPRB, 8.40880e-01_JPRB, &
+     & 8.42256e-01_JPRB, 8.43635e-01_JPRB, 8.45015e-01_JPRB, 8.46398e-01_JPRB, 8.47783e-01_JPRB, &
+     & 8.49170e-01_JPRB, 8.50559e-01_JPRB, 8.51951e-01_JPRB, 8.53345e-01_JPRB, 8.54742e-01_JPRB, &
+     & 8.56140e-01_JPRB, 8.57541e-01_JPRB, 8.58944e-01_JPRB, 8.60350e-01_JPRB/)
+      kao_mn2o( 5, :, 2) = (/ &
+     & 1.04433e+00_JPRB, 1.04864e+00_JPRB, 1.05297e+00_JPRB, 1.05731e+00_JPRB, 1.06168e+00_JPRB, &
+     & 1.06606e+00_JPRB, 1.07046e+00_JPRB, 1.07488e+00_JPRB, 1.07932e+00_JPRB, 1.08377e+00_JPRB, &
+     & 1.08824e+00_JPRB, 1.09274e+00_JPRB, 1.09725e+00_JPRB, 1.10178e+00_JPRB, 1.10632e+00_JPRB, &
+     & 1.11089e+00_JPRB, 1.11547e+00_JPRB, 1.12008e+00_JPRB, 1.12470e+00_JPRB/)
+      kao_mn2o( 6, :, 2) = (/ &
+     & 1.22341e+00_JPRB, 1.22885e+00_JPRB, 1.23431e+00_JPRB, 1.23980e+00_JPRB, 1.24531e+00_JPRB, &
+     & 1.25084e+00_JPRB, 1.25640e+00_JPRB, 1.26199e+00_JPRB, 1.26760e+00_JPRB, 1.27323e+00_JPRB, &
+     & 1.27889e+00_JPRB, 1.28458e+00_JPRB, 1.29029e+00_JPRB, 1.29602e+00_JPRB, 1.30178e+00_JPRB, &
+     & 1.30757e+00_JPRB, 1.31338e+00_JPRB, 1.31922e+00_JPRB, 1.32508e+00_JPRB/)
+      kao_mn2o( 7, :, 2) = (/ &
+     & 1.67595e+00_JPRB, 1.68296e+00_JPRB, 1.69000e+00_JPRB, 1.69707e+00_JPRB, 1.70417e+00_JPRB, &
+     & 1.71130e+00_JPRB, 1.71846e+00_JPRB, 1.72565e+00_JPRB, 1.73287e+00_JPRB, 1.74012e+00_JPRB, &
+     & 1.74740e+00_JPRB, 1.75471e+00_JPRB, 1.76206e+00_JPRB, 1.76943e+00_JPRB, 1.77683e+00_JPRB, &
+     & 1.78426e+00_JPRB, 1.79173e+00_JPRB, 1.79922e+00_JPRB, 1.80675e+00_JPRB/)
+      kao_mn2o( 8, :, 2) = (/ &
+     & 2.76890e+00_JPRB, 2.76981e+00_JPRB, 2.77072e+00_JPRB, 2.77163e+00_JPRB, 2.77254e+00_JPRB, &
+     & 2.77345e+00_JPRB, 2.77436e+00_JPRB, 2.77527e+00_JPRB, 2.77618e+00_JPRB, 2.77709e+00_JPRB, &
+     & 2.77800e+00_JPRB, 2.77891e+00_JPRB, 2.77982e+00_JPRB, 2.78074e+00_JPRB, 2.78165e+00_JPRB, &
+     & 2.78256e+00_JPRB, 2.78348e+00_JPRB, 2.78439e+00_JPRB, 2.78530e+00_JPRB/)
+      kao_mn2o( 9, :, 2) = (/ &
+     & 8.00944e-01_JPRB, 7.95531e-01_JPRB, 7.90155e-01_JPRB, 7.84815e-01_JPRB, 7.79511e-01_JPRB, &
+     & 7.74243e-01_JPRB, 7.69011e-01_JPRB, 7.63813e-01_JPRB, 7.58652e-01_JPRB, 7.53525e-01_JPRB, &
+     & 7.48432e-01_JPRB, 7.43374e-01_JPRB, 7.38350e-01_JPRB, 7.33360e-01_JPRB, 7.28404e-01_JPRB, &
+     & 7.23482e-01_JPRB, 7.18592e-01_JPRB, 7.13736e-01_JPRB, 7.08912e-01_JPRB/)
+      kao_mn2o( 1, :, 3) = (/ &
+     & 5.26578e-02_JPRB, 5.59000e-02_JPRB, 5.93419e-02_JPRB, 6.29957e-02_JPRB, 6.68744e-02_JPRB, &
+     & 7.09920e-02_JPRB, 7.53631e-02_JPRB, 8.00034e-02_JPRB, 8.49294e-02_JPRB, 9.01586e-02_JPRB, &
+     & 9.57099e-02_JPRB, 1.01603e-01_JPRB, 1.07859e-01_JPRB, 1.14500e-01_JPRB, 1.21550e-01_JPRB, &
+     & 1.29034e-01_JPRB, 1.36979e-01_JPRB, 1.45413e-01_JPRB, 1.54366e-01_JPRB/)
+      kao_mn2o( 2, :, 3) = (/ &
+     & 8.18393e-01_JPRB, 8.20623e-01_JPRB, 8.22860e-01_JPRB, 8.25103e-01_JPRB, 8.27352e-01_JPRB, &
+     & 8.29608e-01_JPRB, 8.31869e-01_JPRB, 8.34137e-01_JPRB, 8.36410e-01_JPRB, 8.38690e-01_JPRB, &
+     & 8.40976e-01_JPRB, 8.43269e-01_JPRB, 8.45567e-01_JPRB, 8.47872e-01_JPRB, 8.50183e-01_JPRB, &
+     & 8.52501e-01_JPRB, 8.54825e-01_JPRB, 8.57155e-01_JPRB, 8.59491e-01_JPRB/)
+      kao_mn2o( 3, :, 3) = (/ &
+     & 1.02454e+00_JPRB, 1.03210e+00_JPRB, 1.03972e+00_JPRB, 1.04740e+00_JPRB, 1.05514e+00_JPRB, &
+     & 1.06293e+00_JPRB, 1.07077e+00_JPRB, 1.07868e+00_JPRB, 1.08665e+00_JPRB, 1.09467e+00_JPRB, &
+     & 1.10275e+00_JPRB, 1.11089e+00_JPRB, 1.11910e+00_JPRB, 1.12736e+00_JPRB, 1.13568e+00_JPRB, &
+     & 1.14407e+00_JPRB, 1.15252e+00_JPRB, 1.16103e+00_JPRB, 1.16960e+00_JPRB/)
+      kao_mn2o( 4, :, 3) = (/ &
+     & 1.11755e+00_JPRB, 1.12348e+00_JPRB, 1.12944e+00_JPRB, 1.13543e+00_JPRB, 1.14146e+00_JPRB, &
+     & 1.14752e+00_JPRB, 1.15360e+00_JPRB, 1.15972e+00_JPRB, 1.16588e+00_JPRB, 1.17206e+00_JPRB, &
+     & 1.17828e+00_JPRB, 1.18453e+00_JPRB, 1.19082e+00_JPRB, 1.19714e+00_JPRB, 1.20349e+00_JPRB, &
+     & 1.20988e+00_JPRB, 1.21630e+00_JPRB, 1.22275e+00_JPRB, 1.22924e+00_JPRB/)
+      kao_mn2o( 5, :, 3) = (/ &
+     & 1.41993e+00_JPRB, 1.42353e+00_JPRB, 1.42713e+00_JPRB, 1.43074e+00_JPRB, 1.43436e+00_JPRB, &
+     & 1.43799e+00_JPRB, 1.44163e+00_JPRB, 1.44528e+00_JPRB, 1.44894e+00_JPRB, 1.45261e+00_JPRB, &
+     & 1.45628e+00_JPRB, 1.45997e+00_JPRB, 1.46367e+00_JPRB, 1.46737e+00_JPRB, 1.47108e+00_JPRB, &
+     & 1.47481e+00_JPRB, 1.47854e+00_JPRB, 1.48228e+00_JPRB, 1.48603e+00_JPRB/)
+      kao_mn2o( 6, :, 3) = (/ &
+     & 1.37725e+00_JPRB, 1.38029e+00_JPRB, 1.38334e+00_JPRB, 1.38640e+00_JPRB, 1.38947e+00_JPRB, &
+     & 1.39254e+00_JPRB, 1.39562e+00_JPRB, 1.39870e+00_JPRB, 1.40179e+00_JPRB, 1.40489e+00_JPRB, &
+     & 1.40800e+00_JPRB, 1.41111e+00_JPRB, 1.41423e+00_JPRB, 1.41736e+00_JPRB, 1.42049e+00_JPRB, &
+     & 1.42363e+00_JPRB, 1.42678e+00_JPRB, 1.42993e+00_JPRB, 1.43309e+00_JPRB/)
+      kao_mn2o( 7, :, 3) = (/ &
+     & 1.34579e+00_JPRB, 1.34584e+00_JPRB, 1.34589e+00_JPRB, 1.34594e+00_JPRB, 1.34599e+00_JPRB, &
+     & 1.34603e+00_JPRB, 1.34608e+00_JPRB, 1.34613e+00_JPRB, 1.34618e+00_JPRB, 1.34623e+00_JPRB, &
+     & 1.34627e+00_JPRB, 1.34632e+00_JPRB, 1.34637e+00_JPRB, 1.34642e+00_JPRB, 1.34647e+00_JPRB, &
+     & 1.34651e+00_JPRB, 1.34656e+00_JPRB, 1.34661e+00_JPRB, 1.34666e+00_JPRB/)
+      kao_mn2o( 8, :, 3) = (/ &
+     & 9.15268e-01_JPRB, 9.12779e-01_JPRB, 9.10298e-01_JPRB, 9.07823e-01_JPRB, 9.05355e-01_JPRB, &
+     & 9.02893e-01_JPRB, 9.00438e-01_JPRB, 8.97990e-01_JPRB, 8.95549e-01_JPRB, 8.93114e-01_JPRB, &
+     & 8.90686e-01_JPRB, 8.88264e-01_JPRB, 8.85849e-01_JPRB, 8.83441e-01_JPRB, 8.81039e-01_JPRB, &
+     & 8.78644e-01_JPRB, 8.76255e-01_JPRB, 8.73873e-01_JPRB, 8.71497e-01_JPRB/)
+      kao_mn2o( 9, :, 3) = (/ &
+     & 1.12514e+00_JPRB, 1.13523e+00_JPRB, 1.14541e+00_JPRB, 1.15568e+00_JPRB, 1.16604e+00_JPRB, &
+     & 1.17649e+00_JPRB, 1.18704e+00_JPRB, 1.19768e+00_JPRB, 1.20841e+00_JPRB, 1.21925e+00_JPRB, &
+     & 1.23018e+00_JPRB, 1.24121e+00_JPRB, 1.25233e+00_JPRB, 1.26356e+00_JPRB, 1.27489e+00_JPRB, &
+     & 1.28632e+00_JPRB, 1.29785e+00_JPRB, 1.30948e+00_JPRB, 1.32122e+00_JPRB/)
+      kao_mn2o( 1, :, 4) = (/ &
+     & 4.65135e-01_JPRB, 4.69677e-01_JPRB, 4.74264e-01_JPRB, 4.78895e-01_JPRB, 4.83572e-01_JPRB, &
+     & 4.88294e-01_JPRB, 4.93063e-01_JPRB, 4.97878e-01_JPRB, 5.02740e-01_JPRB, 5.07649e-01_JPRB, &
+     & 5.12607e-01_JPRB, 5.17613e-01_JPRB, 5.22667e-01_JPRB, 5.27771e-01_JPRB, 5.32925e-01_JPRB, &
+     & 5.38130e-01_JPRB, 5.43385e-01_JPRB, 5.48691e-01_JPRB, 5.54049e-01_JPRB/)
+      kao_mn2o( 2, :, 4) = (/ &
+     & 9.71592e-01_JPRB, 9.74472e-01_JPRB, 9.77360e-01_JPRB, 9.80257e-01_JPRB, 9.83163e-01_JPRB, &
+     & 9.86077e-01_JPRB, 9.89000e-01_JPRB, 9.91931e-01_JPRB, 9.94871e-01_JPRB, 9.97820e-01_JPRB, &
+     & 1.00078e+00_JPRB, 1.00374e+00_JPRB, 1.00672e+00_JPRB, 1.00970e+00_JPRB, 1.01270e+00_JPRB, &
+     & 1.01570e+00_JPRB, 1.01871e+00_JPRB, 1.02173e+00_JPRB, 1.02476e+00_JPRB/)
+      kao_mn2o( 3, :, 4) = (/ &
+     & 1.48090e+00_JPRB, 1.48238e+00_JPRB, 1.48385e+00_JPRB, 1.48532e+00_JPRB, 1.48680e+00_JPRB, &
+     & 1.48828e+00_JPRB, 1.48976e+00_JPRB, 1.49124e+00_JPRB, 1.49272e+00_JPRB, 1.49420e+00_JPRB, &
+     & 1.49569e+00_JPRB, 1.49717e+00_JPRB, 1.49866e+00_JPRB, 1.50015e+00_JPRB, 1.50164e+00_JPRB, &
+     & 1.50313e+00_JPRB, 1.50463e+00_JPRB, 1.50612e+00_JPRB, 1.50762e+00_JPRB/)
+      kao_mn2o( 4, :, 4) = (/ &
+     & 1.50599e+00_JPRB, 1.50541e+00_JPRB, 1.50483e+00_JPRB, 1.50426e+00_JPRB, 1.50368e+00_JPRB, &
+     & 1.50310e+00_JPRB, 1.50252e+00_JPRB, 1.50195e+00_JPRB, 1.50137e+00_JPRB, 1.50079e+00_JPRB, &
+     & 1.50022e+00_JPRB, 1.49964e+00_JPRB, 1.49906e+00_JPRB, 1.49849e+00_JPRB, 1.49791e+00_JPRB, &
+     & 1.49734e+00_JPRB, 1.49676e+00_JPRB, 1.49619e+00_JPRB, 1.49561e+00_JPRB/)
+      kao_mn2o( 5, :, 4) = (/ &
+     & 1.25396e+00_JPRB, 1.25230e+00_JPRB, 1.25065e+00_JPRB, 1.24900e+00_JPRB, 1.24735e+00_JPRB, &
+     & 1.24570e+00_JPRB, 1.24405e+00_JPRB, 1.24241e+00_JPRB, 1.24077e+00_JPRB, 1.23913e+00_JPRB, &
+     & 1.23749e+00_JPRB, 1.23586e+00_JPRB, 1.23423e+00_JPRB, 1.23260e+00_JPRB, 1.23097e+00_JPRB, &
+     & 1.22934e+00_JPRB, 1.22772e+00_JPRB, 1.22610e+00_JPRB, 1.22448e+00_JPRB/)
+      kao_mn2o( 6, :, 4) = (/ &
+     & 1.27104e+00_JPRB, 1.26416e+00_JPRB, 1.25731e+00_JPRB, 1.25050e+00_JPRB, 1.24373e+00_JPRB, &
+     & 1.23700e+00_JPRB, 1.23030e+00_JPRB, 1.22364e+00_JPRB, 1.21701e+00_JPRB, 1.21043e+00_JPRB, &
+     & 1.20387e+00_JPRB, 1.19735e+00_JPRB, 1.19087e+00_JPRB, 1.18442e+00_JPRB, 1.17801e+00_JPRB, &
+     & 1.17163e+00_JPRB, 1.16529e+00_JPRB, 1.15898e+00_JPRB, 1.15270e+00_JPRB/)
+      kao_mn2o( 7, :, 4) = (/ &
+     & 9.57877e-01_JPRB, 9.49712e-01_JPRB, 9.41617e-01_JPRB, 9.33591e-01_JPRB, 9.25633e-01_JPRB, &
+     & 9.17743e-01_JPRB, 9.09920e-01_JPRB, 9.02164e-01_JPRB, 8.94473e-01_JPRB, 8.86849e-01_JPRB, &
+     & 8.79289e-01_JPRB, 8.71794e-01_JPRB, 8.64363e-01_JPRB, 8.56995e-01_JPRB, 8.49690e-01_JPRB, &
+     & 8.42447e-01_JPRB, 8.35266e-01_JPRB, 8.28147e-01_JPRB, 8.21087e-01_JPRB/)
+      kao_mn2o( 8, :, 4) = (/ &
+     & 4.75787e-01_JPRB, 4.77208e-01_JPRB, 4.78633e-01_JPRB, 4.80063e-01_JPRB, 4.81496e-01_JPRB, &
+     & 4.82934e-01_JPRB, 4.84377e-01_JPRB, 4.85823e-01_JPRB, 4.87274e-01_JPRB, 4.88730e-01_JPRB, &
+     & 4.90189e-01_JPRB, 4.91653e-01_JPRB, 4.93122e-01_JPRB, 4.94595e-01_JPRB, 4.96072e-01_JPRB, &
+     & 4.97553e-01_JPRB, 4.99039e-01_JPRB, 5.00530e-01_JPRB, 5.02025e-01_JPRB/)
+      kao_mn2o( 9, :, 4) = (/ &
+     & 2.42533e+00_JPRB, 2.41357e+00_JPRB, 2.40188e+00_JPRB, 2.39024e+00_JPRB, 2.37866e+00_JPRB, &
+     & 2.36713e+00_JPRB, 2.35566e+00_JPRB, 2.34425e+00_JPRB, 2.33289e+00_JPRB, 2.32158e+00_JPRB, &
+     & 2.31033e+00_JPRB, 2.29914e+00_JPRB, 2.28800e+00_JPRB, 2.27691e+00_JPRB, 2.26588e+00_JPRB, &
+     & 2.25490e+00_JPRB, 2.24397e+00_JPRB, 2.23310e+00_JPRB, 2.22228e+00_JPRB/)
+      kao_mn2o( 1, :, 5) = (/ &
+     & 1.53885e+00_JPRB, 1.53590e+00_JPRB, 1.53297e+00_JPRB, 1.53004e+00_JPRB, 1.52711e+00_JPRB, &
+     & 1.52419e+00_JPRB, 1.52128e+00_JPRB, 1.51837e+00_JPRB, 1.51547e+00_JPRB, 1.51257e+00_JPRB, &
+     & 1.50968e+00_JPRB, 1.50679e+00_JPRB, 1.50391e+00_JPRB, 1.50104e+00_JPRB, 1.49817e+00_JPRB, &
+     & 1.49530e+00_JPRB, 1.49245e+00_JPRB, 1.48959e+00_JPRB, 1.48675e+00_JPRB/)
+      kao_mn2o( 2, :, 5) = (/ &
+     & 1.83368e+00_JPRB, 1.83530e+00_JPRB, 1.83692e+00_JPRB, 1.83854e+00_JPRB, 1.84016e+00_JPRB, &
+     & 1.84178e+00_JPRB, 1.84340e+00_JPRB, 1.84503e+00_JPRB, 1.84665e+00_JPRB, 1.84828e+00_JPRB, &
+     & 1.84991e+00_JPRB, 1.85154e+00_JPRB, 1.85317e+00_JPRB, 1.85480e+00_JPRB, 1.85644e+00_JPRB, &
+     & 1.85807e+00_JPRB, 1.85971e+00_JPRB, 1.86135e+00_JPRB, 1.86299e+00_JPRB/)
+      kao_mn2o( 3, :, 5) = (/ &
+     & 1.49593e+00_JPRB, 1.49279e+00_JPRB, 1.48965e+00_JPRB, 1.48652e+00_JPRB, 1.48340e+00_JPRB, &
+     & 1.48028e+00_JPRB, 1.47717e+00_JPRB, 1.47406e+00_JPRB, 1.47096e+00_JPRB, 1.46787e+00_JPRB, &
+     & 1.46479e+00_JPRB, 1.46171e+00_JPRB, 1.45863e+00_JPRB, 1.45557e+00_JPRB, 1.45251e+00_JPRB, &
+     & 1.44946e+00_JPRB, 1.44641e+00_JPRB, 1.44337e+00_JPRB, 1.44033e+00_JPRB/)
+      kao_mn2o( 4, :, 5) = (/ &
+     & 1.40048e+00_JPRB, 1.39228e+00_JPRB, 1.38413e+00_JPRB, 1.37603e+00_JPRB, 1.36798e+00_JPRB, &
+     & 1.35997e+00_JPRB, 1.35201e+00_JPRB, 1.34410e+00_JPRB, 1.33623e+00_JPRB, 1.32841e+00_JPRB, &
+     & 1.32064e+00_JPRB, 1.31291e+00_JPRB, 1.30522e+00_JPRB, 1.29758e+00_JPRB, 1.28999e+00_JPRB, &
+     & 1.28244e+00_JPRB, 1.27493e+00_JPRB, 1.26747e+00_JPRB, 1.26005e+00_JPRB/)
+      kao_mn2o( 5, :, 5) = (/ &
+     & 1.22253e+00_JPRB, 1.21202e+00_JPRB, 1.20160e+00_JPRB, 1.19126e+00_JPRB, 1.18102e+00_JPRB, &
+     & 1.17087e+00_JPRB, 1.16080e+00_JPRB, 1.15082e+00_JPRB, 1.14092e+00_JPRB, 1.13111e+00_JPRB, &
+     & 1.12139e+00_JPRB, 1.11174e+00_JPRB, 1.10219e+00_JPRB, 1.09271e+00_JPRB, 1.08331e+00_JPRB, &
+     & 1.07400e+00_JPRB, 1.06476e+00_JPRB, 1.05561e+00_JPRB, 1.04653e+00_JPRB/)
+      kao_mn2o( 6, :, 5) = (/ &
+     & 1.07930e+00_JPRB, 1.06998e+00_JPRB, 1.06075e+00_JPRB, 1.05159e+00_JPRB, 1.04251e+00_JPRB, &
+     & 1.03352e+00_JPRB, 1.02459e+00_JPRB, 1.01575e+00_JPRB, 1.00698e+00_JPRB, 9.98291e-01_JPRB, &
+     & 9.89674e-01_JPRB, 9.81131e-01_JPRB, 9.72663e-01_JPRB, 9.64267e-01_JPRB, 9.55944e-01_JPRB, &
+     & 9.47692e-01_JPRB, 9.39512e-01_JPRB, 9.31402e-01_JPRB, 9.23363e-01_JPRB/)
+      kao_mn2o( 7, :, 5) = (/ &
+     & 7.87066e-01_JPRB, 7.82767e-01_JPRB, 7.78490e-01_JPRB, 7.74237e-01_JPRB, 7.70008e-01_JPRB, &
+     & 7.65801e-01_JPRB, 7.61617e-01_JPRB, 7.57457e-01_JPRB, 7.53319e-01_JPRB, 7.49203e-01_JPRB, &
+     & 7.45110e-01_JPRB, 7.41040e-01_JPRB, 7.36991e-01_JPRB, 7.32965e-01_JPRB, 7.28961e-01_JPRB, &
+     & 7.24979e-01_JPRB, 7.21018e-01_JPRB, 7.17079e-01_JPRB, 7.13161e-01_JPRB/)
+      kao_mn2o( 8, :, 5) = (/ &
+     & 3.83362e-01_JPRB, 3.84405e-01_JPRB, 3.85452e-01_JPRB, 3.86501e-01_JPRB, 3.87552e-01_JPRB, &
+     & 3.88607e-01_JPRB, 3.89665e-01_JPRB, 3.90725e-01_JPRB, 3.91788e-01_JPRB, 3.92855e-01_JPRB, &
+     & 3.93924e-01_JPRB, 3.94996e-01_JPRB, 3.96071e-01_JPRB, 3.97149e-01_JPRB, 3.98229e-01_JPRB, &
+     & 3.99313e-01_JPRB, 4.00400e-01_JPRB, 4.01489e-01_JPRB, 4.02582e-01_JPRB/)
+      kao_mn2o( 9, :, 5) = (/ &
+     & 8.97278e-01_JPRB, 8.92873e-01_JPRB, 8.88490e-01_JPRB, 8.84128e-01_JPRB, 8.79787e-01_JPRB, &
+     & 8.75468e-01_JPRB, 8.71170e-01_JPRB, 8.66893e-01_JPRB, 8.62637e-01_JPRB, 8.58402e-01_JPRB, &
+     & 8.54187e-01_JPRB, 8.49994e-01_JPRB, 8.45821e-01_JPRB, 8.41668e-01_JPRB, 8.37536e-01_JPRB, &
+     & 8.33424e-01_JPRB, 8.29333e-01_JPRB, 8.25261e-01_JPRB, 8.21209e-01_JPRB/)
+      kao_mn2o( 1, :, 6) = (/ &
+     & 1.83809e+00_JPRB, 1.84036e+00_JPRB, 1.84264e+00_JPRB, 1.84491e+00_JPRB, 1.84720e+00_JPRB, &
+     & 1.84948e+00_JPRB, 1.85177e+00_JPRB, 1.85406e+00_JPRB, 1.85635e+00_JPRB, 1.85864e+00_JPRB, &
+     & 1.86094e+00_JPRB, 1.86324e+00_JPRB, 1.86555e+00_JPRB, 1.86785e+00_JPRB, 1.87016e+00_JPRB, &
+     & 1.87247e+00_JPRB, 1.87479e+00_JPRB, 1.87711e+00_JPRB, 1.87943e+00_JPRB/)
+      kao_mn2o( 2, :, 6) = (/ &
+     & 1.82624e+00_JPRB, 1.81564e+00_JPRB, 1.80510e+00_JPRB, 1.79463e+00_JPRB, 1.78421e+00_JPRB, &
+     & 1.77386e+00_JPRB, 1.76356e+00_JPRB, 1.75333e+00_JPRB, 1.74315e+00_JPRB, 1.73304e+00_JPRB, &
+     & 1.72298e+00_JPRB, 1.71298e+00_JPRB, 1.70304e+00_JPRB, 1.69316e+00_JPRB, 1.68333e+00_JPRB, &
+     & 1.67356e+00_JPRB, 1.66385e+00_JPRB, 1.65419e+00_JPRB, 1.64459e+00_JPRB/)
+      kao_mn2o( 3, :, 6) = (/ &
+     & 1.35442e+00_JPRB, 1.34174e+00_JPRB, 1.32918e+00_JPRB, 1.31673e+00_JPRB, 1.30440e+00_JPRB, &
+     & 1.29219e+00_JPRB, 1.28010e+00_JPRB, 1.26811e+00_JPRB, 1.25624e+00_JPRB, 1.24448e+00_JPRB, &
+     & 1.23283e+00_JPRB, 1.22129e+00_JPRB, 1.20985e+00_JPRB, 1.19853e+00_JPRB, 1.18731e+00_JPRB, &
+     & 1.17619e+00_JPRB, 1.16518e+00_JPRB, 1.15427e+00_JPRB, 1.14347e+00_JPRB/)
+      kao_mn2o( 4, :, 6) = (/ &
+     & 1.10510e+00_JPRB, 1.09473e+00_JPRB, 1.08446e+00_JPRB, 1.07429e+00_JPRB, 1.06420e+00_JPRB, &
+     & 1.05422e+00_JPRB, 1.04433e+00_JPRB, 1.03453e+00_JPRB, 1.02482e+00_JPRB, 1.01520e+00_JPRB, &
+     & 1.00568e+00_JPRB, 9.96238e-01_JPRB, 9.86890e-01_JPRB, 9.77629e-01_JPRB, 9.68455e-01_JPRB, &
+     & 9.59367e-01_JPRB, 9.50365e-01_JPRB, 9.41447e-01_JPRB, 9.32612e-01_JPRB/)
+      kao_mn2o( 5, :, 6) = (/ &
+     & 1.01083e+00_JPRB, 1.00221e+00_JPRB, 9.93656e-01_JPRB, 9.85178e-01_JPRB, 9.76772e-01_JPRB, &
+     & 9.68437e-01_JPRB, 9.60174e-01_JPRB, 9.51981e-01_JPRB, 9.43859e-01_JPRB, 9.35805e-01_JPRB, &
+     & 9.27821e-01_JPRB, 9.19904e-01_JPRB, 9.12055e-01_JPRB, 9.04273e-01_JPRB, 8.96557e-01_JPRB, &
+     & 8.88907e-01_JPRB, 8.81323e-01_JPRB, 8.73803e-01_JPRB, 8.66347e-01_JPRB/)
+      kao_mn2o( 6, :, 6) = (/ &
+     & 5.91415e-01_JPRB, 5.90427e-01_JPRB, 5.89441e-01_JPRB, 5.88457e-01_JPRB, 5.87474e-01_JPRB, &
+     & 5.86493e-01_JPRB, 5.85514e-01_JPRB, 5.84536e-01_JPRB, 5.83559e-01_JPRB, 5.82585e-01_JPRB, &
+     & 5.81612e-01_JPRB, 5.80640e-01_JPRB, 5.79671e-01_JPRB, 5.78703e-01_JPRB, 5.77736e-01_JPRB, &
+     & 5.76771e-01_JPRB, 5.75808e-01_JPRB, 5.74846e-01_JPRB, 5.73886e-01_JPRB/)
+      kao_mn2o( 7, :, 6) = (/ &
+     & 3.68189e-01_JPRB, 3.70029e-01_JPRB, 3.71877e-01_JPRB, 3.73735e-01_JPRB, 3.75603e-01_JPRB, &
+     & 3.77479e-01_JPRB, 3.79365e-01_JPRB, 3.81260e-01_JPRB, 3.83165e-01_JPRB, 3.85079e-01_JPRB, &
+     & 3.87003e-01_JPRB, 3.88937e-01_JPRB, 3.90880e-01_JPRB, 3.92833e-01_JPRB, 3.94795e-01_JPRB, &
+     & 3.96768e-01_JPRB, 3.98750e-01_JPRB, 4.00742e-01_JPRB, 4.02744e-01_JPRB/)
+      kao_mn2o( 8, :, 6) = (/ &
+     & 2.98721e-01_JPRB, 2.99932e-01_JPRB, 3.01149e-01_JPRB, 3.02370e-01_JPRB, 3.03597e-01_JPRB, &
+     & 3.04828e-01_JPRB, 3.06064e-01_JPRB, 3.07306e-01_JPRB, 3.08552e-01_JPRB, 3.09804e-01_JPRB, &
+     & 3.11060e-01_JPRB, 3.12322e-01_JPRB, 3.13589e-01_JPRB, 3.14860e-01_JPRB, 3.16138e-01_JPRB, &
+     & 3.17420e-01_JPRB, 3.18707e-01_JPRB, 3.20000e-01_JPRB, 3.21298e-01_JPRB/)
+      kao_mn2o( 9, :, 6) = (/ &
+     & 3.76116e-01_JPRB, 3.77276e-01_JPRB, 3.78439e-01_JPRB, 3.79606e-01_JPRB, 3.80777e-01_JPRB, &
+     & 3.81951e-01_JPRB, 3.83129e-01_JPRB, 3.84310e-01_JPRB, 3.85495e-01_JPRB, 3.86684e-01_JPRB, &
+     & 3.87876e-01_JPRB, 3.89072e-01_JPRB, 3.90272e-01_JPRB, 3.91475e-01_JPRB, 3.92682e-01_JPRB, &
+     & 3.93893e-01_JPRB, 3.95107e-01_JPRB, 3.96326e-01_JPRB, 3.97548e-01_JPRB/)
+      kao_mn2o( 1, :, 7) = (/ &
+     & 3.22705e+00_JPRB, 3.21966e+00_JPRB, 3.21230e+00_JPRB, 3.20494e+00_JPRB, 3.19761e+00_JPRB, &
+     & 3.19029e+00_JPRB, 3.18299e+00_JPRB, 3.17571e+00_JPRB, 3.16844e+00_JPRB, 3.16119e+00_JPRB, &
+     & 3.15395e+00_JPRB, 3.14673e+00_JPRB, 3.13953e+00_JPRB, 3.13235e+00_JPRB, 3.12518e+00_JPRB, &
+     & 3.11803e+00_JPRB, 3.11089e+00_JPRB, 3.10377e+00_JPRB, 3.09667e+00_JPRB/)
+      kao_mn2o( 2, :, 7) = (/ &
+     & 1.43811e+00_JPRB, 1.42367e+00_JPRB, 1.40938e+00_JPRB, 1.39522e+00_JPRB, 1.38121e+00_JPRB, &
+     & 1.36735e+00_JPRB, 1.35362e+00_JPRB, 1.34002e+00_JPRB, 1.32657e+00_JPRB, 1.31325e+00_JPRB, &
+     & 1.30006e+00_JPRB, 1.28701e+00_JPRB, 1.27408e+00_JPRB, 1.26129e+00_JPRB, 1.24862e+00_JPRB, &
+     & 1.23609e+00_JPRB, 1.22367e+00_JPRB, 1.21139e+00_JPRB, 1.19922e+00_JPRB/)
+      kao_mn2o( 3, :, 7) = (/ &
+     & 1.22586e+00_JPRB, 1.21639e+00_JPRB, 1.20700e+00_JPRB, 1.19767e+00_JPRB, 1.18842e+00_JPRB, &
+     & 1.17924e+00_JPRB, 1.17014e+00_JPRB, 1.16110e+00_JPRB, 1.15213e+00_JPRB, 1.14323e+00_JPRB, &
+     & 1.13440e+00_JPRB, 1.12564e+00_JPRB, 1.11695e+00_JPRB, 1.10832e+00_JPRB, 1.09976e+00_JPRB, &
+     & 1.09127e+00_JPRB, 1.08284e+00_JPRB, 1.07447e+00_JPRB, 1.06618e+00_JPRB/)
+      kao_mn2o( 4, :, 7) = (/ &
+     & 7.94380e-01_JPRB, 7.92795e-01_JPRB, 7.91213e-01_JPRB, 7.89634e-01_JPRB, 7.88059e-01_JPRB, &
+     & 7.86486e-01_JPRB, 7.84917e-01_JPRB, 7.83351e-01_JPRB, 7.81787e-01_JPRB, 7.80227e-01_JPRB, &
+     & 7.78671e-01_JPRB, 7.77117e-01_JPRB, 7.75566e-01_JPRB, 7.74019e-01_JPRB, 7.72474e-01_JPRB, &
+     & 7.70933e-01_JPRB, 7.69394e-01_JPRB, 7.67859e-01_JPRB, 7.66327e-01_JPRB/)
+      kao_mn2o( 5, :, 7) = (/ &
+     & 4.46935e-01_JPRB, 4.49760e-01_JPRB, 4.52602e-01_JPRB, 4.55462e-01_JPRB, 4.58340e-01_JPRB, &
+     & 4.61237e-01_JPRB, 4.64152e-01_JPRB, 4.67085e-01_JPRB, 4.70037e-01_JPRB, 4.73007e-01_JPRB, &
+     & 4.75996e-01_JPRB, 4.79004e-01_JPRB, 4.82031e-01_JPRB, 4.85078e-01_JPRB, 4.88143e-01_JPRB, &
+     & 4.91228e-01_JPRB, 4.94332e-01_JPRB, 4.97456e-01_JPRB, 5.00600e-01_JPRB/)
+      kao_mn2o( 6, :, 7) = (/ &
+     & 4.20211e-01_JPRB, 4.21711e-01_JPRB, 4.23216e-01_JPRB, 4.24726e-01_JPRB, 4.26242e-01_JPRB, &
+     & 4.27763e-01_JPRB, 4.29290e-01_JPRB, 4.30822e-01_JPRB, 4.32359e-01_JPRB, 4.33902e-01_JPRB, &
+     & 4.35450e-01_JPRB, 4.37004e-01_JPRB, 4.38564e-01_JPRB, 4.40129e-01_JPRB, 4.41700e-01_JPRB, &
+     & 4.43276e-01_JPRB, 4.44858e-01_JPRB, 4.46445e-01_JPRB, 4.48038e-01_JPRB/)
+      kao_mn2o( 7, :, 7) = (/ &
+     & 3.42094e-01_JPRB, 3.43589e-01_JPRB, 3.45091e-01_JPRB, 3.46600e-01_JPRB, 3.48115e-01_JPRB, &
+     & 3.49637e-01_JPRB, 3.51165e-01_JPRB, 3.52700e-01_JPRB, 3.54242e-01_JPRB, 3.55791e-01_JPRB, &
+     & 3.57346e-01_JPRB, 3.58908e-01_JPRB, 3.60477e-01_JPRB, 3.62053e-01_JPRB, 3.63636e-01_JPRB, &
+     & 3.65225e-01_JPRB, 3.66822e-01_JPRB, 3.68426e-01_JPRB, 3.70036e-01_JPRB/)
+      kao_mn2o( 8, :, 7) = (/ &
+     & 2.94919e-01_JPRB, 2.97460e-01_JPRB, 3.00022e-01_JPRB, 3.02606e-01_JPRB, 3.05212e-01_JPRB, &
+     & 3.07841e-01_JPRB, 3.10492e-01_JPRB, 3.13167e-01_JPRB, 3.15864e-01_JPRB, 3.18584e-01_JPRB, &
+     & 3.21328e-01_JPRB, 3.24096e-01_JPRB, 3.26887e-01_JPRB, 3.29703e-01_JPRB, 3.32543e-01_JPRB, &
+     & 3.35407e-01_JPRB, 3.38296e-01_JPRB, 3.41210e-01_JPRB, 3.44148e-01_JPRB/)
+      kao_mn2o( 9, :, 7) = (/ &
+     & 2.97441e-01_JPRB, 2.99207e-01_JPRB, 3.00984e-01_JPRB, 3.02772e-01_JPRB, 3.04570e-01_JPRB, &
+     & 3.06379e-01_JPRB, 3.08199e-01_JPRB, 3.10029e-01_JPRB, 3.11870e-01_JPRB, 3.13723e-01_JPRB, &
+     & 3.15586e-01_JPRB, 3.17460e-01_JPRB, 3.19345e-01_JPRB, 3.21242e-01_JPRB, 3.23150e-01_JPRB, &
+     & 3.25069e-01_JPRB, 3.27000e-01_JPRB, 3.28942e-01_JPRB, 3.30895e-01_JPRB/)
+      kao_mn2o( 1, :, 8) = (/ &
+     & 2.14641e+00_JPRB, 2.12585e+00_JPRB, 2.10549e+00_JPRB, 2.08532e+00_JPRB, 2.06534e+00_JPRB, &
+     & 2.04556e+00_JPRB, 2.02596e+00_JPRB, 2.00656e+00_JPRB, 1.98733e+00_JPRB, 1.96830e+00_JPRB, &
+     & 1.94944e+00_JPRB, 1.93077e+00_JPRB, 1.91227e+00_JPRB, 1.89395e+00_JPRB, 1.87581e+00_JPRB, &
+     & 1.85784e+00_JPRB, 1.84004e+00_JPRB, 1.82242e+00_JPRB, 1.80496e+00_JPRB/)
+      kao_mn2o( 2, :, 8) = (/ &
+     & 8.83687e-01_JPRB, 8.83170e-01_JPRB, 8.82654e-01_JPRB, 8.82137e-01_JPRB, 8.81621e-01_JPRB, &
+     & 8.81106e-01_JPRB, 8.80590e-01_JPRB, 8.80075e-01_JPRB, 8.79560e-01_JPRB, 8.79046e-01_JPRB, &
+     & 8.78531e-01_JPRB, 8.78017e-01_JPRB, 8.77504e-01_JPRB, 8.76990e-01_JPRB, 8.76477e-01_JPRB, &
+     & 8.75965e-01_JPRB, 8.75452e-01_JPRB, 8.74940e-01_JPRB, 8.74428e-01_JPRB/)
+      kao_mn2o( 3, :, 8) = (/ &
+     & 4.49840e-01_JPRB, 4.52683e-01_JPRB, 4.55543e-01_JPRB, 4.58421e-01_JPRB, 4.61318e-01_JPRB, &
+     & 4.64233e-01_JPRB, 4.67166e-01_JPRB, 4.70118e-01_JPRB, 4.73088e-01_JPRB, 4.76078e-01_JPRB, &
+     & 4.79086e-01_JPRB, 4.82113e-01_JPRB, 4.85159e-01_JPRB, 4.88225e-01_JPRB, 4.91310e-01_JPRB, &
+     & 4.94414e-01_JPRB, 4.97538e-01_JPRB, 5.00682e-01_JPRB, 5.03845e-01_JPRB/)
+      kao_mn2o( 4, :, 8) = (/ &
+     & 3.92292e-01_JPRB, 3.93574e-01_JPRB, 3.94861e-01_JPRB, 3.96151e-01_JPRB, 3.97446e-01_JPRB, &
+     & 3.98746e-01_JPRB, 4.00049e-01_JPRB, 4.01357e-01_JPRB, 4.02669e-01_JPRB, 4.03985e-01_JPRB, &
+     & 4.05306e-01_JPRB, 4.06630e-01_JPRB, 4.07960e-01_JPRB, 4.09293e-01_JPRB, 4.10631e-01_JPRB, &
+     & 4.11973e-01_JPRB, 4.13320e-01_JPRB, 4.14671e-01_JPRB, 4.16027e-01_JPRB/)
+      kao_mn2o( 5, :, 8) = (/ &
+     & 3.38920e-01_JPRB, 3.41151e-01_JPRB, 3.43397e-01_JPRB, 3.45658e-01_JPRB, 3.47934e-01_JPRB, &
+     & 3.50225e-01_JPRB, 3.52531e-01_JPRB, 3.54852e-01_JPRB, 3.57189e-01_JPRB, 3.59541e-01_JPRB, &
+     & 3.61908e-01_JPRB, 3.64291e-01_JPRB, 3.66689e-01_JPRB, 3.69104e-01_JPRB, 3.71534e-01_JPRB, &
+     & 3.73980e-01_JPRB, 3.76443e-01_JPRB, 3.78921e-01_JPRB, 3.81416e-01_JPRB/)
+      kao_mn2o( 6, :, 8) = (/ &
+     & 3.01673e-01_JPRB, 3.04752e-01_JPRB, 3.07863e-01_JPRB, 3.11005e-01_JPRB, 3.14180e-01_JPRB, &
+     & 3.17387e-01_JPRB, 3.20626e-01_JPRB, 3.23899e-01_JPRB, 3.27205e-01_JPRB, 3.30545e-01_JPRB, &
+     & 3.33919e-01_JPRB, 3.37328e-01_JPRB, 3.40771e-01_JPRB, 3.44249e-01_JPRB, 3.47763e-01_JPRB, &
+     & 3.51313e-01_JPRB, 3.54899e-01_JPRB, 3.58521e-01_JPRB, 3.62181e-01_JPRB/)
+      kao_mn2o( 7, :, 8) = (/ &
+     & 2.99381e-01_JPRB, 3.02431e-01_JPRB, 3.05512e-01_JPRB, 3.08624e-01_JPRB, 3.11768e-01_JPRB, &
+     & 3.14945e-01_JPRB, 3.18153e-01_JPRB, 3.21394e-01_JPRB, 3.24668e-01_JPRB, 3.27976e-01_JPRB, &
+     & 3.31317e-01_JPRB, 3.34693e-01_JPRB, 3.38102e-01_JPRB, 3.41547e-01_JPRB, 3.45026e-01_JPRB, &
+     & 3.48541e-01_JPRB, 3.52092e-01_JPRB, 3.55679e-01_JPRB, 3.59302e-01_JPRB/)
+      kao_mn2o( 8, :, 8) = (/ &
+     & 2.87559e-01_JPRB, 2.89153e-01_JPRB, 2.90756e-01_JPRB, 2.92367e-01_JPRB, 2.93987e-01_JPRB, &
+     & 2.95617e-01_JPRB, 2.97255e-01_JPRB, 2.98902e-01_JPRB, 3.00559e-01_JPRB, 3.02225e-01_JPRB, &
+     & 3.03899e-01_JPRB, 3.05584e-01_JPRB, 3.07277e-01_JPRB, 3.08980e-01_JPRB, 3.10693e-01_JPRB, &
+     & 3.12414e-01_JPRB, 3.14146e-01_JPRB, 3.15887e-01_JPRB, 3.17638e-01_JPRB/)
+      kao_mn2o( 9, :, 8) = (/ &
+     & 2.96238e-01_JPRB, 2.97588e-01_JPRB, 2.98945e-01_JPRB, 3.00309e-01_JPRB, 3.01678e-01_JPRB, &
+     & 3.03054e-01_JPRB, 3.04436e-01_JPRB, 3.05824e-01_JPRB, 3.07219e-01_JPRB, 3.08620e-01_JPRB, &
+     & 3.10027e-01_JPRB, 3.11441e-01_JPRB, 3.12861e-01_JPRB, 3.14288e-01_JPRB, 3.15721e-01_JPRB, &
+     & 3.17161e-01_JPRB, 3.18607e-01_JPRB, 3.20060e-01_JPRB, 3.21520e-01_JPRB/)
+      kao_mn2o( 1, :, 9) = (/ &
+     & 1.56483e+00_JPRB, 1.55792e+00_JPRB, 1.55105e+00_JPRB, 1.54420e+00_JPRB, 1.53739e+00_JPRB, &
+     & 1.53060e+00_JPRB, 1.52384e+00_JPRB, 1.51712e+00_JPRB, 1.51042e+00_JPRB, 1.50376e+00_JPRB, &
+     & 1.49712e+00_JPRB, 1.49051e+00_JPRB, 1.48393e+00_JPRB, 1.47738e+00_JPRB, 1.47086e+00_JPRB, &
+     & 1.46437e+00_JPRB, 1.45791e+00_JPRB, 1.45147e+00_JPRB, 1.44507e+00_JPRB/)
+      kao_mn2o( 2, :, 9) = (/ &
+     & 4.09526e-01_JPRB, 4.10301e-01_JPRB, 4.11078e-01_JPRB, 4.11857e-01_JPRB, 4.12637e-01_JPRB, &
+     & 4.13418e-01_JPRB, 4.14201e-01_JPRB, 4.14986e-01_JPRB, 4.15771e-01_JPRB, 4.16559e-01_JPRB, &
+     & 4.17348e-01_JPRB, 4.18138e-01_JPRB, 4.18930e-01_JPRB, 4.19723e-01_JPRB, 4.20518e-01_JPRB, &
+     & 4.21315e-01_JPRB, 4.22112e-01_JPRB, 4.22912e-01_JPRB, 4.23713e-01_JPRB/)
+      kao_mn2o( 3, :, 9) = (/ &
+     & 3.35672e-01_JPRB, 3.38982e-01_JPRB, 3.42326e-01_JPRB, 3.45702e-01_JPRB, 3.49111e-01_JPRB, &
+     & 3.52554e-01_JPRB, 3.56031e-01_JPRB, 3.59543e-01_JPRB, 3.63089e-01_JPRB, 3.66670e-01_JPRB, &
+     & 3.70286e-01_JPRB, 3.73938e-01_JPRB, 3.77626e-01_JPRB, 3.81350e-01_JPRB, 3.85111e-01_JPRB, &
+     & 3.88909e-01_JPRB, 3.92745e-01_JPRB, 3.96618e-01_JPRB, 4.00530e-01_JPRB/)
+      kao_mn2o( 4, :, 9) = (/ &
+     & 3.19130e-01_JPRB, 3.23028e-01_JPRB, 3.26973e-01_JPRB, 3.30966e-01_JPRB, 3.35008e-01_JPRB, &
+     & 3.39100e-01_JPRB, 3.43241e-01_JPRB, 3.47433e-01_JPRB, 3.51676e-01_JPRB, 3.55971e-01_JPRB, &
+     & 3.60319e-01_JPRB, 3.64719e-01_JPRB, 3.69173e-01_JPRB, 3.73682e-01_JPRB, 3.78246e-01_JPRB, &
+     & 3.82865e-01_JPRB, 3.87541e-01_JPRB, 3.92274e-01_JPRB, 3.97065e-01_JPRB/)
+      kao_mn2o( 5, :, 9) = (/ &
+     & 3.04385e-01_JPRB, 3.07155e-01_JPRB, 3.09949e-01_JPRB, 3.12770e-01_JPRB, 3.15616e-01_JPRB, &
+     & 3.18488e-01_JPRB, 3.21386e-01_JPRB, 3.24310e-01_JPRB, 3.27261e-01_JPRB, 3.30239e-01_JPRB, &
+     & 3.33244e-01_JPRB, 3.36276e-01_JPRB, 3.39336e-01_JPRB, 3.42424e-01_JPRB, 3.45540e-01_JPRB, &
+     & 3.48684e-01_JPRB, 3.51857e-01_JPRB, 3.55059e-01_JPRB, 3.58289e-01_JPRB/)
+      kao_mn2o( 6, :, 9) = (/ &
+     & 2.98789e-01_JPRB, 3.00996e-01_JPRB, 3.03220e-01_JPRB, 3.05460e-01_JPRB, 3.07717e-01_JPRB, &
+     & 3.09990e-01_JPRB, 3.12281e-01_JPRB, 3.14588e-01_JPRB, 3.16912e-01_JPRB, 3.19253e-01_JPRB, &
+     & 3.21612e-01_JPRB, 3.23988e-01_JPRB, 3.26382e-01_JPRB, 3.28793e-01_JPRB, 3.31222e-01_JPRB, &
+     & 3.33669e-01_JPRB, 3.36134e-01_JPRB, 3.38618e-01_JPRB, 3.41119e-01_JPRB/)
+      kao_mn2o( 7, :, 9) = (/ &
+     & 3.08712e-01_JPRB, 3.10491e-01_JPRB, 3.12281e-01_JPRB, 3.14080e-01_JPRB, 3.15890e-01_JPRB, &
+     & 3.17710e-01_JPRB, 3.19541e-01_JPRB, 3.21382e-01_JPRB, 3.23234e-01_JPRB, 3.25097e-01_JPRB, &
+     & 3.26970e-01_JPRB, 3.28854e-01_JPRB, 3.30749e-01_JPRB, 3.32655e-01_JPRB, 3.34572e-01_JPRB, &
+     & 3.36500e-01_JPRB, 3.38439e-01_JPRB, 3.40390e-01_JPRB, 3.42351e-01_JPRB/)
+      kao_mn2o( 8, :, 9) = (/ &
+     & 3.10571e-01_JPRB, 3.12262e-01_JPRB, 3.13961e-01_JPRB, 3.15670e-01_JPRB, 3.17388e-01_JPRB, &
+     & 3.19115e-01_JPRB, 3.20852e-01_JPRB, 3.22598e-01_JPRB, 3.24354e-01_JPRB, 3.26120e-01_JPRB, &
+     & 3.27895e-01_JPRB, 3.29679e-01_JPRB, 3.31474e-01_JPRB, 3.33278e-01_JPRB, 3.35092e-01_JPRB, &
+     & 3.36915e-01_JPRB, 3.38749e-01_JPRB, 3.40593e-01_JPRB, 3.42447e-01_JPRB/)
+      kao_mn2o( 9, :, 9) = (/ &
+     & 3.16436e-01_JPRB, 3.18200e-01_JPRB, 3.19974e-01_JPRB, 3.21759e-01_JPRB, 3.23553e-01_JPRB, &
+     & 3.25357e-01_JPRB, 3.27172e-01_JPRB, 3.28996e-01_JPRB, 3.30831e-01_JPRB, 3.32675e-01_JPRB, &
+     & 3.34530e-01_JPRB, 3.36396e-01_JPRB, 3.38272e-01_JPRB, 3.40158e-01_JPRB, 3.42055e-01_JPRB, &
+     & 3.43962e-01_JPRB, 3.45880e-01_JPRB, 3.47809e-01_JPRB, 3.49749e-01_JPRB/)
+      kao_mn2o( 1, :,10) = (/ &
+     & 7.68616e-01_JPRB, 7.63263e-01_JPRB, 7.57948e-01_JPRB, 7.52669e-01_JPRB, 7.47428e-01_JPRB, &
+     & 7.42223e-01_JPRB, 7.37054e-01_JPRB, 7.31921e-01_JPRB, 7.26824e-01_JPRB, 7.21762e-01_JPRB, &
+     & 7.16736e-01_JPRB, 7.11744e-01_JPRB, 7.06788e-01_JPRB, 7.01866e-01_JPRB, 6.96978e-01_JPRB, &
+     & 6.92124e-01_JPRB, 6.87304e-01_JPRB, 6.82517e-01_JPRB, 6.77764e-01_JPRB/)
+      kao_mn2o( 2, :,10) = (/ &
+     & 4.97271e-01_JPRB, 5.10054e-01_JPRB, 5.23165e-01_JPRB, 5.36614e-01_JPRB, 5.50408e-01_JPRB, &
+     & 5.64556e-01_JPRB, 5.79069e-01_JPRB, 5.93954e-01_JPRB, 6.09222e-01_JPRB, 6.24883e-01_JPRB, &
+     & 6.40946e-01_JPRB, 6.57422e-01_JPRB, 6.74321e-01_JPRB, 6.91655e-01_JPRB, 7.09435e-01_JPRB, &
+     & 7.27671e-01_JPRB, 7.46377e-01_JPRB, 7.65563e-01_JPRB, 7.85242e-01_JPRB/)
+      kao_mn2o( 3, :,10) = (/ &
+     & 2.44443e-01_JPRB, 2.47096e-01_JPRB, 2.49778e-01_JPRB, 2.52489e-01_JPRB, 2.55229e-01_JPRB, &
+     & 2.57999e-01_JPRB, 2.60799e-01_JPRB, 2.63630e-01_JPRB, 2.66491e-01_JPRB, 2.69383e-01_JPRB, &
+     & 2.72307e-01_JPRB, 2.75262e-01_JPRB, 2.78250e-01_JPRB, 2.81269e-01_JPRB, 2.84322e-01_JPRB, &
+     & 2.87408e-01_JPRB, 2.90527e-01_JPRB, 2.93680e-01_JPRB, 2.96868e-01_JPRB/)
+      kao_mn2o( 4, :,10) = (/ &
+     & 2.01964e-01_JPRB, 2.02869e-01_JPRB, 2.03777e-01_JPRB, 2.04690e-01_JPRB, 2.05606e-01_JPRB, &
+     & 2.06527e-01_JPRB, 2.07452e-01_JPRB, 2.08381e-01_JPRB, 2.09314e-01_JPRB, 2.10251e-01_JPRB, &
+     & 2.11193e-01_JPRB, 2.12139e-01_JPRB, 2.13089e-01_JPRB, 2.14043e-01_JPRB, 2.15002e-01_JPRB, &
+     & 2.15964e-01_JPRB, 2.16932e-01_JPRB, 2.17903e-01_JPRB, 2.18879e-01_JPRB/)
+      kao_mn2o( 5, :,10) = (/ &
+     & 2.56972e-01_JPRB, 2.56837e-01_JPRB, 2.56702e-01_JPRB, 2.56567e-01_JPRB, 2.56432e-01_JPRB, &
+     & 2.56297e-01_JPRB, 2.56162e-01_JPRB, 2.56027e-01_JPRB, 2.55893e-01_JPRB, 2.55758e-01_JPRB, &
+     & 2.55624e-01_JPRB, 2.55489e-01_JPRB, 2.55355e-01_JPRB, 2.55220e-01_JPRB, 2.55086e-01_JPRB, &
+     & 2.54952e-01_JPRB, 2.54818e-01_JPRB, 2.54684e-01_JPRB, 2.54550e-01_JPRB/)
+      kao_mn2o( 6, :,10) = (/ &
+     & 2.57322e-01_JPRB, 2.57187e-01_JPRB, 2.57052e-01_JPRB, 2.56917e-01_JPRB, 2.56782e-01_JPRB, &
+     & 2.56647e-01_JPRB, 2.56512e-01_JPRB, 2.56377e-01_JPRB, 2.56243e-01_JPRB, 2.56108e-01_JPRB, &
+     & 2.55974e-01_JPRB, 2.55839e-01_JPRB, 2.55705e-01_JPRB, 2.55570e-01_JPRB, 2.55436e-01_JPRB, &
+     & 2.55302e-01_JPRB, 2.55168e-01_JPRB, 2.55034e-01_JPRB, 2.54900e-01_JPRB/)
+      kao_mn2o( 7, :,10) = (/ &
+     & 2.56551e-01_JPRB, 2.56421e-01_JPRB, 2.56291e-01_JPRB, 2.56161e-01_JPRB, 2.56030e-01_JPRB, &
+     & 2.55900e-01_JPRB, 2.55770e-01_JPRB, 2.55640e-01_JPRB, 2.55511e-01_JPRB, 2.55381e-01_JPRB, &
+     & 2.55251e-01_JPRB, 2.55121e-01_JPRB, 2.54992e-01_JPRB, 2.54862e-01_JPRB, 2.54733e-01_JPRB, &
+     & 2.54603e-01_JPRB, 2.54474e-01_JPRB, 2.54345e-01_JPRB, 2.54215e-01_JPRB/)
+      kao_mn2o( 8, :,10) = (/ &
+     & 2.73629e-01_JPRB, 2.73460e-01_JPRB, 2.73291e-01_JPRB, 2.73122e-01_JPRB, 2.72953e-01_JPRB, &
+     & 2.72784e-01_JPRB, 2.72615e-01_JPRB, 2.72447e-01_JPRB, 2.72279e-01_JPRB, 2.72110e-01_JPRB, &
+     & 2.71942e-01_JPRB, 2.71774e-01_JPRB, 2.71606e-01_JPRB, 2.71438e-01_JPRB, 2.71270e-01_JPRB, &
+     & 2.71102e-01_JPRB, 2.70935e-01_JPRB, 2.70767e-01_JPRB, 2.70600e-01_JPRB/)
+      kao_mn2o( 9, :,10) = (/ &
+     & 2.57294e-01_JPRB, 2.57149e-01_JPRB, 2.57004e-01_JPRB, 2.56860e-01_JPRB, 2.56715e-01_JPRB, &
+     & 2.56570e-01_JPRB, 2.56426e-01_JPRB, 2.56282e-01_JPRB, 2.56137e-01_JPRB, 2.55993e-01_JPRB, &
+     & 2.55849e-01_JPRB, 2.55705e-01_JPRB, 2.55561e-01_JPRB, 2.55417e-01_JPRB, 2.55273e-01_JPRB, &
+     & 2.55129e-01_JPRB, 2.54986e-01_JPRB, 2.54842e-01_JPRB, 2.54698e-01_JPRB/)
+      kao_mn2o( 1, :,11) = (/ &
+     & 6.91062e-01_JPRB, 6.84151e-01_JPRB, 6.77309e-01_JPRB, 6.70535e-01_JPRB, 6.63829e-01_JPRB, &
+     & 6.57190e-01_JPRB, 6.50617e-01_JPRB, 6.44111e-01_JPRB, 6.37669e-01_JPRB, 6.31292e-01_JPRB, &
+     & 6.24978e-01_JPRB, 6.18728e-01_JPRB, 6.12540e-01_JPRB, 6.06414e-01_JPRB, 6.00349e-01_JPRB, &
+     & 5.94345e-01_JPRB, 5.88401e-01_JPRB, 5.82517e-01_JPRB, 5.76691e-01_JPRB/)
+      kao_mn2o( 2, :,11) = (/ &
+     & 1.98698e-01_JPRB, 2.01182e-01_JPRB, 2.03698e-01_JPRB, 2.06244e-01_JPRB, 2.08823e-01_JPRB, &
+     & 2.11433e-01_JPRB, 2.14077e-01_JPRB, 2.16753e-01_JPRB, 2.19463e-01_JPRB, 2.22207e-01_JPRB, &
+     & 2.24985e-01_JPRB, 2.27798e-01_JPRB, 2.30646e-01_JPRB, 2.33529e-01_JPRB, 2.36449e-01_JPRB, &
+     & 2.39405e-01_JPRB, 2.42398e-01_JPRB, 2.45429e-01_JPRB, 2.48497e-01_JPRB/)
+      kao_mn2o( 3, :,11) = (/ &
+     & 2.11950e-01_JPRB, 2.13560e-01_JPRB, 2.15184e-01_JPRB, 2.16819e-01_JPRB, 2.18467e-01_JPRB, &
+     & 2.20127e-01_JPRB, 2.21800e-01_JPRB, 2.23486e-01_JPRB, 2.25185e-01_JPRB, 2.26896e-01_JPRB, &
+     & 2.28621e-01_JPRB, 2.30358e-01_JPRB, 2.32109e-01_JPRB, 2.33873e-01_JPRB, 2.35651e-01_JPRB, &
+     & 2.37442e-01_JPRB, 2.39247e-01_JPRB, 2.41065e-01_JPRB, 2.42897e-01_JPRB/)
+      kao_mn2o( 4, :,11) = (/ &
+     & 3.14210e-01_JPRB, 3.13143e-01_JPRB, 3.12080e-01_JPRB, 3.11021e-01_JPRB, 3.09965e-01_JPRB, &
+     & 3.08913e-01_JPRB, 3.07864e-01_JPRB, 3.06819e-01_JPRB, 3.05777e-01_JPRB, 3.04739e-01_JPRB, &
+     & 3.03705e-01_JPRB, 3.02674e-01_JPRB, 3.01646e-01_JPRB, 3.00622e-01_JPRB, 2.99602e-01_JPRB, &
+     & 2.98584e-01_JPRB, 2.97571e-01_JPRB, 2.96561e-01_JPRB, 2.95554e-01_JPRB/)
+      kao_mn2o( 5, :,11) = (/ &
+     & 3.13536e-01_JPRB, 3.12459e-01_JPRB, 3.11386e-01_JPRB, 3.10316e-01_JPRB, 3.09250e-01_JPRB, &
+     & 3.08188e-01_JPRB, 3.07129e-01_JPRB, 3.06074e-01_JPRB, 3.05022e-01_JPRB, 3.03974e-01_JPRB, &
+     & 3.02930e-01_JPRB, 3.01889e-01_JPRB, 3.00852e-01_JPRB, 2.99819e-01_JPRB, 2.98789e-01_JPRB, &
+     & 2.97762e-01_JPRB, 2.96739e-01_JPRB, 2.95720e-01_JPRB, 2.94704e-01_JPRB/)
+      kao_mn2o( 6, :,11) = (/ &
+     & 3.13215e-01_JPRB, 3.12123e-01_JPRB, 3.11034e-01_JPRB, 3.09949e-01_JPRB, 3.08867e-01_JPRB, &
+     & 3.07790e-01_JPRB, 3.06716e-01_JPRB, 3.05646e-01_JPRB, 3.04579e-01_JPRB, 3.03517e-01_JPRB, &
+     & 3.02458e-01_JPRB, 3.01403e-01_JPRB, 3.00351e-01_JPRB, 2.99303e-01_JPRB, 2.98259e-01_JPRB, &
+     & 2.97219e-01_JPRB, 2.96182e-01_JPRB, 2.95148e-01_JPRB, 2.94119e-01_JPRB/)
+      kao_mn2o( 7, :,11) = (/ &
+     & 3.14236e-01_JPRB, 3.13123e-01_JPRB, 3.12014e-01_JPRB, 3.10908e-01_JPRB, 3.09806e-01_JPRB, &
+     & 3.08709e-01_JPRB, 3.07615e-01_JPRB, 3.06525e-01_JPRB, 3.05439e-01_JPRB, 3.04357e-01_JPRB, &
+     & 3.03278e-01_JPRB, 3.02204e-01_JPRB, 3.01133e-01_JPRB, 3.00066e-01_JPRB, 2.99003e-01_JPRB, &
+     & 2.97944e-01_JPRB, 2.96888e-01_JPRB, 2.95836e-01_JPRB, 2.94788e-01_JPRB/)
+      kao_mn2o( 8, :,11) = (/ &
+     & 2.97453e-01_JPRB, 2.96420e-01_JPRB, 2.95391e-01_JPRB, 2.94366e-01_JPRB, 2.93344e-01_JPRB, &
+     & 2.92325e-01_JPRB, 2.91311e-01_JPRB, 2.90299e-01_JPRB, 2.89291e-01_JPRB, 2.88287e-01_JPRB, &
+     & 2.87286e-01_JPRB, 2.86289e-01_JPRB, 2.85295e-01_JPRB, 2.84304e-01_JPRB, 2.83317e-01_JPRB, &
+     & 2.82334e-01_JPRB, 2.81354e-01_JPRB, 2.80377e-01_JPRB, 2.79404e-01_JPRB/)
+      kao_mn2o( 9, :,11) = (/ &
+     & 3.12694e-01_JPRB, 3.11622e-01_JPRB, 3.10554e-01_JPRB, 3.09489e-01_JPRB, 3.08428e-01_JPRB, &
+     & 3.07370e-01_JPRB, 3.06316e-01_JPRB, 3.05266e-01_JPRB, 3.04220e-01_JPRB, 3.03177e-01_JPRB, &
+     & 3.02137e-01_JPRB, 3.01101e-01_JPRB, 3.00069e-01_JPRB, 2.99040e-01_JPRB, 2.98015e-01_JPRB, &
+     & 2.96993e-01_JPRB, 2.95975e-01_JPRB, 2.94960e-01_JPRB, 2.93949e-01_JPRB/)
+      kao_mn2o( 1, :,12) = (/ &
+     & 5.30796e-01_JPRB, 5.50444e-01_JPRB, 5.70818e-01_JPRB, 5.91947e-01_JPRB, 6.13857e-01_JPRB, &
+     & 6.36579e-01_JPRB, 6.60142e-01_JPRB, 6.84577e-01_JPRB, 7.09916e-01_JPRB, 7.36194e-01_JPRB, &
+     & 7.63444e-01_JPRB, 7.91702e-01_JPRB, 8.21007e-01_JPRB, 8.51396e-01_JPRB, 8.82910e-01_JPRB, &
+     & 9.15591e-01_JPRB, 9.49481e-01_JPRB, 9.84626e-01_JPRB, 1.02107e+00_JPRB/)
+      kao_mn2o( 2, :,12) = (/ &
+     & 1.38469e-01_JPRB, 1.40959e-01_JPRB, 1.43493e-01_JPRB, 1.46073e-01_JPRB, 1.48699e-01_JPRB, &
+     & 1.51373e-01_JPRB, 1.54094e-01_JPRB, 1.56865e-01_JPRB, 1.59685e-01_JPRB, 1.62556e-01_JPRB, &
+     & 1.65478e-01_JPRB, 1.68454e-01_JPRB, 1.71482e-01_JPRB, 1.74565e-01_JPRB, 1.77704e-01_JPRB, &
+     & 1.80899e-01_JPRB, 1.84151e-01_JPRB, 1.87462e-01_JPRB, 1.90833e-01_JPRB/)
+      kao_mn2o( 3, :,12) = (/ &
+     & 1.50741e-01_JPRB, 1.50855e-01_JPRB, 1.50969e-01_JPRB, 1.51084e-01_JPRB, 1.51198e-01_JPRB, &
+     & 1.51313e-01_JPRB, 1.51427e-01_JPRB, 1.51542e-01_JPRB, 1.51657e-01_JPRB, 1.51772e-01_JPRB, &
+     & 1.51887e-01_JPRB, 1.52002e-01_JPRB, 1.52117e-01_JPRB, 1.52233e-01_JPRB, 1.52348e-01_JPRB, &
+     & 1.52463e-01_JPRB, 1.52579e-01_JPRB, 1.52695e-01_JPRB, 1.52810e-01_JPRB/)
+      kao_mn2o( 4, :,12) = (/ &
+     & 1.80444e-01_JPRB, 1.79944e-01_JPRB, 1.79445e-01_JPRB, 1.78948e-01_JPRB, 1.78452e-01_JPRB, &
+     & 1.77958e-01_JPRB, 1.77465e-01_JPRB, 1.76973e-01_JPRB, 1.76483e-01_JPRB, 1.75994e-01_JPRB, &
+     & 1.75506e-01_JPRB, 1.75020e-01_JPRB, 1.74535e-01_JPRB, 1.74051e-01_JPRB, 1.73569e-01_JPRB, &
+     & 1.73088e-01_JPRB, 1.72609e-01_JPRB, 1.72131e-01_JPRB, 1.71654e-01_JPRB/)
+      kao_mn2o( 5, :,12) = (/ &
+     & 1.80595e-01_JPRB, 1.80033e-01_JPRB, 1.79474e-01_JPRB, 1.78916e-01_JPRB, 1.78359e-01_JPRB, &
+     & 1.77805e-01_JPRB, 1.77252e-01_JPRB, 1.76701e-01_JPRB, 1.76152e-01_JPRB, 1.75604e-01_JPRB, &
+     & 1.75058e-01_JPRB, 1.74514e-01_JPRB, 1.73971e-01_JPRB, 1.73430e-01_JPRB, 1.72891e-01_JPRB, &
+     & 1.72354e-01_JPRB, 1.71818e-01_JPRB, 1.71284e-01_JPRB, 1.70751e-01_JPRB/)
+      kao_mn2o( 6, :,12) = (/ &
+     & 1.79904e-01_JPRB, 1.79254e-01_JPRB, 1.78607e-01_JPRB, 1.77962e-01_JPRB, 1.77320e-01_JPRB, &
+     & 1.76680e-01_JPRB, 1.76042e-01_JPRB, 1.75406e-01_JPRB, 1.74773e-01_JPRB, 1.74142e-01_JPRB, &
+     & 1.73513e-01_JPRB, 1.72887e-01_JPRB, 1.72262e-01_JPRB, 1.71640e-01_JPRB, 1.71021e-01_JPRB, &
+     & 1.70403e-01_JPRB, 1.69788e-01_JPRB, 1.69175e-01_JPRB, 1.68564e-01_JPRB/)
+      kao_mn2o( 7, :,12) = (/ &
+     & 1.78712e-01_JPRB, 1.77868e-01_JPRB, 1.77027e-01_JPRB, 1.76190e-01_JPRB, 1.75357e-01_JPRB, &
+     & 1.74528e-01_JPRB, 1.73703e-01_JPRB, 1.72882e-01_JPRB, 1.72064e-01_JPRB, 1.71251e-01_JPRB, &
+     & 1.70441e-01_JPRB, 1.69636e-01_JPRB, 1.68834e-01_JPRB, 1.68036e-01_JPRB, 1.67241e-01_JPRB, &
+     & 1.66451e-01_JPRB, 1.65664e-01_JPRB, 1.64881e-01_JPRB, 1.64101e-01_JPRB/)
+      kao_mn2o( 8, :,12) = (/ &
+     & 1.72346e-01_JPRB, 1.70873e-01_JPRB, 1.69413e-01_JPRB, 1.67965e-01_JPRB, 1.66530e-01_JPRB, &
+     & 1.65107e-01_JPRB, 1.63696e-01_JPRB, 1.62297e-01_JPRB, 1.60910e-01_JPRB, 1.59535e-01_JPRB, &
+     & 1.58171e-01_JPRB, 1.56819e-01_JPRB, 1.55479e-01_JPRB, 1.54150e-01_JPRB, 1.52833e-01_JPRB, &
+     & 1.51527e-01_JPRB, 1.50232e-01_JPRB, 1.48948e-01_JPRB, 1.47675e-01_JPRB/)
+      kao_mn2o( 9, :,12) = (/ &
+     & 1.80517e-01_JPRB, 1.79951e-01_JPRB, 1.79386e-01_JPRB, 1.78823e-01_JPRB, 1.78262e-01_JPRB, &
+     & 1.77702e-01_JPRB, 1.77144e-01_JPRB, 1.76588e-01_JPRB, 1.76034e-01_JPRB, 1.75481e-01_JPRB, &
+     & 1.74931e-01_JPRB, 1.74382e-01_JPRB, 1.73834e-01_JPRB, 1.73289e-01_JPRB, 1.72745e-01_JPRB, &
+     & 1.72202e-01_JPRB, 1.71662e-01_JPRB, 1.71123e-01_JPRB, 1.70586e-01_JPRB/)
+      kao_mn2o( 1, :,13) = (/ &
+     & 2.41966e-01_JPRB, 2.50534e-01_JPRB, 2.59406e-01_JPRB, 2.68591e-01_JPRB, 2.78102e-01_JPRB, &
+     & 2.87950e-01_JPRB, 2.98146e-01_JPRB, 3.08704e-01_JPRB, 3.19635e-01_JPRB, 3.30953e-01_JPRB, &
+     & 3.42672e-01_JPRB, 3.54806e-01_JPRB, 3.67370e-01_JPRB, 3.80379e-01_JPRB, 3.93848e-01_JPRB, &
+     & 4.07794e-01_JPRB, 4.22234e-01_JPRB, 4.37186e-01_JPRB, 4.52667e-01_JPRB/)
+      kao_mn2o( 2, :,13) = (/ &
+     & 1.54385e-01_JPRB, 1.54015e-01_JPRB, 1.53646e-01_JPRB, 1.53279e-01_JPRB, 1.52912e-01_JPRB, &
+     & 1.52545e-01_JPRB, 1.52180e-01_JPRB, 1.51816e-01_JPRB, 1.51452e-01_JPRB, 1.51089e-01_JPRB, &
+     & 1.50728e-01_JPRB, 1.50367e-01_JPRB, 1.50007e-01_JPRB, 1.49647e-01_JPRB, 1.49289e-01_JPRB, &
+     & 1.48932e-01_JPRB, 1.48575e-01_JPRB, 1.48219e-01_JPRB, 1.47864e-01_JPRB/)
+      kao_mn2o( 3, :,13) = (/ &
+     & 2.00518e-01_JPRB, 1.94901e-01_JPRB, 1.89442e-01_JPRB, 1.84136e-01_JPRB, 1.78978e-01_JPRB, &
+     & 1.73965e-01_JPRB, 1.69092e-01_JPRB, 1.64356e-01_JPRB, 1.59752e-01_JPRB, 1.55278e-01_JPRB, &
+     & 1.50928e-01_JPRB, 1.46701e-01_JPRB, 1.42592e-01_JPRB, 1.38598e-01_JPRB, 1.34715e-01_JPRB, &
+     & 1.30942e-01_JPRB, 1.27274e-01_JPRB, 1.23709e-01_JPRB, 1.20244e-01_JPRB/)
+      kao_mn2o( 4, :,13) = (/ &
+     & 2.03974e-01_JPRB, 1.98258e-01_JPRB, 1.92703e-01_JPRB, 1.87302e-01_JPRB, 1.82054e-01_JPRB, &
+     & 1.76952e-01_JPRB, 1.71993e-01_JPRB, 1.67173e-01_JPRB, 1.62489e-01_JPRB, 1.57935e-01_JPRB, &
+     & 1.53509e-01_JPRB, 1.49207e-01_JPRB, 1.45026e-01_JPRB, 1.40962e-01_JPRB, 1.37012e-01_JPRB, &
+     & 1.33172e-01_JPRB, 1.29440e-01_JPRB, 1.25813e-01_JPRB, 1.22287e-01_JPRB/)
+      kao_mn2o( 5, :,13) = (/ &
+     & 2.09410e-01_JPRB, 2.03543e-01_JPRB, 1.97841e-01_JPRB, 1.92298e-01_JPRB, 1.86911e-01_JPRB, &
+     & 1.81674e-01_JPRB, 1.76585e-01_JPRB, 1.71637e-01_JPRB, 1.66829e-01_JPRB, 1.62155e-01_JPRB, &
+     & 1.57612e-01_JPRB, 1.53196e-01_JPRB, 1.48904e-01_JPRB, 1.44733e-01_JPRB, 1.40678e-01_JPRB, &
+     & 1.36736e-01_JPRB, 1.32906e-01_JPRB, 1.29182e-01_JPRB, 1.25563e-01_JPRB/)
+      kao_mn2o( 6, :,13) = (/ &
+     & 2.19808e-01_JPRB, 2.13643e-01_JPRB, 2.07651e-01_JPRB, 2.01827e-01_JPRB, 1.96166e-01_JPRB, &
+     & 1.90664e-01_JPRB, 1.85317e-01_JPRB, 1.80119e-01_JPRB, 1.75067e-01_JPRB, 1.70157e-01_JPRB, &
+     & 1.65385e-01_JPRB, 1.60746e-01_JPRB, 1.56238e-01_JPRB, 1.51856e-01_JPRB, 1.47596e-01_JPRB, &
+     & 1.43457e-01_JPRB, 1.39433e-01_JPRB, 1.35523e-01_JPRB, 1.31722e-01_JPRB/)
+      kao_mn2o( 7, :,13) = (/ &
+     & 2.47074e-01_JPRB, 2.40127e-01_JPRB, 2.33375e-01_JPRB, 2.26813e-01_JPRB, 2.20436e-01_JPRB, &
+     & 2.14238e-01_JPRB, 2.08215e-01_JPRB, 2.02360e-01_JPRB, 1.96671e-01_JPRB, 1.91141e-01_JPRB, &
+     & 1.85767e-01_JPRB, 1.80544e-01_JPRB, 1.75467e-01_JPRB, 1.70534e-01_JPRB, 1.65739e-01_JPRB, &
+     & 1.61079e-01_JPRB, 1.56550e-01_JPRB, 1.52148e-01_JPRB, 1.47870e-01_JPRB/)
+      kao_mn2o( 8, :,13) = (/ &
+     & 2.55282e-01_JPRB, 2.48105e-01_JPRB, 2.41130e-01_JPRB, 2.34350e-01_JPRB, 2.27762e-01_JPRB, &
+     & 2.21358e-01_JPRB, 2.15135e-01_JPRB, 2.09086e-01_JPRB, 2.03208e-01_JPRB, 1.97495e-01_JPRB, &
+     & 1.91942e-01_JPRB, 1.86546e-01_JPRB, 1.81301e-01_JPRB, 1.76204e-01_JPRB, 1.71250e-01_JPRB, &
+     & 1.66435e-01_JPRB, 1.61756e-01_JPRB, 1.57208e-01_JPRB, 1.52788e-01_JPRB/)
+      kao_mn2o( 9, :,13) = (/ &
+     & 2.09991e-01_JPRB, 2.04103e-01_JPRB, 1.98380e-01_JPRB, 1.92818e-01_JPRB, 1.87411e-01_JPRB, &
+     & 1.82156e-01_JPRB, 1.77048e-01_JPRB, 1.72084e-01_JPRB, 1.67259e-01_JPRB, 1.62569e-01_JPRB, &
+     & 1.58010e-01_JPRB, 1.53580e-01_JPRB, 1.49273e-01_JPRB, 1.45087e-01_JPRB, 1.41019e-01_JPRB, &
+     & 1.37065e-01_JPRB, 1.33222e-01_JPRB, 1.29486e-01_JPRB, 1.25855e-01_JPRB/)
+      kao_mn2o( 1, :,14) = (/ &
+     & 9.08340e-02_JPRB, 9.50421e-02_JPRB, 9.94452e-02_JPRB, 1.04052e-01_JPRB, 1.08873e-01_JPRB, &
+     & 1.13917e-01_JPRB, 1.19194e-01_JPRB, 1.24716e-01_JPRB, 1.30494e-01_JPRB, 1.36540e-01_JPRB, &
+     & 1.42865e-01_JPRB, 1.49484e-01_JPRB, 1.56409e-01_JPRB, 1.63655e-01_JPRB, 1.71237e-01_JPRB, &
+     & 1.79170e-01_JPRB, 1.87471e-01_JPRB, 1.96156e-01_JPRB, 2.05243e-01_JPRB/)
+      kao_mn2o( 2, :,14) = (/ &
+     & 3.36945e-02_JPRB, 3.45144e-02_JPRB, 3.53542e-02_JPRB, 3.62144e-02_JPRB, 3.70956e-02_JPRB, &
+     & 3.79982e-02_JPRB, 3.89228e-02_JPRB, 3.98698e-02_JPRB, 4.08399e-02_JPRB, 4.18336e-02_JPRB, &
+     & 4.28515e-02_JPRB, 4.38942e-02_JPRB, 4.49622e-02_JPRB, 4.60562e-02_JPRB, 4.71769e-02_JPRB, &
+     & 4.83248e-02_JPRB, 4.95006e-02_JPRB, 5.07051e-02_JPRB, 5.19388e-02_JPRB/)
+      kao_mn2o( 3, :,14) = (/ &
+     & 9.11678e-02_JPRB, 8.85761e-02_JPRB, 8.60580e-02_JPRB, 8.36116e-02_JPRB, 8.12347e-02_JPRB, &
+     & 7.89253e-02_JPRB, 7.66817e-02_JPRB, 7.45017e-02_JPRB, 7.23838e-02_JPRB, 7.03261e-02_JPRB, &
+     & 6.83269e-02_JPRB, 6.63845e-02_JPRB, 6.44973e-02_JPRB, 6.26638e-02_JPRB, 6.08824e-02_JPRB, &
+     & 5.91516e-02_JPRB, 5.74700e-02_JPRB, 5.58363e-02_JPRB, 5.42490e-02_JPRB/)
+      kao_mn2o( 4, :,14) = (/ &
+     & 8.43999e-02_JPRB, 8.20004e-02_JPRB, 7.96692e-02_JPRB, 7.74042e-02_JPRB, 7.52037e-02_JPRB, &
+     & 7.30656e-02_JPRB, 7.09884e-02_JPRB, 6.89702e-02_JPRB, 6.70094e-02_JPRB, 6.51044e-02_JPRB, &
+     & 6.32535e-02_JPRB, 6.14552e-02_JPRB, 5.97081e-02_JPRB, 5.80106e-02_JPRB, 5.63614e-02_JPRB, &
+     & 5.47590e-02_JPRB, 5.32022e-02_JPRB, 5.16897e-02_JPRB, 5.02202e-02_JPRB/)
+      kao_mn2o( 5, :,14) = (/ &
+     & 7.41279e-02_JPRB, 7.20196e-02_JPRB, 6.99712e-02_JPRB, 6.79811e-02_JPRB, 6.60476e-02_JPRB, &
+     & 6.41691e-02_JPRB, 6.23440e-02_JPRB, 6.05708e-02_JPRB, 5.88481e-02_JPRB, 5.71743e-02_JPRB, &
+     & 5.55482e-02_JPRB, 5.39683e-02_JPRB, 5.24334e-02_JPRB, 5.09421e-02_JPRB, 4.94932e-02_JPRB, &
+     & 4.80855e-02_JPRB, 4.67179e-02_JPRB, 4.53891e-02_JPRB, 4.40982e-02_JPRB/)
+      kao_mn2o( 6, :,14) = (/ &
+     & 5.66805e-02_JPRB, 5.50676e-02_JPRB, 5.35006e-02_JPRB, 5.19782e-02_JPRB, 5.04991e-02_JPRB, &
+     & 4.90621e-02_JPRB, 4.76659e-02_JPRB, 4.63096e-02_JPRB, 4.49918e-02_JPRB, 4.37115e-02_JPRB, &
+     & 4.24676e-02_JPRB, 4.12592e-02_JPRB, 4.00851e-02_JPRB, 3.89444e-02_JPRB, 3.78362e-02_JPRB, &
+     & 3.67595e-02_JPRB, 3.57135e-02_JPRB, 3.46972e-02_JPRB, 3.37099e-02_JPRB/)
+      kao_mn2o( 7, :,14) = (/ &
+     & 1.23018e-02_JPRB, 1.19517e-02_JPRB, 1.16116e-02_JPRB, 1.12811e-02_JPRB, 1.09601e-02_JPRB, &
+     & 1.06482e-02_JPRB, 1.03452e-02_JPRB, 1.00508e-02_JPRB, 9.76474e-03_JPRB, 9.48685e-03_JPRB, &
+     & 9.21687e-03_JPRB, 8.95458e-03_JPRB, 8.69974e-03_JPRB, 8.45216e-03_JPRB, 8.21163e-03_JPRB, &
+     & 7.97794e-03_JPRB, 7.75091e-03_JPRB, 7.53033e-03_JPRB, 7.31603e-03_JPRB/)
+      kao_mn2o( 8, :,14) = (/ &
+     & 3.22403e-07_JPRB, 3.75986e-07_JPRB, 4.38475e-07_JPRB, 5.11349e-07_JPRB, 5.96335e-07_JPRB, &
+     & 6.95446e-07_JPRB, 8.11028e-07_JPRB, 9.45821e-07_JPRB, 1.10302e-06_JPRB, 1.28634e-06_JPRB, &
+     & 1.50012e-06_JPRB, 1.74944e-06_JPRB, 2.04020e-06_JPRB, 2.37928e-06_JPRB, 2.77472e-06_JPRB, &
+     & 3.23587e-06_JPRB, 3.77367e-06_JPRB, 4.40085e-06_JPRB, 5.13227e-06_JPRB/)
+      kao_mn2o( 9, :,14) = (/ &
+     & 7.33052e-02_JPRB, 7.12199e-02_JPRB, 6.91939e-02_JPRB, 6.72255e-02_JPRB, 6.53131e-02_JPRB, &
+     & 6.34551e-02_JPRB, 6.16500e-02_JPRB, 5.98963e-02_JPRB, 5.81924e-02_JPRB, 5.65370e-02_JPRB, &
+     & 5.49287e-02_JPRB, 5.33661e-02_JPRB, 5.18480e-02_JPRB, 5.03730e-02_JPRB, 4.89401e-02_JPRB, &
+     & 4.75479e-02_JPRB, 4.61953e-02_JPRB, 4.48811e-02_JPRB, 4.36044e-02_JPRB/)
+      kao_mn2o( 1, :,15) = (/ &
+     & 8.80247e-02_JPRB, 9.01793e-02_JPRB, 9.23868e-02_JPRB, 9.46482e-02_JPRB, 9.69650e-02_JPRB, &
+     & 9.93385e-02_JPRB, 1.01770e-01_JPRB, 1.04261e-01_JPRB, 1.06813e-01_JPRB, 1.09428e-01_JPRB, &
+     & 1.12107e-01_JPRB, 1.14851e-01_JPRB, 1.17662e-01_JPRB, 1.20542e-01_JPRB, 1.23493e-01_JPRB, &
+     & 1.26516e-01_JPRB, 1.29613e-01_JPRB, 1.32785e-01_JPRB, 1.36036e-01_JPRB/)
+      kao_mn2o( 2, :,15) = (/ &
+     & 3.89107e-07_JPRB, 4.53768e-07_JPRB, 5.29173e-07_JPRB, 6.17109e-07_JPRB, 7.19658e-07_JPRB, &
+     & 8.39248e-07_JPRB, 9.78710e-07_JPRB, 1.14135e-06_JPRB, 1.33101e-06_JPRB, 1.55220e-06_JPRB, &
+     & 1.81013e-06_JPRB, 2.11094e-06_JPRB, 2.46172e-06_JPRB, 2.87080e-06_JPRB, 3.34786e-06_JPRB, &
+     & 3.90420e-06_JPRB, 4.55298e-06_JPRB, 5.30958e-06_JPRB, 6.19190e-06_JPRB/)
+      kao_mn2o( 3, :,15) = (/ &
+     & 3.86537e-07_JPRB, 4.50763e-07_JPRB, 5.25662e-07_JPRB, 6.13006e-07_JPRB, 7.14863e-07_JPRB, &
+     & 8.33644e-07_JPRB, 9.72162e-07_JPRB, 1.13370e-06_JPRB, 1.32207e-06_JPRB, 1.54175e-06_JPRB, &
+     & 1.79792e-06_JPRB, 2.09666e-06_JPRB, 2.44504e-06_JPRB, 2.85131e-06_JPRB, 3.32508e-06_JPRB, &
+     & 3.87758e-06_JPRB, 4.52188e-06_JPRB, 5.27323e-06_JPRB, 6.14943e-06_JPRB/)
+      kao_mn2o( 4, :,15) = (/ &
+     & 3.81913e-07_JPRB, 4.45369e-07_JPRB, 5.19369e-07_JPRB, 6.05664e-07_JPRB, 7.06297e-07_JPRB, &
+     & 8.23651e-07_JPRB, 9.60503e-07_JPRB, 1.12009e-06_JPRB, 1.30620e-06_JPRB, 1.52323e-06_JPRB, &
+     & 1.77632e-06_JPRB, 2.07147e-06_JPRB, 2.41565e-06_JPRB, 2.81701e-06_JPRB, 3.28507e-06_JPRB, &
+     & 3.83090e-06_JPRB, 4.46741e-06_JPRB, 5.20969e-06_JPRB, 6.07529e-06_JPRB/)
+      kao_mn2o( 5, :,15) = (/ &
+     & 3.77265e-07_JPRB, 4.39951e-07_JPRB, 5.13053e-07_JPRB, 5.98303e-07_JPRB, 6.97717e-07_JPRB, &
+     & 8.13650e-07_JPRB, 9.48846e-07_JPRB, 1.10651e-06_JPRB, 1.29036e-06_JPRB, 1.50477e-06_JPRB, &
+     & 1.75480e-06_JPRB, 2.04638e-06_JPRB, 2.38641e-06_JPRB, 2.78294e-06_JPRB, 3.24535e-06_JPRB, &
+     & 3.78460e-06_JPRB, 4.41345e-06_JPRB, 5.14679e-06_JPRB, 6.00198e-06_JPRB/)
+      kao_mn2o( 6, :,15) = (/ &
+     & 3.77877e-07_JPRB, 4.40670e-07_JPRB, 5.13897e-07_JPRB, 5.99292e-07_JPRB, 6.98878e-07_JPRB, &
+     & 8.15012e-07_JPRB, 9.50444e-07_JPRB, 1.10838e-06_JPRB, 1.29256e-06_JPRB, 1.50735e-06_JPRB, &
+     & 1.75783e-06_JPRB, 2.04993e-06_JPRB, 2.39057e-06_JPRB, 2.78782e-06_JPRB, 3.25107e-06_JPRB, &
+     & 3.79131e-06_JPRB, 4.42132e-06_JPRB, 5.15602e-06_JPRB, 6.01280e-06_JPRB/)
+      kao_mn2o( 7, :,15) = (/ &
+     & 3.80495e-07_JPRB, 4.43726e-07_JPRB, 5.17465e-07_JPRB, 6.03458e-07_JPRB, 7.03741e-07_JPRB, &
+     & 8.20689e-07_JPRB, 9.57072e-07_JPRB, 1.11612e-06_JPRB, 1.30160e-06_JPRB, 1.51790e-06_JPRB, &
+     & 1.77014e-06_JPRB, 2.06430e-06_JPRB, 2.40735e-06_JPRB, 2.80741e-06_JPRB, 3.27394e-06_JPRB, &
+     & 3.81801e-06_JPRB, 4.45249e-06_JPRB, 5.19241e-06_JPRB, 6.05528e-06_JPRB/)
+      kao_mn2o( 8, :,15) = (/ &
+     & 3.87881e-07_JPRB, 4.52329e-07_JPRB, 5.27486e-07_JPRB, 6.15129e-07_JPRB, 7.17335e-07_JPRB, &
+     & 8.36523e-07_JPRB, 9.75515e-07_JPRB, 1.13760e-06_JPRB, 1.32662e-06_JPRB, 1.54704e-06_JPRB, &
+     & 1.80409e-06_JPRB, 2.10384e-06_JPRB, 2.45340e-06_JPRB, 2.86105e-06_JPRB, 3.33642e-06_JPRB, &
+     & 3.89078e-06_JPRB, 4.53725e-06_JPRB, 5.29112e-06_JPRB, 6.17026e-06_JPRB/)
+      kao_mn2o( 9, :,15) = (/ &
+     & 3.77265e-07_JPRB, 4.39951e-07_JPRB, 5.13053e-07_JPRB, 5.98303e-07_JPRB, 6.97717e-07_JPRB, &
+     & 8.13650e-07_JPRB, 9.48846e-07_JPRB, 1.10651e-06_JPRB, 1.29036e-06_JPRB, 1.50477e-06_JPRB, &
+     & 1.75480e-06_JPRB, 2.04638e-06_JPRB, 2.38641e-06_JPRB, 2.78294e-06_JPRB, 3.24535e-06_JPRB, &
+     & 3.78460e-06_JPRB, 4.41345e-06_JPRB, 5.14679e-06_JPRB, 6.00198e-06_JPRB/)
+      kao_mn2o( 1, :,16) = (/ &
+     & 8.84606e-02_JPRB, 9.05971e-02_JPRB, 9.27852e-02_JPRB, 9.50261e-02_JPRB, 9.73212e-02_JPRB, &
+     & 9.96717e-02_JPRB, 1.02079e-01_JPRB, 1.04544e-01_JPRB, 1.07069e-01_JPRB, 1.09655e-01_JPRB, &
+     & 1.12304e-01_JPRB, 1.15016e-01_JPRB, 1.17794e-01_JPRB, 1.20639e-01_JPRB, 1.23553e-01_JPRB, &
+     & 1.26537e-01_JPRB, 1.29593e-01_JPRB, 1.32723e-01_JPRB, 1.35928e-01_JPRB/)
+      kao_mn2o( 2, :,16) = (/ &
+     & 8.13898e-07_JPRB, 9.49130e-07_JPRB, 1.10683e-06_JPRB, 1.29073e-06_JPRB, 1.50519e-06_JPRB, &
+     & 1.75528e-06_JPRB, 2.04693e-06_JPRB, 2.38703e-06_JPRB, 2.78364e-06_JPRB, 3.24615e-06_JPRB, &
+     & 3.78551e-06_JPRB, 4.41449e-06_JPRB, 5.14796e-06_JPRB, 6.00331e-06_JPRB, 7.00078e-06_JPRB, &
+     & 8.16398e-06_JPRB, 9.52045e-06_JPRB, 1.11023e-05_JPRB, 1.29470e-05_JPRB/)
+      kao_mn2o( 3, :,16) = (/ &
+     & 8.32666e-07_JPRB, 9.71021e-07_JPRB, 1.13237e-06_JPRB, 1.32052e-06_JPRB, 1.53994e-06_JPRB, &
+     & 1.79581e-06_JPRB, 2.09420e-06_JPRB, 2.44217e-06_JPRB, 2.84796e-06_JPRB, 3.32117e-06_JPRB, &
+     & 3.87302e-06_JPRB, 4.51656e-06_JPRB, 5.26703e-06_JPRB, 6.14219e-06_JPRB, 7.16277e-06_JPRB, &
+     & 8.35294e-06_JPRB, 9.74086e-06_JPRB, 1.13594e-05_JPRB, 1.32468e-05_JPRB/)
+      kao_mn2o( 4, :,16) = (/ &
+     & 8.70348e-07_JPRB, 1.01496e-06_JPRB, 1.18360e-06_JPRB, 1.38026e-06_JPRB, 1.60959e-06_JPRB, &
+     & 1.87703e-06_JPRB, 2.18890e-06_JPRB, 2.55259e-06_JPRB, 2.97671e-06_JPRB, 3.47130e-06_JPRB, &
+     & 4.04807e-06_JPRB, 4.72067e-06_JPRB, 5.50502e-06_JPRB, 6.41970e-06_JPRB, 7.48635e-06_JPRB, &
+     & 8.73023e-06_JPRB, 1.01808e-05_JPRB, 1.18724e-05_JPRB, 1.38450e-05_JPRB/)
+      kao_mn2o( 5, :,16) = (/ &
+     & 9.07957e-07_JPRB, 1.05882e-06_JPRB, 1.23475e-06_JPRB, 1.43991e-06_JPRB, 1.67916e-06_JPRB, &
+     & 1.95816e-06_JPRB, 2.28352e-06_JPRB, 2.66294e-06_JPRB, 3.10541e-06_JPRB, 3.62139e-06_JPRB, &
+     & 4.22310e-06_JPRB, 4.92480e-06_JPRB, 5.74308e-06_JPRB, 6.69733e-06_JPRB, 7.81013e-06_JPRB, &
+     & 9.10784e-06_JPRB, 1.06212e-05_JPRB, 1.23859e-05_JPRB, 1.44439e-05_JPRB/)
+      kao_mn2o( 6, :,16) = (/ &
+     & 8.59072e-04_JPRB, 9.19773e-04_JPRB, 9.84764e-04_JPRB, 1.05435e-03_JPRB, 1.12885e-03_JPRB, &
+     & 1.20861e-03_JPRB, 1.29401e-03_JPRB, 1.38544e-03_JPRB, 1.48334e-03_JPRB, 1.58815e-03_JPRB, &
+     & 1.70037e-03_JPRB, 1.82052e-03_JPRB, 1.94915e-03_JPRB, 2.08688e-03_JPRB, 2.23434e-03_JPRB, &
+     & 2.39222e-03_JPRB, 2.56125e-03_JPRB, 2.74223e-03_JPRB, 2.93599e-03_JPRB/)
+      kao_mn2o( 7, :,16) = (/ &
+     & 9.17294e-07_JPRB, 1.06971e-06_JPRB, 1.24746e-06_JPRB, 1.45474e-06_JPRB, 1.69646e-06_JPRB, &
+     & 1.97835e-06_JPRB, 2.30708e-06_JPRB, 2.69043e-06_JPRB, 3.13748e-06_JPRB, 3.65880e-06_JPRB, &
+     & 4.26676e-06_JPRB, 4.97574e-06_JPRB, 5.80251e-06_JPRB, 6.76667e-06_JPRB, 7.89104e-06_JPRB, &
+     & 9.20223e-06_JPRB, 1.07313e-05_JPRB, 1.25144e-05_JPRB, 1.45939e-05_JPRB/)
+      kao_mn2o( 8, :,16) = (/ &
+     & 9.17341e-07_JPRB, 1.06977e-06_JPRB, 1.24752e-06_JPRB, 1.45480e-06_JPRB, 1.69653e-06_JPRB, &
+     & 1.97843e-06_JPRB, 2.30716e-06_JPRB, 2.69051e-06_JPRB, 3.13757e-06_JPRB, 3.65890e-06_JPRB, &
+     & 4.26686e-06_JPRB, 4.97584e-06_JPRB, 5.80261e-06_JPRB, 6.76677e-06_JPRB, 7.89113e-06_JPRB, &
+     & 9.20231e-06_JPRB, 1.07314e-05_JPRB, 1.25145e-05_JPRB, 1.45939e-05_JPRB/)
+      kao_mn2o( 9, :,16) = (/ &
+     & 9.07957e-07_JPRB, 1.05882e-06_JPRB, 1.23475e-06_JPRB, 1.43991e-06_JPRB, 1.67916e-06_JPRB, &
+     & 1.95816e-06_JPRB, 2.28352e-06_JPRB, 2.66294e-06_JPRB, 3.10541e-06_JPRB, 3.62139e-06_JPRB, &
+     & 4.22310e-06_JPRB, 4.92480e-06_JPRB, 5.74308e-06_JPRB, 6.69733e-06_JPRB, 7.81013e-06_JPRB, &
+     & 9.10784e-06_JPRB, 1.06212e-05_JPRB, 1.23859e-05_JPRB, 1.44439e-05_JPRB/)
+
+!     The array KBO_Mxx contains the absorption coefficient for 
+!     a minor species at the 16 chosen g-values for a reference pressure
+!     level above 100~ mb.   The first index in the array, JS, runs
+!     from 1 to 10, and corresponds to different gas column amounts ratios,
+!     as expressed through the binary species parameter eta, defined as
+!     eta = gas1/(gas1 + (rat) * gas2), where rat is the 
+!     ratio of the reference MLS column amount value of gas 1 to 
+!     that of gas2.  The second index refers to temperature 
+!     in 7.2 degree increments.  For instance, JT = 1 refers to a 
+!     temperature of 188.0, JT = 2 refers to 195.2, etc. The third index 
+!     runs over the g-channel (1 to 16).
+
+      kbo_mn2o( 1, :, 1) = (/ &
+     & 7.72009e-08_JPRB, 1.15883e-07_JPRB, 1.73947e-07_JPRB, 2.61104e-07_JPRB, 3.91932e-07_JPRB, &
+     & 5.88311e-07_JPRB, 8.83088e-07_JPRB, 1.32556e-06_JPRB, 1.98975e-06_JPRB, 2.98672e-06_JPRB, &
+     & 4.48324e-06_JPRB, 6.72960e-06_JPRB, 1.01015e-05_JPRB, 1.51629e-05_JPRB, 2.27604e-05_JPRB, &
+     & 3.41646e-05_JPRB, 5.12831e-05_JPRB, 7.69787e-05_JPRB, 1.15549e-04_JPRB/)
+      kbo_mn2o( 2, :, 1) = (/ &
+     & 1.29932e-05_JPRB, 1.78207e-05_JPRB, 2.44419e-05_JPRB, 3.35232e-05_JPRB, 4.59786e-05_JPRB, &
+     & 6.30617e-05_JPRB, 8.64920e-05_JPRB, 1.18628e-04_JPRB, 1.62703e-04_JPRB, 2.23155e-04_JPRB, &
+     & 3.06067e-04_JPRB, 4.19784e-04_JPRB, 5.75753e-04_JPRB, 7.89671e-04_JPRB, 1.08307e-03_JPRB, &
+     & 1.48548e-03_JPRB, 2.03740e-03_JPRB, 2.79439e-03_JPRB, 3.83262e-03_JPRB/)
+      kbo_mn2o( 3, :, 1) = (/ &
+     & 6.44518e-05_JPRB, 8.10996e-05_JPRB, 1.02047e-04_JPRB, 1.28406e-04_JPRB, 1.61573e-04_JPRB, &
+     & 2.03307e-04_JPRB, 2.55821e-04_JPRB, 3.21899e-04_JPRB, 4.05045e-04_JPRB, 5.09667e-04_JPRB, &
+     & 6.41313e-04_JPRB, 8.06964e-04_JPRB, 1.01540e-03_JPRB, 1.27768e-03_JPRB, 1.60770e-03_JPRB, &
+     & 2.02296e-03_JPRB, 2.54549e-03_JPRB, 3.20298e-03_JPRB, 4.03031e-03_JPRB/)
+      kbo_mn2o( 4, :, 1) = (/ &
+     & 3.23454e-04_JPRB, 3.82112e-04_JPRB, 4.51408e-04_JPRB, 5.33270e-04_JPRB, 6.29978e-04_JPRB, &
+     & 7.44223e-04_JPRB, 8.79187e-04_JPRB, 1.03863e-03_JPRB, 1.22698e-03_JPRB, 1.44949e-03_JPRB, &
+     & 1.71235e-03_JPRB, 2.02289e-03_JPRB, 2.38974e-03_JPRB, 2.82311e-03_JPRB, 3.33508e-03_JPRB, &
+     & 3.93989e-03_JPRB, 4.65439e-03_JPRB, 5.49845e-03_JPRB, 6.49558e-03_JPRB/)
+      kbo_mn2o( 5, :, 1) = (/ &
+     & 1.45978e-04_JPRB, 1.75646e-04_JPRB, 2.11344e-04_JPRB, 2.54296e-04_JPRB, 3.05978e-04_JPRB, &
+     & 3.68163e-04_JPRB, 4.42986e-04_JPRB, 5.33017e-04_JPRB, 6.41344e-04_JPRB, 7.71687e-04_JPRB, &
+     & 9.28522e-04_JPRB, 1.11723e-03_JPRB, 1.34429e-03_JPRB, 1.61750e-03_JPRB, 1.94623e-03_JPRB, &
+     & 2.34177e-03_JPRB, 2.81770e-03_JPRB, 3.39035e-03_JPRB, 4.07939e-03_JPRB/)
+      kbo_mn2o( 1, :, 2) = (/ &
+     & 1.94527e-04_JPRB, 2.38609e-04_JPRB, 2.92680e-04_JPRB, 3.59005e-04_JPRB, 4.40360e-04_JPRB, &
+     & 5.40150e-04_JPRB, 6.62554e-04_JPRB, 8.12697e-04_JPRB, 9.96864e-04_JPRB, 1.22276e-03_JPRB, &
+     & 1.49986e-03_JPRB, 1.83974e-03_JPRB, 2.25665e-03_JPRB, 2.76803e-03_JPRB, 3.39530e-03_JPRB, &
+     & 4.16472e-03_JPRB, 5.10849e-03_JPRB, 6.26613e-03_JPRB, 7.68611e-03_JPRB/)
+      kbo_mn2o( 2, :, 2) = (/ &
+     & 7.49615e-04_JPRB, 8.82716e-04_JPRB, 1.03945e-03_JPRB, 1.22401e-03_JPRB, 1.44135e-03_JPRB, &
+     & 1.69727e-03_JPRB, 1.99863e-03_JPRB, 2.35351e-03_JPRB, 2.77139e-03_JPRB, 3.26347e-03_JPRB, &
+     & 3.84293e-03_JPRB, 4.52528e-03_JPRB, 5.32878e-03_JPRB, 6.27495e-03_JPRB, 7.38911e-03_JPRB, &
+     & 8.70111e-03_JPRB, 1.02461e-02_JPRB, 1.20653e-02_JPRB, 1.42076e-02_JPRB/)
+      kbo_mn2o( 3, :, 2) = (/ &
+     & 1.39162e-03_JPRB, 1.59859e-03_JPRB, 1.83634e-03_JPRB, 2.10946e-03_JPRB, 2.42319e-03_JPRB, &
+     & 2.78358e-03_JPRB, 3.19758e-03_JPRB, 3.67314e-03_JPRB, 4.21944e-03_JPRB, 4.84698e-03_JPRB, &
+     & 5.56786e-03_JPRB, 6.39595e-03_JPRB, 7.34720e-03_JPRB, 8.43992e-03_JPRB, 9.69516e-03_JPRB, &
+     & 1.11371e-02_JPRB, 1.27935e-02_JPRB, 1.46962e-02_JPRB, 1.68819e-02_JPRB/)
+      kbo_mn2o( 4, :, 2) = (/ &
+     & 2.42354e-03_JPRB, 2.73623e-03_JPRB, 3.08926e-03_JPRB, 3.48783e-03_JPRB, 3.93783e-03_JPRB, &
+     & 4.44589e-03_JPRB, 5.01950e-03_JPRB, 5.66712e-03_JPRB, 6.39829e-03_JPRB, 7.22379e-03_JPRB, &
+     & 8.15581e-03_JPRB, 9.20807e-03_JPRB, 1.03961e-02_JPRB, 1.17374e-02_JPRB, 1.32517e-02_JPRB, &
+     & 1.49615e-02_JPRB, 1.68918e-02_JPRB, 1.90712e-02_JPRB, 2.15318e-02_JPRB/)
+      kbo_mn2o( 5, :, 2) = (/ &
+     & 1.39908e-03_JPRB, 1.59133e-03_JPRB, 1.81000e-03_JPRB, 2.05872e-03_JPRB, 2.34161e-03_JPRB, &
+     & 2.66338e-03_JPRB, 3.02937e-03_JPRB, 3.44564e-03_JPRB, 3.91912e-03_JPRB, 4.45766e-03_JPRB, &
+     & 5.07021e-03_JPRB, 5.76693e-03_JPRB, 6.55938e-03_JPRB, 7.46073e-03_JPRB, 8.48594e-03_JPRB, &
+     & 9.65202e-03_JPRB, 1.09783e-02_JPRB, 1.24869e-02_JPRB, 1.42028e-02_JPRB/)
+      kbo_mn2o( 1, :, 3) = (/ &
+     & 8.74797e-03_JPRB, 9.66828e-03_JPRB, 1.06854e-02_JPRB, 1.18095e-02_JPRB, 1.30519e-02_JPRB, &
+     & 1.44250e-02_JPRB, 1.59426e-02_JPRB, 1.76198e-02_JPRB, 1.94735e-02_JPRB, 2.15221e-02_JPRB, &
+     & 2.37863e-02_JPRB, 2.62887e-02_JPRB, 2.90544e-02_JPRB, 3.21110e-02_JPRB, 3.54891e-02_JPRB, &
+     & 3.92227e-02_JPRB, 4.33491e-02_JPRB, 4.79095e-02_JPRB, 5.29497e-02_JPRB/)
+      kbo_mn2o( 2, :, 3) = (/ &
+     & 1.43974e-02_JPRB, 1.56118e-02_JPRB, 1.69286e-02_JPRB, 1.83564e-02_JPRB, 1.99047e-02_JPRB, &
+     & 2.15836e-02_JPRB, 2.34041e-02_JPRB, 2.53781e-02_JPRB, 2.75187e-02_JPRB, 2.98397e-02_JPRB, &
+     & 3.23566e-02_JPRB, 3.50857e-02_JPRB, 3.80451e-02_JPRB, 4.12540e-02_JPRB, 4.47336e-02_JPRB, &
+     & 4.85067e-02_JPRB, 5.25980e-02_JPRB, 5.70344e-02_JPRB, 6.18450e-02_JPRB/)
+      kbo_mn2o( 3, :, 3) = (/ &
+     & 1.83051e-02_JPRB, 1.96851e-02_JPRB, 2.11692e-02_JPRB, 2.27651e-02_JPRB, 2.44813e-02_JPRB, &
+     & 2.63270e-02_JPRB, 2.83117e-02_JPRB, 3.04461e-02_JPRB, 3.27414e-02_JPRB, 3.52097e-02_JPRB, &
+     & 3.78642e-02_JPRB, 4.07187e-02_JPRB, 4.37884e-02_JPRB, 4.70896e-02_JPRB, 5.06396e-02_JPRB, &
+     & 5.44573e-02_JPRB, 5.85628e-02_JPRB, 6.29777e-02_JPRB, 6.77256e-02_JPRB/)
+      kbo_mn2o( 4, :, 3) = (/ &
+     & 2.81258e-02_JPRB, 2.97806e-02_JPRB, 3.15328e-02_JPRB, 3.33880e-02_JPRB, 3.53524e-02_JPRB, &
+     & 3.74324e-02_JPRB, 3.96348e-02_JPRB, 4.19667e-02_JPRB, 4.44358e-02_JPRB, 4.70502e-02_JPRB, &
+     & 4.98185e-02_JPRB, 5.27496e-02_JPRB, 5.58531e-02_JPRB, 5.91393e-02_JPRB, 6.26187e-02_JPRB, &
+     & 6.63030e-02_JPRB, 7.02039e-02_JPRB, 7.43344e-02_JPRB, 7.87079e-02_JPRB/)
+      kbo_mn2o( 5, :, 3) = (/ &
+     & 8.82958e-03_JPRB, 9.53842e-03_JPRB, 1.03042e-02_JPRB, 1.11314e-02_JPRB, 1.20250e-02_JPRB, &
+     & 1.29904e-02_JPRB, 1.40333e-02_JPRB, 1.51599e-02_JPRB, 1.63769e-02_JPRB, 1.76917e-02_JPRB, &
+     & 1.91120e-02_JPRB, 2.06463e-02_JPRB, 2.23038e-02_JPRB, 2.40944e-02_JPRB, 2.60287e-02_JPRB, &
+     & 2.81183e-02_JPRB, 3.03757e-02_JPRB, 3.28142e-02_JPRB, 3.54486e-02_JPRB/)
+      kbo_mn2o( 1, :, 4) = (/ &
+     & 1.18673e-01_JPRB, 1.22983e-01_JPRB, 1.27449e-01_JPRB, 1.32077e-01_JPRB, 1.36874e-01_JPRB, &
+     & 1.41845e-01_JPRB, 1.46996e-01_JPRB, 1.52334e-01_JPRB, 1.57866e-01_JPRB, 1.63599e-01_JPRB, &
+     & 1.69541e-01_JPRB, 1.75698e-01_JPRB, 1.82078e-01_JPRB, 1.88691e-01_JPRB, 1.95543e-01_JPRB, &
+     & 2.02645e-01_JPRB, 2.10004e-01_JPRB, 2.17631e-01_JPRB, 2.25534e-01_JPRB/)
+      kbo_mn2o( 2, :, 4) = (/ &
+     & 1.32161e-01_JPRB, 1.36550e-01_JPRB, 1.41084e-01_JPRB, 1.45769e-01_JPRB, 1.50610e-01_JPRB, &
+     & 1.55611e-01_JPRB, 1.60779e-01_JPRB, 1.66118e-01_JPRB, 1.71634e-01_JPRB, 1.77334e-01_JPRB, &
+     & 1.83223e-01_JPRB, 1.89307e-01_JPRB, 1.95594e-01_JPRB, 2.02089e-01_JPRB, 2.08800e-01_JPRB, &
+     & 2.15734e-01_JPRB, 2.22898e-01_JPRB, 2.30300e-01_JPRB, 2.37947e-01_JPRB/)
+      kbo_mn2o( 3, :, 4) = (/ &
+     & 1.44384e-01_JPRB, 1.48820e-01_JPRB, 1.53392e-01_JPRB, 1.58104e-01_JPRB, 1.62962e-01_JPRB, &
+     & 1.67968e-01_JPRB, 1.73128e-01_JPRB, 1.78447e-01_JPRB, 1.83929e-01_JPRB, 1.89580e-01_JPRB, &
+     & 1.95404e-01_JPRB, 2.01407e-01_JPRB, 2.07594e-01_JPRB, 2.13972e-01_JPRB, 2.20546e-01_JPRB, &
+     & 2.27321e-01_JPRB, 2.34305e-01_JPRB, 2.41503e-01_JPRB, 2.48922e-01_JPRB/)
+      kbo_mn2o( 4, :, 4) = (/ &
+     & 1.58026e-01_JPRB, 1.62626e-01_JPRB, 1.67360e-01_JPRB, 1.72232e-01_JPRB, 1.77245e-01_JPRB, &
+     & 1.82405e-01_JPRB, 1.87714e-01_JPRB, 1.93179e-01_JPRB, 1.98802e-01_JPRB, 2.04589e-01_JPRB, &
+     & 2.10544e-01_JPRB, 2.16673e-01_JPRB, 2.22980e-01_JPRB, 2.29471e-01_JPRB, 2.36151e-01_JPRB, &
+     & 2.43025e-01_JPRB, 2.50100e-01_JPRB, 2.57380e-01_JPRB, 2.64872e-01_JPRB/)
+      kbo_mn2o( 5, :, 4) = (/ &
+     & 4.04885e-02_JPRB, 4.16064e-02_JPRB, 4.27551e-02_JPRB, 4.39355e-02_JPRB, 4.51485e-02_JPRB, &
+     & 4.63950e-02_JPRB, 4.76759e-02_JPRB, 4.89921e-02_JPRB, 5.03448e-02_JPRB, 5.17347e-02_JPRB, &
+     & 5.31630e-02_JPRB, 5.46308e-02_JPRB, 5.61391e-02_JPRB, 5.76890e-02_JPRB, 5.92817e-02_JPRB, &
+     & 6.09184e-02_JPRB, 6.26003e-02_JPRB, 6.43286e-02_JPRB, 6.61047e-02_JPRB/)
+      kbo_mn2o( 1, :, 5) = (/ &
+     & 3.97757e-01_JPRB, 4.01082e-01_JPRB, 4.04434e-01_JPRB, 4.07814e-01_JPRB, 4.11223e-01_JPRB, &
+     & 4.14659e-01_JPRB, 4.18125e-01_JPRB, 4.21620e-01_JPRB, 4.25144e-01_JPRB, 4.28697e-01_JPRB, &
+     & 4.32280e-01_JPRB, 4.35893e-01_JPRB, 4.39536e-01_JPRB, 4.43209e-01_JPRB, 4.46913e-01_JPRB, &
+     & 4.50649e-01_JPRB, 4.54415e-01_JPRB, 4.58213e-01_JPRB, 4.62043e-01_JPRB/)
+      kbo_mn2o( 2, :, 5) = (/ &
+     & 3.99425e-01_JPRB, 4.02035e-01_JPRB, 4.04662e-01_JPRB, 4.07306e-01_JPRB, 4.09968e-01_JPRB, &
+     & 4.12647e-01_JPRB, 4.15343e-01_JPRB, 4.18057e-01_JPRB, 4.20789e-01_JPRB, 4.23539e-01_JPRB, &
+     & 4.26307e-01_JPRB, 4.29092e-01_JPRB, 4.31896e-01_JPRB, 4.34719e-01_JPRB, 4.37559e-01_JPRB, &
+     & 4.40419e-01_JPRB, 4.43296e-01_JPRB, 4.46193e-01_JPRB, 4.49109e-01_JPRB/)
+      kbo_mn2o( 3, :, 5) = (/ &
+     & 4.00527e-01_JPRB, 4.02848e-01_JPRB, 4.05182e-01_JPRB, 4.07530e-01_JPRB, 4.09892e-01_JPRB, &
+     & 4.12267e-01_JPRB, 4.14656e-01_JPRB, 4.17058e-01_JPRB, 4.19475e-01_JPRB, 4.21906e-01_JPRB, &
+     & 4.24351e-01_JPRB, 4.26809e-01_JPRB, 4.29283e-01_JPRB, 4.31770e-01_JPRB, 4.34272e-01_JPRB, &
+     & 4.36788e-01_JPRB, 4.39319e-01_JPRB, 4.41865e-01_JPRB, 4.44426e-01_JPRB/)
+      kbo_mn2o( 4, :, 5) = (/ &
+     & 4.11455e-01_JPRB, 4.13077e-01_JPRB, 4.14705e-01_JPRB, 4.16340e-01_JPRB, 4.17981e-01_JPRB, &
+     & 4.19629e-01_JPRB, 4.21283e-01_JPRB, 4.22944e-01_JPRB, 4.24611e-01_JPRB, 4.26285e-01_JPRB, &
+     & 4.27966e-01_JPRB, 4.29653e-01_JPRB, 4.31346e-01_JPRB, 4.33047e-01_JPRB, 4.34754e-01_JPRB, &
+     & 4.36468e-01_JPRB, 4.38188e-01_JPRB, 4.39916e-01_JPRB, 4.41650e-01_JPRB/)
+      kbo_mn2o( 5, :, 5) = (/ &
+     & 8.65576e-02_JPRB, 8.83622e-02_JPRB, 9.02044e-02_JPRB, 9.20850e-02_JPRB, 9.40049e-02_JPRB, &
+     & 9.59647e-02_JPRB, 9.79655e-02_JPRB, 1.00008e-01_JPRB, 1.02093e-01_JPRB, 1.04221e-01_JPRB, &
+     & 1.06394e-01_JPRB, 1.08612e-01_JPRB, 1.10877e-01_JPRB, 1.13188e-01_JPRB, 1.15548e-01_JPRB, &
+     & 1.17957e-01_JPRB, 1.20417e-01_JPRB, 1.22927e-01_JPRB, 1.25490e-01_JPRB/)
+      kbo_mn2o( 1, :, 6) = (/ &
+     & 6.98675e-01_JPRB, 7.00999e-01_JPRB, 7.03331e-01_JPRB, 7.05671e-01_JPRB, 7.08019e-01_JPRB, &
+     & 7.10375e-01_JPRB, 7.12738e-01_JPRB, 7.15110e-01_JPRB, 7.17489e-01_JPRB, 7.19876e-01_JPRB, &
+     & 7.22271e-01_JPRB, 7.24674e-01_JPRB, 7.27085e-01_JPRB, 7.29504e-01_JPRB, 7.31931e-01_JPRB, &
+     & 7.34366e-01_JPRB, 7.36809e-01_JPRB, 7.39261e-01_JPRB, 7.41720e-01_JPRB/)
+      kbo_mn2o( 2, :, 6) = (/ &
+     & 6.98858e-01_JPRB, 7.01424e-01_JPRB, 7.03999e-01_JPRB, 7.06583e-01_JPRB, 7.09177e-01_JPRB, &
+     & 7.11780e-01_JPRB, 7.14393e-01_JPRB, 7.17016e-01_JPRB, 7.19648e-01_JPRB, 7.22289e-01_JPRB, &
+     & 7.24941e-01_JPRB, 7.27602e-01_JPRB, 7.30273e-01_JPRB, 7.32954e-01_JPRB, 7.35644e-01_JPRB, &
+     & 7.38345e-01_JPRB, 7.41055e-01_JPRB, 7.43775e-01_JPRB, 7.46506e-01_JPRB/)
+      kbo_mn2o( 3, :, 6) = (/ &
+     & 7.08151e-01_JPRB, 7.10727e-01_JPRB, 7.13311e-01_JPRB, 7.15905e-01_JPRB, 7.18508e-01_JPRB, &
+     & 7.21121e-01_JPRB, 7.23743e-01_JPRB, 7.26375e-01_JPRB, 7.29017e-01_JPRB, 7.31668e-01_JPRB, &
+     & 7.34329e-01_JPRB, 7.36999e-01_JPRB, 7.39679e-01_JPRB, 7.42369e-01_JPRB, 7.45068e-01_JPRB, &
+     & 7.47778e-01_JPRB, 7.50497e-01_JPRB, 7.53226e-01_JPRB, 7.55965e-01_JPRB/)
+      kbo_mn2o( 4, :, 6) = (/ &
+     & 7.22269e-01_JPRB, 7.24981e-01_JPRB, 7.27704e-01_JPRB, 7.30437e-01_JPRB, 7.33180e-01_JPRB, &
+     & 7.35933e-01_JPRB, 7.38697e-01_JPRB, 7.41471e-01_JPRB, 7.44256e-01_JPRB, 7.47051e-01_JPRB, &
+     & 7.49856e-01_JPRB, 7.52672e-01_JPRB, 7.55499e-01_JPRB, 7.58336e-01_JPRB, 7.61184e-01_JPRB, &
+     & 7.64043e-01_JPRB, 7.66912e-01_JPRB, 7.69792e-01_JPRB, 7.72683e-01_JPRB/)
+      kbo_mn2o( 5, :, 6) = (/ &
+     & 1.75877e-01_JPRB, 1.78578e-01_JPRB, 1.81321e-01_JPRB, 1.84107e-01_JPRB, 1.86935e-01_JPRB, &
+     & 1.89806e-01_JPRB, 1.92722e-01_JPRB, 1.95682e-01_JPRB, 1.98688e-01_JPRB, 2.01740e-01_JPRB, &
+     & 2.04839e-01_JPRB, 2.07986e-01_JPRB, 2.11181e-01_JPRB, 2.14425e-01_JPRB, 2.17719e-01_JPRB, &
+     & 2.21063e-01_JPRB, 2.24459e-01_JPRB, 2.27907e-01_JPRB, 2.31408e-01_JPRB/)
+      kbo_mn2o( 1, :, 7) = (/ &
+     & 1.82985e+00_JPRB, 1.83684e+00_JPRB, 1.84386e+00_JPRB, 1.85091e+00_JPRB, 1.85798e+00_JPRB, &
+     & 1.86508e+00_JPRB, 1.87221e+00_JPRB, 1.87937e+00_JPRB, 1.88655e+00_JPRB, 1.89376e+00_JPRB, &
+     & 1.90100e+00_JPRB, 1.90827e+00_JPRB, 1.91556e+00_JPRB, 1.92288e+00_JPRB, 1.93023e+00_JPRB, &
+     & 1.93761e+00_JPRB, 1.94502e+00_JPRB, 1.95245e+00_JPRB, 1.95991e+00_JPRB/)
+      kbo_mn2o( 2, :, 7) = (/ &
+     & 1.83229e+00_JPRB, 1.83943e+00_JPRB, 1.84659e+00_JPRB, 1.85379e+00_JPRB, 1.86100e+00_JPRB, &
+     & 1.86825e+00_JPRB, 1.87553e+00_JPRB, 1.88283e+00_JPRB, 1.89016e+00_JPRB, 1.89753e+00_JPRB, &
+     & 1.90492e+00_JPRB, 1.91233e+00_JPRB, 1.91978e+00_JPRB, 1.92726e+00_JPRB, 1.93476e+00_JPRB, &
+     & 1.94230e+00_JPRB, 1.94986e+00_JPRB, 1.95746e+00_JPRB, 1.96508e+00_JPRB/)
+      kbo_mn2o( 3, :, 7) = (/ &
+     & 1.84946e+00_JPRB, 1.85707e+00_JPRB, 1.86471e+00_JPRB, 1.87238e+00_JPRB, 1.88008e+00_JPRB, &
+     & 1.88781e+00_JPRB, 1.89558e+00_JPRB, 1.90338e+00_JPRB, 1.91120e+00_JPRB, 1.91907e+00_JPRB, &
+     & 1.92696e+00_JPRB, 1.93489e+00_JPRB, 1.94285e+00_JPRB, 1.95084e+00_JPRB, 1.95886e+00_JPRB, &
+     & 1.96692e+00_JPRB, 1.97501e+00_JPRB, 1.98313e+00_JPRB, 1.99129e+00_JPRB/)
+      kbo_mn2o( 4, :, 7) = (/ &
+     & 1.88354e+00_JPRB, 1.89167e+00_JPRB, 1.89983e+00_JPRB, 1.90803e+00_JPRB, 1.91626e+00_JPRB, &
+     & 1.92453e+00_JPRB, 1.93283e+00_JPRB, 1.94117e+00_JPRB, 1.94955e+00_JPRB, 1.95796e+00_JPRB, &
+     & 1.96641e+00_JPRB, 1.97489e+00_JPRB, 1.98341e+00_JPRB, 1.99197e+00_JPRB, 2.00056e+00_JPRB, &
+     & 2.00920e+00_JPRB, 2.01787e+00_JPRB, 2.02657e+00_JPRB, 2.03532e+00_JPRB/)
+      kbo_mn2o( 5, :, 7) = (/ &
+     & 3.35154e-01_JPRB, 3.43258e-01_JPRB, 3.51557e-01_JPRB, 3.60058e-01_JPRB, 3.68764e-01_JPRB, &
+     & 3.77680e-01_JPRB, 3.86812e-01_JPRB, 3.96164e-01_JPRB, 4.05743e-01_JPRB, 4.15553e-01_JPRB, &
+     & 4.25601e-01_JPRB, 4.35892e-01_JPRB, 4.46431e-01_JPRB, 4.57225e-01_JPRB, 4.68280e-01_JPRB, &
+     & 4.79603e-01_JPRB, 4.91199e-01_JPRB, 5.03075e-01_JPRB, 5.15239e-01_JPRB/)
+      kbo_mn2o( 1, :, 8) = (/ &
+     & 4.46843e+00_JPRB, 4.49793e+00_JPRB, 4.52763e+00_JPRB, 4.55752e+00_JPRB, 4.58761e+00_JPRB, &
+     & 4.61790e+00_JPRB, 4.64839e+00_JPRB, 4.67908e+00_JPRB, 4.70997e+00_JPRB, 4.74106e+00_JPRB, &
+     & 4.77236e+00_JPRB, 4.80387e+00_JPRB, 4.83559e+00_JPRB, 4.86751e+00_JPRB, 4.89965e+00_JPRB, &
+     & 4.93200e+00_JPRB, 4.96456e+00_JPRB, 4.99733e+00_JPRB, 5.03033e+00_JPRB/)
+      kbo_mn2o( 2, :, 8) = (/ &
+     & 4.44347e+00_JPRB, 4.47278e+00_JPRB, 4.50228e+00_JPRB, 4.53198e+00_JPRB, 4.56188e+00_JPRB, &
+     & 4.59197e+00_JPRB, 4.62227e+00_JPRB, 4.65276e+00_JPRB, 4.68345e+00_JPRB, 4.71435e+00_JPRB, &
+     & 4.74544e+00_JPRB, 4.77675e+00_JPRB, 4.80826e+00_JPRB, 4.83998e+00_JPRB, 4.87191e+00_JPRB, &
+     & 4.90405e+00_JPRB, 4.93640e+00_JPRB, 4.96896e+00_JPRB, 5.00174e+00_JPRB/)
+      kbo_mn2o( 3, :, 8) = (/ &
+     & 4.43138e+00_JPRB, 4.46017e+00_JPRB, 4.48916e+00_JPRB, 4.51834e+00_JPRB, 4.54770e+00_JPRB, &
+     & 4.57725e+00_JPRB, 4.60700e+00_JPRB, 4.63694e+00_JPRB, 4.66708e+00_JPRB, 4.69741e+00_JPRB, &
+     & 4.72793e+00_JPRB, 4.75866e+00_JPRB, 4.78958e+00_JPRB, 4.82071e+00_JPRB, 4.85204e+00_JPRB, &
+     & 4.88357e+00_JPRB, 4.91531e+00_JPRB, 4.94725e+00_JPRB, 4.97941e+00_JPRB/)
+      kbo_mn2o( 4, :, 8) = (/ &
+     & 4.47437e+00_JPRB, 4.50396e+00_JPRB, 4.53375e+00_JPRB, 4.56374e+00_JPRB, 4.59392e+00_JPRB, &
+     & 4.62431e+00_JPRB, 4.65490e+00_JPRB, 4.68569e+00_JPRB, 4.71668e+00_JPRB, 4.74788e+00_JPRB, &
+     & 4.77928e+00_JPRB, 4.81089e+00_JPRB, 4.84271e+00_JPRB, 4.87474e+00_JPRB, 4.90698e+00_JPRB, &
+     & 4.93944e+00_JPRB, 4.97211e+00_JPRB, 5.00500e+00_JPRB, 5.03810e+00_JPRB/)
+      kbo_mn2o( 5, :, 8) = (/ &
+     & 8.82838e-01_JPRB, 8.92257e-01_JPRB, 9.01777e-01_JPRB, 9.11398e-01_JPRB, 9.21122e-01_JPRB, &
+     & 9.30950e-01_JPRB, 9.40883e-01_JPRB, 9.50921e-01_JPRB, 9.61067e-01_JPRB, 9.71321e-01_JPRB, &
+     & 9.81685e-01_JPRB, 9.92159e-01_JPRB, 1.00274e+00_JPRB, 1.01344e+00_JPRB, 1.02426e+00_JPRB, &
+     & 1.03518e+00_JPRB, 1.04623e+00_JPRB, 1.05739e+00_JPRB, 1.06867e+00_JPRB/)
+      kbo_mn2o( 1, :, 9) = (/ &
+     & 7.92826e+00_JPRB, 7.83168e+00_JPRB, 7.73628e+00_JPRB, 7.64204e+00_JPRB, 7.54895e+00_JPRB, &
+     & 7.45699e+00_JPRB, 7.36616e+00_JPRB, 7.27643e+00_JPRB, 7.18779e+00_JPRB, 7.10023e+00_JPRB, &
+     & 7.01374e+00_JPRB, 6.92831e+00_JPRB, 6.84391e+00_JPRB, 6.76054e+00_JPRB, 6.67819e+00_JPRB, &
+     & 6.59684e+00_JPRB, 6.51648e+00_JPRB, 6.43710e+00_JPRB, 6.35869e+00_JPRB/)
+      kbo_mn2o( 2, :, 9) = (/ &
+     & 7.89244e+00_JPRB, 7.79570e+00_JPRB, 7.70014e+00_JPRB, 7.60576e+00_JPRB, 7.51253e+00_JPRB, &
+     & 7.42045e+00_JPRB, 7.32949e+00_JPRB, 7.23965e+00_JPRB, 7.15091e+00_JPRB, 7.06325e+00_JPRB, &
+     & 6.97668e+00_JPRB, 6.89116e+00_JPRB, 6.80669e+00_JPRB, 6.72326e+00_JPRB, 6.64085e+00_JPRB, &
+     & 6.55945e+00_JPRB, 6.47904e+00_JPRB, 6.39963e+00_JPRB, 6.32118e+00_JPRB/)
+      kbo_mn2o( 3, :, 9) = (/ &
+     & 7.79799e+00_JPRB, 7.70076e+00_JPRB, 7.60474e+00_JPRB, 7.50991e+00_JPRB, 7.41627e+00_JPRB, &
+     & 7.32379e+00_JPRB, 7.23247e+00_JPRB, 7.14229e+00_JPRB, 7.05323e+00_JPRB, 6.96528e+00_JPRB, &
+     & 6.87843e+00_JPRB, 6.79266e+00_JPRB, 6.70797e+00_JPRB, 6.62432e+00_JPRB, 6.54172e+00_JPRB, &
+     & 6.46015e+00_JPRB, 6.37960e+00_JPRB, 6.30005e+00_JPRB, 6.22150e+00_JPRB/)
+      kbo_mn2o( 4, :, 9) = (/ &
+     & 7.53750e+00_JPRB, 7.43715e+00_JPRB, 7.33814e+00_JPRB, 7.24045e+00_JPRB, 7.14406e+00_JPRB, &
+     & 7.04895e+00_JPRB, 6.95510e+00_JPRB, 6.86251e+00_JPRB, 6.77115e+00_JPRB, 6.68101e+00_JPRB, &
+     & 6.59206e+00_JPRB, 6.50430e+00_JPRB, 6.41771e+00_JPRB, 6.33227e+00_JPRB, 6.24797e+00_JPRB, &
+     & 6.16479e+00_JPRB, 6.08272e+00_JPRB, 6.00174e+00_JPRB, 5.92184e+00_JPRB/)
+      kbo_mn2o( 5, :, 9) = (/ &
+     & 5.06319e+00_JPRB, 5.08595e+00_JPRB, 5.10881e+00_JPRB, 5.13177e+00_JPRB, 5.15483e+00_JPRB, &
+     & 5.17800e+00_JPRB, 5.20127e+00_JPRB, 5.22464e+00_JPRB, 5.24813e+00_JPRB, 5.27171e+00_JPRB, &
+     & 5.29540e+00_JPRB, 5.31920e+00_JPRB, 5.34311e+00_JPRB, 5.36712e+00_JPRB, 5.39124e+00_JPRB, &
+     & 5.41547e+00_JPRB, 5.43981e+00_JPRB, 5.46426e+00_JPRB, 5.48882e+00_JPRB/)
+      kbo_mn2o( 1, :,10) = (/ &
+     & 1.05265e+00_JPRB, 1.03986e+00_JPRB, 1.02723e+00_JPRB, 1.01475e+00_JPRB, 1.00243e+00_JPRB, &
+     & 9.90250e-01_JPRB, 9.78220e-01_JPRB, 9.66338e-01_JPRB, 9.54599e-01_JPRB, 9.43003e-01_JPRB, &
+     & 9.31548e-01_JPRB, 9.20232e-01_JPRB, 9.09054e-01_JPRB, 8.98011e-01_JPRB, 8.87102e-01_JPRB, &
+     & 8.76326e-01_JPRB, 8.65681e-01_JPRB, 8.55165e-01_JPRB, 8.44777e-01_JPRB/)
+      kbo_mn2o( 2, :,10) = (/ &
+     & 1.05246e+00_JPRB, 1.03973e+00_JPRB, 1.02714e+00_JPRB, 1.01471e+00_JPRB, 1.00243e+00_JPRB, &
+     & 9.90303e-01_JPRB, 9.78319e-01_JPRB, 9.66480e-01_JPRB, 9.54784e-01_JPRB, 9.43230e-01_JPRB, &
+     & 9.31815e-01_JPRB, 9.20539e-01_JPRB, 9.09399e-01_JPRB, 8.98394e-01_JPRB, 8.87522e-01_JPRB, &
+     & 8.76782e-01_JPRB, 8.66171e-01_JPRB, 8.55690e-01_JPRB, 8.45335e-01_JPRB/)
+      kbo_mn2o( 3, :,10) = (/ &
+     & 1.05236e+00_JPRB, 1.03963e+00_JPRB, 1.02704e+00_JPRB, 1.01461e+00_JPRB, 1.00233e+00_JPRB, &
+     & 9.90203e-01_JPRB, 9.78219e-01_JPRB, 9.66380e-01_JPRB, 9.54684e-01_JPRB, 9.43130e-01_JPRB, &
+     & 9.31715e-01_JPRB, 9.20439e-01_JPRB, 9.09300e-01_JPRB, 8.98295e-01_JPRB, 8.87423e-01_JPRB, &
+     & 8.76683e-01_JPRB, 8.66073e-01_JPRB, 8.55591e-01_JPRB, 8.45236e-01_JPRB/)
+      kbo_mn2o( 4, :,10) = (/ &
+     & 9.30836e-01_JPRB, 9.21099e-01_JPRB, 9.11464e-01_JPRB, 9.01930e-01_JPRB, 8.92495e-01_JPRB, &
+     & 8.83159e-01_JPRB, 8.73921e-01_JPRB, 8.64779e-01_JPRB, 8.55733e-01_JPRB, 8.46781e-01_JPRB, &
+     & 8.37923e-01_JPRB, 8.29158e-01_JPRB, 8.20485e-01_JPRB, 8.11902e-01_JPRB, 8.03409e-01_JPRB, &
+     & 7.95005e-01_JPRB, 7.86689e-01_JPRB, 7.78460e-01_JPRB, 7.70316e-01_JPRB/)
+      kbo_mn2o( 5, :,10) = (/ &
+     & 1.65786e+01_JPRB, 1.66541e+01_JPRB, 1.67299e+01_JPRB, 1.68062e+01_JPRB, 1.68827e+01_JPRB, &
+     & 1.69596e+01_JPRB, 1.70369e+01_JPRB, 1.71145e+01_JPRB, 1.71925e+01_JPRB, 1.72708e+01_JPRB, &
+     & 1.73495e+01_JPRB, 1.74285e+01_JPRB, 1.75079e+01_JPRB, 1.75877e+01_JPRB, 1.76678e+01_JPRB, &
+     & 1.77483e+01_JPRB, 1.78291e+01_JPRB, 1.79103e+01_JPRB, 1.79919e+01_JPRB/)
+      kbo_mn2o( 1, :,11) = (/ &
+     & 1.74239e-01_JPRB, 1.77873e-01_JPRB, 1.81583e-01_JPRB, 1.85370e-01_JPRB, 1.89236e-01_JPRB, &
+     & 1.93182e-01_JPRB, 1.97211e-01_JPRB, 2.01324e-01_JPRB, 2.05523e-01_JPRB, 2.09809e-01_JPRB, &
+     & 2.14185e-01_JPRB, 2.18652e-01_JPRB, 2.23212e-01_JPRB, 2.27867e-01_JPRB, 2.32620e-01_JPRB, &
+     & 2.37471e-01_JPRB, 2.42424e-01_JPRB, 2.47479e-01_JPRB, 2.52641e-01_JPRB/)
+      kbo_mn2o( 2, :,11) = (/ &
+     & 1.74114e-01_JPRB, 1.77756e-01_JPRB, 1.81475e-01_JPRB, 1.85271e-01_JPRB, 1.89147e-01_JPRB, &
+     & 1.93104e-01_JPRB, 1.97144e-01_JPRB, 2.01268e-01_JPRB, 2.05479e-01_JPRB, 2.09778e-01_JPRB, &
+     & 2.14166e-01_JPRB, 2.18647e-01_JPRB, 2.23221e-01_JPRB, 2.27890e-01_JPRB, 2.32658e-01_JPRB, &
+     & 2.37525e-01_JPRB, 2.42494e-01_JPRB, 2.47567e-01_JPRB, 2.52746e-01_JPRB/)
+      kbo_mn2o( 3, :,11) = (/ &
+     & 1.74142e-01_JPRB, 1.77780e-01_JPRB, 1.81494e-01_JPRB, 1.85286e-01_JPRB, 1.89157e-01_JPRB, &
+     & 1.93108e-01_JPRB, 1.97143e-01_JPRB, 2.01261e-01_JPRB, 2.05466e-01_JPRB, 2.09759e-01_JPRB, &
+     & 2.14141e-01_JPRB, 2.18615e-01_JPRB, 2.23182e-01_JPRB, 2.27845e-01_JPRB, 2.32605e-01_JPRB, &
+     & 2.37464e-01_JPRB, 2.42425e-01_JPRB, 2.47490e-01_JPRB, 2.52661e-01_JPRB/)
+      kbo_mn2o( 4, :,11) = (/ &
+     & 1.74074e-01_JPRB, 1.77716e-01_JPRB, 1.81435e-01_JPRB, 1.85231e-01_JPRB, 1.89107e-01_JPRB, &
+     & 1.93064e-01_JPRB, 1.97104e-01_JPRB, 2.01229e-01_JPRB, 2.05439e-01_JPRB, 2.09738e-01_JPRB, &
+     & 2.14127e-01_JPRB, 2.18607e-01_JPRB, 2.23181e-01_JPRB, 2.27852e-01_JPRB, 2.32619e-01_JPRB, &
+     & 2.37487e-01_JPRB, 2.42456e-01_JPRB, 2.47529e-01_JPRB, 2.52709e-01_JPRB/)
+      kbo_mn2o( 5, :,11) = (/ &
+     & 2.31905e+01_JPRB, 2.33011e+01_JPRB, 2.34123e+01_JPRB, 2.35240e+01_JPRB, 2.36362e+01_JPRB, &
+     & 2.37489e+01_JPRB, 2.38622e+01_JPRB, 2.39760e+01_JPRB, 2.40904e+01_JPRB, 2.42053e+01_JPRB, &
+     & 2.43208e+01_JPRB, 2.44368e+01_JPRB, 2.45533e+01_JPRB, 2.46705e+01_JPRB, 2.47881e+01_JPRB, &
+     & 2.49064e+01_JPRB, 2.50252e+01_JPRB, 2.51446e+01_JPRB, 2.52645e+01_JPRB/)
+      kbo_mn2o( 1, :,12) = (/ &
+     & 1.60269e-01_JPRB, 1.62873e-01_JPRB, 1.65519e-01_JPRB, 1.68208e-01_JPRB, 1.70940e-01_JPRB, &
+     & 1.73717e-01_JPRB, 1.76540e-01_JPRB, 1.79408e-01_JPRB, 1.82322e-01_JPRB, 1.85284e-01_JPRB, &
+     & 1.88295e-01_JPRB, 1.91354e-01_JPRB, 1.94462e-01_JPRB, 1.97622e-01_JPRB, 2.00832e-01_JPRB, &
+     & 2.04095e-01_JPRB, 2.07411e-01_JPRB, 2.10780e-01_JPRB, 2.14205e-01_JPRB/)
+      kbo_mn2o( 2, :,12) = (/ &
+     & 1.60497e-01_JPRB, 1.63096e-01_JPRB, 1.65738e-01_JPRB, 1.68422e-01_JPRB, 1.71150e-01_JPRB, &
+     & 1.73922e-01_JPRB, 1.76738e-01_JPRB, 1.79601e-01_JPRB, 1.82510e-01_JPRB, 1.85466e-01_JPRB, &
+     & 1.88469e-01_JPRB, 1.91522e-01_JPRB, 1.94624e-01_JPRB, 1.97776e-01_JPRB, 2.00979e-01_JPRB, &
+     & 2.04234e-01_JPRB, 2.07542e-01_JPRB, 2.10903e-01_JPRB, 2.14319e-01_JPRB/)
+      kbo_mn2o( 3, :,12) = (/ &
+     & 1.60407e-01_JPRB, 1.63006e-01_JPRB, 1.65648e-01_JPRB, 1.68332e-01_JPRB, 1.71060e-01_JPRB, &
+     & 1.73832e-01_JPRB, 1.76649e-01_JPRB, 1.79511e-01_JPRB, 1.82420e-01_JPRB, 1.85376e-01_JPRB, &
+     & 1.88380e-01_JPRB, 1.91433e-01_JPRB, 1.94535e-01_JPRB, 1.97687e-01_JPRB, 2.00891e-01_JPRB, &
+     & 2.04146e-01_JPRB, 2.07454e-01_JPRB, 2.10816e-01_JPRB, 2.14232e-01_JPRB/)
+      kbo_mn2o( 4, :,12) = (/ &
+     & 1.60475e-01_JPRB, 1.63070e-01_JPRB, 1.65706e-01_JPRB, 1.68386e-01_JPRB, 1.71109e-01_JPRB, &
+     & 1.73876e-01_JPRB, 1.76687e-01_JPRB, 1.79544e-01_JPRB, 1.82448e-01_JPRB, 1.85398e-01_JPRB, &
+     & 1.88396e-01_JPRB, 1.91442e-01_JPRB, 1.94538e-01_JPRB, 1.97684e-01_JPRB, 2.00881e-01_JPRB, &
+     & 2.04129e-01_JPRB, 2.07430e-01_JPRB, 2.10784e-01_JPRB, 2.14192e-01_JPRB/)
+      kbo_mn2o( 5, :,12) = (/ &
+     & 3.25743e+01_JPRB, 3.27992e+01_JPRB, 3.30256e+01_JPRB, 3.32536e+01_JPRB, 3.34832e+01_JPRB, &
+     & 3.37143e+01_JPRB, 3.39471e+01_JPRB, 3.41815e+01_JPRB, 3.44174e+01_JPRB, 3.46550e+01_JPRB, &
+     & 3.48943e+01_JPRB, 3.51352e+01_JPRB, 3.53778e+01_JPRB, 3.56220e+01_JPRB, 3.58679e+01_JPRB, &
+     & 3.61156e+01_JPRB, 3.63649e+01_JPRB, 3.66159e+01_JPRB, 3.68687e+01_JPRB/)
+      kbo_mn2o( 1, :,13) = (/ &
+     & 2.01846e-01_JPRB, 2.03110e-01_JPRB, 2.04381e-01_JPRB, 2.05660e-01_JPRB, 2.06947e-01_JPRB, &
+     & 2.08242e-01_JPRB, 2.09546e-01_JPRB, 2.10857e-01_JPRB, 2.12177e-01_JPRB, 2.13505e-01_JPRB, &
+     & 2.14841e-01_JPRB, 2.16186e-01_JPRB, 2.17539e-01_JPRB, 2.18900e-01_JPRB, 2.20270e-01_JPRB, &
+     & 2.21649e-01_JPRB, 2.23036e-01_JPRB, 2.24432e-01_JPRB, 2.25837e-01_JPRB/)
+      kbo_mn2o( 2, :,13) = (/ &
+     & 2.01756e-01_JPRB, 2.03020e-01_JPRB, 2.04291e-01_JPRB, 2.05570e-01_JPRB, 2.06857e-01_JPRB, &
+     & 2.08152e-01_JPRB, 2.09456e-01_JPRB, 2.10767e-01_JPRB, 2.12087e-01_JPRB, 2.13415e-01_JPRB, &
+     & 2.14751e-01_JPRB, 2.16096e-01_JPRB, 2.17449e-01_JPRB, 2.18810e-01_JPRB, 2.20181e-01_JPRB, &
+     & 2.21559e-01_JPRB, 2.22946e-01_JPRB, 2.24342e-01_JPRB, 2.25747e-01_JPRB/)
+      kbo_mn2o( 3, :,13) = (/ &
+     & 2.01836e-01_JPRB, 2.03100e-01_JPRB, 2.04371e-01_JPRB, 2.05650e-01_JPRB, 2.06937e-01_JPRB, &
+     & 2.08232e-01_JPRB, 2.09536e-01_JPRB, 2.10847e-01_JPRB, 2.12167e-01_JPRB, 2.13495e-01_JPRB, &
+     & 2.14831e-01_JPRB, 2.16176e-01_JPRB, 2.17529e-01_JPRB, 2.18890e-01_JPRB, 2.20260e-01_JPRB, &
+     & 2.21639e-01_JPRB, 2.23026e-01_JPRB, 2.24422e-01_JPRB, 2.25827e-01_JPRB/)
+      kbo_mn2o( 4, :,13) = (/ &
+     & 2.01845e-01_JPRB, 2.03103e-01_JPRB, 2.04370e-01_JPRB, 2.05644e-01_JPRB, 2.06926e-01_JPRB, &
+     & 2.08217e-01_JPRB, 2.09515e-01_JPRB, 2.10822e-01_JPRB, 2.12136e-01_JPRB, 2.13459e-01_JPRB, &
+     & 2.14790e-01_JPRB, 2.16129e-01_JPRB, 2.17477e-01_JPRB, 2.18833e-01_JPRB, 2.20198e-01_JPRB, &
+     & 2.21571e-01_JPRB, 2.22952e-01_JPRB, 2.24343e-01_JPRB, 2.25741e-01_JPRB/)
+      kbo_mn2o( 5, :,13) = (/ &
+     & 5.34154e+01_JPRB, 5.31954e+01_JPRB, 5.29763e+01_JPRB, 5.27582e+01_JPRB, 5.25409e+01_JPRB, &
+     & 5.23245e+01_JPRB, 5.21090e+01_JPRB, 5.18943e+01_JPRB, 5.16806e+01_JPRB, 5.14677e+01_JPRB, &
+     & 5.12558e+01_JPRB, 5.10446e+01_JPRB, 5.08344e+01_JPRB, 5.06250e+01_JPRB, 5.04165e+01_JPRB, &
+     & 5.02089e+01_JPRB, 5.00021e+01_JPRB, 4.97961e+01_JPRB, 4.95910e+01_JPRB/)
+      kbo_mn2o( 1, :,14) = (/ &
+     & 2.87818e-02_JPRB, 3.17868e-02_JPRB, 3.51056e-02_JPRB, 3.87708e-02_JPRB, 4.28187e-02_JPRB, &
+     & 4.72893e-02_JPRB, 5.22266e-02_JPRB, 5.76794e-02_JPRB, 6.37015e-02_JPRB, 7.03523e-02_JPRB, &
+     & 7.76976e-02_JPRB, 8.58097e-02_JPRB, 9.47688e-02_JPRB, 1.04663e-01_JPRB, 1.15591e-01_JPRB, &
+     & 1.27659e-01_JPRB, 1.40988e-01_JPRB, 1.55708e-01_JPRB, 1.71965e-01_JPRB/)
+      kbo_mn2o( 2, :,14) = (/ &
+     & 2.88500e-02_JPRB, 3.18494e-02_JPRB, 3.51606e-02_JPRB, 3.88161e-02_JPRB, 4.28517e-02_JPRB, &
+     & 4.73068e-02_JPRB, 5.22251e-02_JPRB, 5.76547e-02_JPRB, 6.36488e-02_JPRB, 7.02661e-02_JPRB, &
+     & 7.75714e-02_JPRB, 8.56362e-02_JPRB, 9.45395e-02_JPRB, 1.04368e-01_JPRB, 1.15219e-01_JPRB, &
+     & 1.27198e-01_JPRB, 1.40422e-01_JPRB, 1.55021e-01_JPRB, 1.71138e-01_JPRB/)
+      kbo_mn2o( 3, :,14) = (/ &
+     & 2.88036e-02_JPRB, 3.18109e-02_JPRB, 3.51322e-02_JPRB, 3.88002e-02_JPRB, 4.28512e-02_JPRB, &
+     & 4.73252e-02_JPRB, 5.22663e-02_JPRB, 5.77232e-02_JPRB, 6.37499e-02_JPRB, 7.04058e-02_JPRB, &
+     & 7.77567e-02_JPRB, 8.58751e-02_JPRB, 9.48410e-02_JPRB, 1.04743e-01_JPRB, 1.15679e-01_JPRB, &
+     & 1.27757e-01_JPRB, 1.41095e-01_JPRB, 1.55827e-01_JPRB, 1.72096e-01_JPRB/)
+      kbo_mn2o( 4, :,14) = (/ &
+     & 2.87750e-02_JPRB, 3.17783e-02_JPRB, 3.50951e-02_JPRB, 3.87580e-02_JPRB, 4.28033e-02_JPRB, &
+     & 4.72708e-02_JPRB, 5.22046e-02_JPRB, 5.76533e-02_JPRB, 6.36707e-02_JPRB, 7.03162e-02_JPRB, &
+     & 7.76553e-02_JPRB, 8.57604e-02_JPRB, 9.47114e-02_JPRB, 1.04597e-01_JPRB, 1.15514e-01_JPRB, &
+     & 1.27570e-01_JPRB, 1.40885e-01_JPRB, 1.55589e-01_JPRB, 1.71829e-01_JPRB/)
+      kbo_mn2o( 5, :,14) = (/ &
+     & 1.11848e+02_JPRB, 1.09489e+02_JPRB, 1.07179e+02_JPRB, 1.04918e+02_JPRB, 1.02705e+02_JPRB, &
+     & 1.00538e+02_JPRB, 9.84175e+01_JPRB, 9.63414e+01_JPRB, 9.43091e+01_JPRB, 9.23196e+01_JPRB, &
+     & 9.03722e+01_JPRB, 8.84658e+01_JPRB, 8.65996e+01_JPRB, 8.47728e+01_JPRB, 8.29845e+01_JPRB, &
+     & 8.12339e+01_JPRB, 7.95203e+01_JPRB, 7.78428e+01_JPRB, 7.62007e+01_JPRB/)
+      kbo_mn2o( 1, :,15) = (/ &
+     & 1.52234e-02_JPRB, 1.69256e-02_JPRB, 1.88181e-02_JPRB, 2.09222e-02_JPRB, 2.32617e-02_JPRB, &
+     & 2.58626e-02_JPRB, 2.87545e-02_JPRB, 3.19696e-02_JPRB, 3.55443e-02_JPRB, 3.95187e-02_JPRB, &
+     & 4.39374e-02_JPRB, 4.88503e-02_JPRB, 5.43124e-02_JPRB, 6.03854e-02_JPRB, 6.71373e-02_JPRB, &
+     & 7.46443e-02_JPRB, 8.29906e-02_JPRB, 9.22701e-02_JPRB, 1.02587e-01_JPRB/)
+      kbo_mn2o( 2, :,15) = (/ &
+     & 1.52234e-02_JPRB, 1.69256e-02_JPRB, 1.88181e-02_JPRB, 2.09222e-02_JPRB, 2.32617e-02_JPRB, &
+     & 2.58626e-02_JPRB, 2.87545e-02_JPRB, 3.19696e-02_JPRB, 3.55443e-02_JPRB, 3.95187e-02_JPRB, &
+     & 4.39374e-02_JPRB, 4.88503e-02_JPRB, 5.43124e-02_JPRB, 6.03854e-02_JPRB, 6.71373e-02_JPRB, &
+     & 7.46443e-02_JPRB, 8.29906e-02_JPRB, 9.22701e-02_JPRB, 1.02587e-01_JPRB/)
+      kbo_mn2o( 3, :,15) = (/ &
+     & 1.52076e-02_JPRB, 1.69049e-02_JPRB, 1.87916e-02_JPRB, 2.08890e-02_JPRB, 2.32203e-02_JPRB, &
+     & 2.58119e-02_JPRB, 2.86928e-02_JPRB, 3.18951e-02_JPRB, 3.54549e-02_JPRB, 3.94120e-02_JPRB, &
+     & 4.38107e-02_JPRB, 4.87003e-02_JPRB, 5.41357e-02_JPRB, 6.01777e-02_JPRB, 6.68940e-02_JPRB, &
+     & 7.43600e-02_JPRB, 8.26593e-02_JPRB, 9.18847e-02_JPRB, 1.02140e-01_JPRB/)
+      kbo_mn2o( 4, :,15) = (/ &
+     & 1.52422e-02_JPRB, 1.69488e-02_JPRB, 1.88464e-02_JPRB, 2.09565e-02_JPRB, 2.33028e-02_JPRB, &
+     & 2.59118e-02_JPRB, 2.88129e-02_JPRB, 3.20389e-02_JPRB, 3.56260e-02_JPRB, 3.96148e-02_JPRB, &
+     & 4.40501e-02_JPRB, 4.89821e-02_JPRB, 5.44662e-02_JPRB, 6.05643e-02_JPRB, 6.73452e-02_JPRB, &
+     & 7.48853e-02_JPRB, 8.32696e-02_JPRB, 9.25927e-02_JPRB, 1.02959e-01_JPRB/)
+      kbo_mn2o( 5, :,15) = (/ &
+     & 6.94782e+01_JPRB, 6.73469e+01_JPRB, 6.52810e+01_JPRB, 6.32785e+01_JPRB, 6.13373e+01_JPRB, &
+     & 5.94558e+01_JPRB, 5.76319e+01_JPRB, 5.58640e+01_JPRB, 5.41503e+01_JPRB, 5.24892e+01_JPRB, &
+     & 5.08791e+01_JPRB, 4.93183e+01_JPRB, 4.78055e+01_JPRB, 4.63390e+01_JPRB, 4.49175e+01_JPRB, &
+     & 4.35396e+01_JPRB, 4.22040e+01_JPRB, 4.09094e+01_JPRB, 3.96544e+01_JPRB/)
+      kbo_mn2o( 1, :,16) = (/ &
+     & 1.08257e-02_JPRB, 1.15188e-02_JPRB, 1.22563e-02_JPRB, 1.30410e-02_JPRB, 1.38759e-02_JPRB, &
+     & 1.47643e-02_JPRB, 1.57096e-02_JPRB, 1.67154e-02_JPRB, 1.77857e-02_JPRB, 1.89244e-02_JPRB, &
+     & 2.01360e-02_JPRB, 2.14252e-02_JPRB, 2.27970e-02_JPRB, 2.42565e-02_JPRB, 2.58096e-02_JPRB, &
+     & 2.74620e-02_JPRB, 2.92203e-02_JPRB, 3.10911e-02_JPRB, 3.30817e-02_JPRB/)
+      kbo_mn2o( 2, :,16) = (/ &
+     & 1.08257e-02_JPRB, 1.15188e-02_JPRB, 1.22563e-02_JPRB, 1.30410e-02_JPRB, 1.38759e-02_JPRB, &
+     & 1.47643e-02_JPRB, 1.57096e-02_JPRB, 1.67154e-02_JPRB, 1.77857e-02_JPRB, 1.89244e-02_JPRB, &
+     & 2.01360e-02_JPRB, 2.14252e-02_JPRB, 2.27970e-02_JPRB, 2.42565e-02_JPRB, 2.58096e-02_JPRB, &
+     & 2.74620e-02_JPRB, 2.92203e-02_JPRB, 3.10911e-02_JPRB, 3.30817e-02_JPRB/)
+      kbo_mn2o( 3, :,16) = (/ &
+     & 1.08257e-02_JPRB, 1.15188e-02_JPRB, 1.22563e-02_JPRB, 1.30410e-02_JPRB, 1.38759e-02_JPRB, &
+     & 1.47643e-02_JPRB, 1.57096e-02_JPRB, 1.67154e-02_JPRB, 1.77857e-02_JPRB, 1.89244e-02_JPRB, &
+     & 2.01360e-02_JPRB, 2.14252e-02_JPRB, 2.27970e-02_JPRB, 2.42565e-02_JPRB, 2.58096e-02_JPRB, &
+     & 2.74620e-02_JPRB, 2.92203e-02_JPRB, 3.10911e-02_JPRB, 3.30817e-02_JPRB/)
+      kbo_mn2o( 4, :,16) = (/ &
+     & 1.08263e-02_JPRB, 1.15191e-02_JPRB, 1.22562e-02_JPRB, 1.30404e-02_JPRB, 1.38749e-02_JPRB, &
+     & 1.47627e-02_JPRB, 1.57073e-02_JPRB, 1.67124e-02_JPRB, 1.77818e-02_JPRB, 1.89196e-02_JPRB, &
+     & 2.01302e-02_JPRB, 2.14183e-02_JPRB, 2.27888e-02_JPRB, 2.42470e-02_JPRB, 2.57986e-02_JPRB, &
+     & 2.74494e-02_JPRB, 2.92058e-02_JPRB, 3.10746e-02_JPRB, 3.30630e-02_JPRB/)
+      kbo_mn2o( 5, :,16) = (/ &
+     & 4.53450e-08_JPRB, 5.75193e-08_JPRB, 7.29620e-08_JPRB, 9.25509e-08_JPRB, 1.17399e-07_JPRB, &
+     & 1.48918e-07_JPRB, 1.88900e-07_JPRB, 2.39616e-07_JPRB, 3.03948e-07_JPRB, 3.85551e-07_JPRB, &
+     & 4.89064e-07_JPRB, 6.20369e-07_JPRB, 7.86925e-07_JPRB, 9.98199e-07_JPRB, 1.26619e-06_JPRB, &
+     & 1.60614e-06_JPRB, 2.03736e-06_JPRB, 2.58435e-06_JPRB, 3.27819e-06_JPRB/)
+
+!     The array FORREFO contains the coefficient of the water vapor
+!     foreign-continuum (including the energy term).  The first 
+!     index refers to reference temperature (296,260,224,260) and 
+!     pressure (970,475,219,3 mbar) levels.  The second index 
+!     runs over the g-channel (1 to 16).
+
+      forrefo(1,:) = (/ &
+     &9.0039e-04_JPRB,1.1081e-03_JPRB,1.0732e-03_JPRB,1.1881e-03_JPRB,1.2488e-03_JPRB,1.3170e-03_JPRB, &
+     &1.3317e-03_JPRB,1.3168e-03_JPRB,1.3369e-03_JPRB,1.4228e-03_JPRB,1.5385e-03_JPRB,1.7376e-03_JPRB, &
+     &1.7122e-03_JPRB,1.9002e-03_JPRB,1.8881e-03_JPRB,2.1595e-03_JPRB/)
+      forrefo(2,:) = (/ &
+     &1.2726e-03_JPRB,1.3680e-03_JPRB,1.2494e-03_JPRB,1.2049e-03_JPRB,1.2048e-03_JPRB,1.1256e-03_JPRB, &
+     &1.1170e-03_JPRB,1.0697e-03_JPRB,1.1177e-03_JPRB,1.1883e-03_JPRB,1.2219e-03_JPRB,1.2179e-03_JPRB, &
+     &1.5692e-03_JPRB,1.9103e-03_JPRB,2.0219e-03_JPRB,1.6937e-03_JPRB/)
+      forrefo(3,:) = (/ &
+     &1.5527e-03_JPRB,1.6477e-03_JPRB,1.4973e-03_JPRB,1.3400e-03_JPRB,1.0820e-03_JPRB,9.3315e-04_JPRB, &
+     &8.8132e-04_JPRB,8.1508e-04_JPRB,8.3559e-04_JPRB,7.6492e-04_JPRB,8.2343e-04_JPRB,7.1274e-04_JPRB, &
+     &6.6011e-04_JPRB,6.7179e-04_JPRB,6.7039e-04_JPRB,6.7021e-04_JPRB/)
+      forrefo(4,:) = (/ &
+     &1.6763e-03_JPRB,1.6066e-03_JPRB,1.3927e-03_JPRB,1.2087e-03_JPRB,9.8463e-04_JPRB,8.8414e-04_JPRB, &
+     &8.0976e-04_JPRB,7.8758e-04_JPRB,7.7376e-04_JPRB,7.5785e-04_JPRB,7.4152e-04_JPRB,7.3814e-04_JPRB, &
+     &7.4278e-04_JPRB,7.1745e-04_JPRB,6.7216e-04_JPRB,6.4097e-04_JPRB/)
+
+!     The array SELFREFO contains the coefficient of the water vapor
+!     self-continuum (including the energy term).  The first index
+!     refers to temperature in 7.2 degree increments.  For instance,
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+!     etc.  The second index runs over the g-channel (1 to 16).
+
+      selfrefo(:, 1) = (/ &
+     & 5.11926e-01_JPRB, 4.32863e-01_JPRB, 3.66010e-01_JPRB, 3.09482e-01_JPRB, 2.61685e-01_JPRB, &
+     & 2.21269e-01_JPRB, 1.87096e-01_JPRB, 1.58200e-01_JPRB, 1.33767e-01_JPRB, 1.13108e-01_JPRB/)
+      selfrefo(:, 2) = (/ &
+     & 5.02863e-01_JPRB, 4.35008e-01_JPRB, 3.76310e-01_JPRB, 3.25532e-01_JPRB, 2.81606e-01_JPRB, &
+     & 2.43607e-01_JPRB, 2.10736e-01_JPRB, 1.82300e-01_JPRB, 1.57701e-01_JPRB, 1.36422e-01_JPRB/)
+      selfrefo(:, 3) = (/ &
+     & 4.57628e-01_JPRB, 3.99663e-01_JPRB, 3.49040e-01_JPRB, 3.04829e-01_JPRB, 2.66218e-01_JPRB, &
+     & 2.32498e-01_JPRB, 2.03049e-01_JPRB, 1.77330e-01_JPRB, 1.54869e-01_JPRB, 1.35252e-01_JPRB/)
+      selfrefo(:, 4) = (/ &
+     & 4.28634e-01_JPRB, 3.81736e-01_JPRB, 3.39970e-01_JPRB, 3.02773e-01_JPRB, 2.69647e-01_JPRB, &
+     & 2.40144e-01_JPRB, 2.13870e-01_JPRB, 1.90470e-01_JPRB, 1.69630e-01_JPRB, 1.51071e-01_JPRB/)
+      selfrefo(:, 5) = (/ &
+     & 4.21002e-01_JPRB, 3.77493e-01_JPRB, 3.38480e-01_JPRB, 3.03499e-01_JPRB, 2.72133e-01_JPRB, &
+     & 2.44009e-01_JPRB, 2.18792e-01_JPRB, 1.96180e-01_JPRB, 1.75905e-01_JPRB, 1.57726e-01_JPRB/)
+      selfrefo(:, 6) = (/ &
+     & 3.97517e-01_JPRB, 3.61167e-01_JPRB, 3.28140e-01_JPRB, 2.98133e-01_JPRB, 2.70871e-01_JPRB, &
+     & 2.46101e-01_JPRB, 2.23597e-01_JPRB, 2.03150e-01_JPRB, 1.84573e-01_JPRB, 1.67695e-01_JPRB/)
+      selfrefo(:, 7) = (/ &
+     & 3.92114e-01_JPRB, 3.57554e-01_JPRB, 3.26040e-01_JPRB, 2.97304e-01_JPRB, 2.71100e-01_JPRB, &
+     & 2.47206e-01_JPRB, 2.25418e-01_JPRB, 2.05550e-01_JPRB, 1.87433e-01_JPRB, 1.70913e-01_JPRB/)
+      selfrefo(:, 8) = (/ &
+     & 3.79555e-01_JPRB, 3.47264e-01_JPRB, 3.17720e-01_JPRB, 2.90690e-01_JPRB, 2.65959e-01_JPRB, &
+     & 2.43332e-01_JPRB, 2.22631e-01_JPRB, 2.03690e-01_JPRB, 1.86361e-01_JPRB, 1.70506e-01_JPRB/)
+      selfrefo(:, 9) = (/ &
+     & 3.92644e-01_JPRB, 3.58048e-01_JPRB, 3.26500e-01_JPRB, 2.97732e-01_JPRB, 2.71498e-01_JPRB, &
+     & 2.47576e-01_JPRB, 2.25762e-01_JPRB, 2.05870e-01_JPRB, 1.87731e-01_JPRB, 1.71190e-01_JPRB/)
+      selfrefo(:,10) = (/ &
+     & 4.06542e-01_JPRB, 3.71200e-01_JPRB, 3.38930e-01_JPRB, 3.09465e-01_JPRB, 2.82562e-01_JPRB, &
+     & 2.57998e-01_JPRB, 2.35569e-01_JPRB, 2.15090e-01_JPRB, 1.96391e-01_JPRB, 1.79318e-01_JPRB/)
+      selfrefo(:,11) = (/ &
+     & 4.09672e-01_JPRB, 3.76237e-01_JPRB, 3.45530e-01_JPRB, 3.17329e-01_JPRB, 2.91430e-01_JPRB, &
+     & 2.67645e-01_JPRB, 2.45801e-01_JPRB, 2.25740e-01_JPRB, 2.07316e-01_JPRB, 1.90396e-01_JPRB/)
+      selfrefo(:,12) = (/ &
+     & 3.85140e-01_JPRB, 3.61989e-01_JPRB, 3.40230e-01_JPRB, 3.19779e-01_JPRB, 3.00557e-01_JPRB, &
+     & 2.82490e-01_JPRB, 2.65510e-01_JPRB, 2.49550e-01_JPRB, 2.34549e-01_JPRB, 2.20451e-01_JPRB/)
+      selfrefo(:,13) = (/ &
+     & 4.87349e-01_JPRB, 4.42192e-01_JPRB, 4.01220e-01_JPRB, 3.64044e-01_JPRB, 3.30313e-01_JPRB, &
+     & 2.99707e-01_JPRB, 2.71937e-01_JPRB, 2.46740e-01_JPRB, 2.23878e-01_JPRB, 2.03134e-01_JPRB/)
+      selfrefo(:,14) = (/ &
+     & 5.64339e-01_JPRB, 5.06194e-01_JPRB, 4.54040e-01_JPRB, 4.07259e-01_JPRB, 3.65298e-01_JPRB, &
+     & 3.27661e-01_JPRB, 2.93901e-01_JPRB, 2.63620e-01_JPRB, 2.36459e-01_JPRB, 2.12096e-01_JPRB/)
+      selfrefo(:,15) = (/ &
+     & 5.91123e-01_JPRB, 5.26420e-01_JPRB, 4.68800e-01_JPRB, 4.17486e-01_JPRB, 3.71790e-01_JPRB, &
+     & 3.31095e-01_JPRB, 2.94854e-01_JPRB, 2.62580e-01_JPRB, 2.33839e-01_JPRB, 2.08243e-01_JPRB/)
+      selfrefo(:,16) = (/ &
+     & 5.04590e-01_JPRB, 4.65235e-01_JPRB, 4.28950e-01_JPRB, 3.95495e-01_JPRB, 3.64649e-01_JPRB, &
+     & 3.36209e-01_JPRB, 3.09987e-01_JPRB, 2.85810e-01_JPRB, 2.63519e-01_JPRB, 2.42966e-01_JPRB/)
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB3',1,ZHOOK_HANDLE)
+RETURN
+
+1001 CONTINUE
+CALL ABOR1("RRTM_KGB3:ERROR READING FILE RADRRTM")
+
+END SUBROUTINE RRTM_KGB3
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb3.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb3.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb3.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_KGB3
+END SUBROUTINE RRTM_KGB3
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb4.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb4.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb4.F90	(revision 3908)
@@ -0,0 +1,229 @@
+SUBROUTINE RRTM_KGB4
+
+!     Originally by Eli J. Mlawer, Atmospheric & Environmental Research.
+!     BAND 4:  630-700 cm-1 (low - H2O,CO2; high - O3,CO2)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+!     G.Mozdzynski March 2011 read constants from files
+!     ABozzo 201306 updated to rrtmg v4.85
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+USE YOMLUN    ,ONLY : NULRAD
+USE MPL_MODULE,ONLY : MPL_BROADCAST
+USE YOMTAG    ,ONLY : MTAGRAD
+USE YOMMP0    , ONLY : NPROC, MYPROC
+
+USE YOERRTO4 , ONLY :  KAO     ,KBO     ,KAO_D,KBO_D,SELFREFO   ,FORREFO, FRACREFAO  ,FRACREFBO
+
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB4',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+  READ(NULRAD,ERR=1001) KAO_D,KBO_D
+ ! Convert the data into model actual precision.
+  KAO = REAL(KAO_D,JPRB)
+  KBO = REAL(KBO_D,JPRB) 
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KAO,MTAGRAD,1,CDSTRING='RRTM_KGB4:')
+  CALL MPL_BROADCAST (KBO,MTAGRAD,1,CDSTRING='RRTM_KGB4:')
+ENDIF
+
+
+! Planck fraction mapping level : P = 142.5940 mbar, T = 215.70 K
+      FRACREFAO(:, 1) = (/ &
+     &   1.5572E-01_JPRB,1.4925E-01_JPRB,1.4107E-01_JPRB,1.3126E-01_JPRB,1.1791E-01_JPRB,1.0173E-01_JPRB, &
+     &   8.2949E-02_JPRB,6.2393E-02_JPRB,4.2146E-02_JPRB,4.5907E-03_JPRB,3.7965E-03_JPRB,2.9744E-03_JPRB, &
+     &   2.2074E-03_JPRB,1.4063E-03_JPRB,5.3012E-04_JPRB,7.4595E-05_JPRB/)
+      FRACREFAO(:, 2) = (/ &
+     &   1.5572E-01_JPRB,1.4925E-01_JPRB,1.4107E-01_JPRB,1.3126E-01_JPRB,1.1791E-01_JPRB,1.0173E-01_JPRB, &
+     &   8.2949E-02_JPRB,6.2392E-02_JPRB,4.2146E-02_JPRB,4.5906E-03_JPRB,3.7965E-03_JPRB,2.9745E-03_JPRB, &
+     &   2.2074E-03_JPRB,1.4063E-03_JPRB,5.3012E-04_JPRB,7.4595E-05_JPRB/)
+      FRACREFAO(:, 3) = (/ &
+     &   1.5572E-01_JPRB,1.4925E-01_JPRB,1.4107E-01_JPRB,1.3126E-01_JPRB,1.1791E-01_JPRB,1.0173E-01_JPRB, &
+     &   8.2949E-02_JPRB,6.2393E-02_JPRB,4.2146E-02_JPRB,4.5907E-03_JPRB,3.7965E-03_JPRB,2.9745E-03_JPRB, &
+     &   2.2074E-03_JPRB,1.4063E-03_JPRB,5.3012E-04_JPRB,7.4595E-05_JPRB/)
+      FRACREFAO(:, 4) = (/ &
+     &   1.5572E-01_JPRB,1.4925E-01_JPRB,1.4107E-01_JPRB,1.3126E-01_JPRB,1.1791E-01_JPRB,1.0173E-01_JPRB, &
+     &   8.2949E-02_JPRB,6.2393E-02_JPRB,4.2146E-02_JPRB,4.5907E-03_JPRB,3.7964E-03_JPRB,2.9744E-03_JPRB, &
+     &   2.2074E-03_JPRB,1.4063E-03_JPRB,5.3012E-04_JPRB,7.4595E-05_JPRB/)
+      FRACREFAO(:, 5) = (/ &
+     &   1.5572E-01_JPRB,1.4925E-01_JPRB,1.4107E-01_JPRB,1.3126E-01_JPRB,1.1791E-01_JPRB,1.0173E-01_JPRB, &
+     &   8.2949E-02_JPRB,6.2393E-02_JPRB,4.2146E-02_JPRB,4.5907E-03_JPRB,3.7965E-03_JPRB,2.9744E-03_JPRB, &
+     &   2.2074E-03_JPRB,1.4063E-03_JPRB,5.3012E-04_JPRB,7.4595E-05_JPRB/)
+      FRACREFAO(:, 6) = (/ &
+     &   1.5572E-01_JPRB,1.4925E-01_JPRB,1.4107E-01_JPRB,1.3126E-01_JPRB,1.1791E-01_JPRB,1.0173E-01_JPRB, &
+     &   8.2949E-02_JPRB,6.2393E-02_JPRB,4.2146E-02_JPRB,4.5907E-03_JPRB,3.7965E-03_JPRB,2.9744E-03_JPRB, &
+     &   2.2074E-03_JPRB,1.4063E-03_JPRB,5.3012E-04_JPRB,7.4595E-05_JPRB/)
+      FRACREFAO(:, 7) = (/ &
+     &   1.5572E-01_JPRB,1.4926E-01_JPRB,1.4107E-01_JPRB,1.3126E-01_JPRB,1.1791E-01_JPRB,1.0173E-01_JPRB, &
+     &   8.2949E-02_JPRB,6.2393E-02_JPRB,4.2146E-02_JPRB,4.5908E-03_JPRB,3.7964E-03_JPRB,2.9745E-03_JPRB, &
+     &   2.2074E-03_JPRB,1.4063E-03_JPRB,5.3012E-04_JPRB,7.4595E-05_JPRB/)
+      FRACREFAO(:, 8) = (/ &
+     &   1.5571E-01_JPRB,1.4926E-01_JPRB,1.4107E-01_JPRB,1.3125E-01_JPRB,1.1791E-01_JPRB,1.0173E-01_JPRB, &
+     &   8.2949E-02_JPRB,6.2393E-02_JPRB,4.2146E-02_JPRB,4.5907E-03_JPRB,3.7964E-03_JPRB,2.9744E-03_JPRB, &
+     &   2.2074E-03_JPRB,1.4063E-03_JPRB,5.3012E-04_JPRB,7.4595E-05_JPRB/)
+      FRACREFAO(:, 9) = (/ &
+     &   1.5952E-01_JPRB,1.5155E-01_JPRB,1.4217E-01_JPRB,1.3077E-01_JPRB,1.1667E-01_JPRB,1.0048E-01_JPRB, &
+     &   8.1511E-02_JPRB,6.1076E-02_JPRB,4.1111E-02_JPRB,4.4432E-03_JPRB,3.6910E-03_JPRB,2.9076E-03_JPRB, &
+     &   2.1329E-03_JPRB,1.3566E-03_JPRB,5.2235E-04_JPRB,7.9935E-05_JPRB/)
+
+! Planck fraction mapping level : P = 95.58350 mb, T = 215.70 K
+      FRACREFBO(:, 1) = (/ &
+     &   1.5558E-01_JPRB,1.4931E-01_JPRB,1.4104E-01_JPRB,1.3124E-01_JPRB,1.1793E-01_JPRB,1.0160E-01_JPRB, &
+     &   8.3142E-02_JPRB,6.2403E-02_JPRB,4.2170E-02_JPRB,4.5935E-03_JPRB,3.7976E-03_JPRB,2.9986E-03_JPRB, &
+     &   2.1890E-03_JPRB,1.4061E-03_JPRB,5.3005E-04_JPRB,7.4587E-05_JPRB/)
+      FRACREFBO(:, 2) = (/ &
+     &   1.5558E-01_JPRB,1.4932E-01_JPRB,1.4104E-01_JPRB,1.3124E-01_JPRB,1.1792E-01_JPRB,1.0159E-01_JPRB, &
+     &   8.3142E-02_JPRB,6.2403E-02_JPRB,4.2170E-02_JPRB,4.5935E-03_JPRB,3.7976E-03_JPRB,2.9986E-03_JPRB, &
+     &   2.1890E-03_JPRB,1.4061E-03_JPRB,5.3005E-04_JPRB,7.4587E-05_JPRB/)
+      FRACREFBO(:, 3) = (/ &
+     &   1.5558E-01_JPRB,1.4933E-01_JPRB,1.4103E-01_JPRB,1.3124E-01_JPRB,1.1792E-01_JPRB,1.0159E-01_JPRB, &
+     &   8.3142E-02_JPRB,6.2403E-02_JPRB,4.2170E-02_JPRB,4.5935E-03_JPRB,3.7976E-03_JPRB,2.9986E-03_JPRB, &
+     &   2.1890E-03_JPRB,1.4061E-03_JPRB,5.3005E-04_JPRB,7.4587E-05_JPRB/)
+      FRACREFBO(:, 4) = (/ &
+     &   1.5569E-01_JPRB,1.4926E-01_JPRB,1.4102E-01_JPRB,1.3122E-01_JPRB,1.1791E-01_JPRB,1.0159E-01_JPRB, &
+     &   8.3141E-02_JPRB,6.2403E-02_JPRB,4.2170E-02_JPRB,4.5935E-03_JPRB,3.7976E-03_JPRB,2.9986E-03_JPRB, &
+     &   2.1890E-03_JPRB,1.4061E-03_JPRB,5.3005E-04_JPRB,7.4587E-05_JPRB/)
+      FRACREFBO(:, 5) = (/ &
+     &   1.5947E-01_JPRB,1.5132E-01_JPRB,1.4195E-01_JPRB,1.3061E-01_JPRB,1.1680E-01_JPRB,1.0054E-01_JPRB, &
+     &   8.1785E-02_JPRB,6.1212E-02_JPRB,4.1276E-02_JPRB,4.4424E-03_JPRB,3.6628E-03_JPRB,2.8943E-03_JPRB, &
+     &   2.1134E-03_JPRB,1.3457E-03_JPRB,5.1024E-04_JPRB,7.3998E-05_JPRB/)
+
+!     ------------------------------------------------------------------
+
+!     The array KAO contains absorption coefs for each of the 16 g-intervals
+!     for a range of pressure levels > ~100mb, temperatures, and ratios
+!     of water vapor to CO2.  The first index in the array, JS, runs
+!     from 1 to 9 and corresponds to different water vapor to CO2 ratios,
+!     as expressed through the binary species parameter eta, defined as
+!     eta = h2o/(h20 + (rat) * co2), where rat is the ratio of the integrated
+!     line strength in the band of co2 to that of h2o.  For instance,
+!     JS=1 refers to dry air (eta = 0), JS = 9 corresponds to eta = 1.0.
+!     The 2nd index in the array, JT, which runs from 1 to 5, corresponds 
+!     to different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the reference temperature TREF for this pressure 
+!     level, JT = 2 refers to the temperature TREF-15,
+!     JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
+!     to the reference pressure level (e.g. JP = 1 is for a
+!     pressure of 1053.63 mb).  The fourth index, IG, goes from 1 to 16,
+!     and tells us which g-interval the absorption coefficients are for.
+
+
+
+!     The array KBO contains absorption coefs for each of the 16 g-intervals
+!     for a range of pressure levels  < ~100mb, temperatures, and ratios
+!     of O3 to CO2.  The first index in the array, JS, runs from 1 to 6, 
+!     and corresponds to different O3 to CO2 ratios, as expressed through 
+!     the binary species parameter eta, defined as eta = O3/(O3+RAT*H2O), 
+!     where RAT is the ratio of the integrated line strength in the band 
+!     of CO2 to that of O3.  For instance, JS=1 refers to no O3 (eta = 0) 
+!     and JS = 5 corresponds to eta = 1.0.  The second index, JT, which
+!     runs from 1 to 5, corresponds to different temperatures.  More 
+!     specifically, JT = 3 means that the data are for the corresponding 
+!     reference temperature TREF for this  pressure level, JT = 2 refers 
+!     to the TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and
+!     JT = 5 is for TREF+30.  The third index, JP, runs from 13 to 59 and
+!     refers to the corresponding pressure level in PREF (e.g. JP = 13 is
+!     for a pressure of 95.5835 mb).  The fourth index, IG, goes from 1 to
+!     16, and tells us which g-interval the absorption coefficients are for.
+
+
+
+!     The array FORREFO contains the coefficient of the water vapor
+!     foreign-continuum (including the energy term).  The first 
+!     index refers to reference temperature (296,260,224,260) and 
+!     pressure (970,475,219,3 mbar) levels.  The second index 
+!     runs over the g-channel (1 to 16).
+
+      FORREFO(1,:) = (/ &
+     &3.3839E-04_JPRB,2.4739E-04_JPRB,2.2846E-04_JPRB,2.3376E-04_JPRB,2.2622E-04_JPRB,2.3188E-04_JPRB, &
+     &2.2990E-04_JPRB,2.2532E-04_JPRB,2.1233E-04_JPRB,2.0593E-04_JPRB,2.0716E-04_JPRB,2.0809E-04_JPRB, &
+     &2.0889E-04_JPRB,2.0932E-04_JPRB,2.0944E-04_JPRB,2.0945E-04_JPRB/)
+      FORREFO(2,:) = (/ &
+     &3.4391E-04_JPRB,2.6022E-04_JPRB,2.3449E-04_JPRB,2.4544E-04_JPRB,2.3831E-04_JPRB,2.3014E-04_JPRB, &
+     &2.3729E-04_JPRB,2.2726E-04_JPRB,2.1892E-04_JPRB,1.9223E-04_JPRB,2.1291E-04_JPRB,2.1406E-04_JPRB, &
+     &2.1491E-04_JPRB,2.1548E-04_JPRB,2.1562E-04_JPRB,2.1567E-04_JPRB/)
+      FORREFO(3,:) = (/ &
+     &3.4219E-04_JPRB,2.7334E-04_JPRB,2.3727E-04_JPRB,2.4515E-04_JPRB,2.5272E-04_JPRB,2.4212E-04_JPRB, &
+     &2.3824E-04_JPRB,2.3615E-04_JPRB,2.2724E-04_JPRB,2.2381E-04_JPRB,1.9634E-04_JPRB,2.1625E-04_JPRB, &
+     &2.1963E-04_JPRB,2.2032E-04_JPRB,2.2057E-04_JPRB,2.2058E-04_JPRB/)
+      FORREFO(4,:) = (/ &
+     &3.1684E-04_JPRB,2.4823E-04_JPRB,2.4890E-04_JPRB,2.4577E-04_JPRB,2.4106E-04_JPRB,2.4353E-04_JPRB, &
+     &2.4038E-04_JPRB,2.3932E-04_JPRB,2.3604E-04_JPRB,2.3773E-04_JPRB,2.4243E-04_JPRB,2.2597E-04_JPRB, &
+     &2.2879E-04_JPRB,2.2440E-04_JPRB,2.1104E-04_JPRB,2.1460E-04_JPRB/)
+
+!     The array SELFREFO contains the coefficient of the water vapor
+!     self-continuum (including the energy term).  The first index
+!     refers to temperature in 7.2 degree increments.  For instance,
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+!     etc.  The second index runs over the g-channel (1 to 16).
+
+      SELFREFO(:, 1) = (/ &
+     & 2.62922E-01_JPRB, 2.29106E-01_JPRB, 1.99640E-01_JPRB, 1.73964E-01_JPRB, 1.51589E-01_JPRB, &
+     & 1.32093E-01_JPRB, 1.15104E-01_JPRB, 1.00300E-01_JPRB, 8.74000E-02_JPRB, 7.61592E-02_JPRB/)
+      SELFREFO(:, 2) = (/ &
+     & 2.45448E-01_JPRB, 2.13212E-01_JPRB, 1.85210E-01_JPRB, 1.60886E-01_JPRB, 1.39756E-01_JPRB, &
+     & 1.21401E-01_JPRB, 1.05457E-01_JPRB, 9.16070E-02_JPRB, 7.95759E-02_JPRB, 6.91249E-02_JPRB/)
+      SELFREFO(:, 3) = (/ &
+     & 2.41595E-01_JPRB, 2.09697E-01_JPRB, 1.82010E-01_JPRB, 1.57979E-01_JPRB, 1.37121E-01_JPRB, &
+     & 1.19016E-01_JPRB, 1.03302E-01_JPRB, 8.96630E-02_JPRB, 7.78246E-02_JPRB, 6.75492E-02_JPRB/)
+      SELFREFO(:, 4) = (/ &
+     & 2.44818E-01_JPRB, 2.12172E-01_JPRB, 1.83880E-01_JPRB, 1.59360E-01_JPRB, 1.38110E-01_JPRB, &
+     & 1.19694E-01_JPRB, 1.03733E-01_JPRB, 8.99010E-02_JPRB, 7.79131E-02_JPRB, 6.75238E-02_JPRB/)
+      SELFREFO(:, 5) = (/ &
+     & 2.43458E-01_JPRB, 2.10983E-01_JPRB, 1.82840E-01_JPRB, 1.58451E-01_JPRB, 1.37315E-01_JPRB, &
+     & 1.18998E-01_JPRB, 1.03125E-01_JPRB, 8.93690E-02_JPRB, 7.74480E-02_JPRB, 6.71171E-02_JPRB/)
+      SELFREFO(:, 6) = (/ &
+     & 2.40186E-01_JPRB, 2.08745E-01_JPRB, 1.81420E-01_JPRB, 1.57672E-01_JPRB, 1.37032E-01_JPRB, &
+     & 1.19095E-01_JPRB, 1.03505E-01_JPRB, 8.99560E-02_JPRB, 7.81806E-02_JPRB, 6.79467E-02_JPRB/)
+      SELFREFO(:, 7) = (/ &
+     & 2.42752E-01_JPRB, 2.10579E-01_JPRB, 1.82670E-01_JPRB, 1.58460E-01_JPRB, 1.37459E-01_JPRB, &
+     & 1.19240E-01_JPRB, 1.03437E-01_JPRB, 8.97280E-02_JPRB, 7.78359E-02_JPRB, 6.75200E-02_JPRB/)
+      SELFREFO(:, 8) = (/ &
+     & 2.39620E-01_JPRB, 2.08166E-01_JPRB, 1.80840E-01_JPRB, 1.57101E-01_JPRB, 1.36479E-01_JPRB, &
+     & 1.18563E-01_JPRB, 1.03000E-01_JPRB, 8.94790E-02_JPRB, 7.77332E-02_JPRB, 6.75292E-02_JPRB/)
+      SELFREFO(:, 9) = (/ &
+     & 2.38856E-01_JPRB, 2.07166E-01_JPRB, 1.79680E-01_JPRB, 1.55841E-01_JPRB, 1.35165E-01_JPRB, &
+     & 1.17232E-01_JPRB, 1.01678E-01_JPRB, 8.81880E-02_JPRB, 7.64877E-02_JPRB, 6.63397E-02_JPRB/)
+      SELFREFO(:,10) = (/ &
+     & 2.29821E-01_JPRB, 2.00586E-01_JPRB, 1.75070E-01_JPRB, 1.52800E-01_JPRB, 1.33363E-01_JPRB, &
+     & 1.16398E-01_JPRB, 1.01591E-01_JPRB, 8.86680E-02_JPRB, 7.73887E-02_JPRB, 6.75443E-02_JPRB/)
+      SELFREFO(:,11) = (/ &
+     & 2.39945E-01_JPRB, 2.08186E-01_JPRB, 1.80630E-01_JPRB, 1.56722E-01_JPRB, 1.35978E-01_JPRB, &
+     & 1.17980E-01_JPRB, 1.02364E-01_JPRB, 8.88150E-02_JPRB, 7.70594E-02_JPRB, 6.68598E-02_JPRB/)
+      SELFREFO(:,12) = (/ &
+     & 2.40271E-01_JPRB, 2.08465E-01_JPRB, 1.80870E-01_JPRB, 1.56927E-01_JPRB, 1.36154E-01_JPRB, &
+     & 1.18131E-01_JPRB, 1.02494E-01_JPRB, 8.89260E-02_JPRB, 7.71545E-02_JPRB, 6.69412E-02_JPRB/)
+      SELFREFO(:,13) = (/ &
+     & 2.40503E-01_JPRB, 2.08670E-01_JPRB, 1.81050E-01_JPRB, 1.57086E-01_JPRB, 1.36294E-01_JPRB, &
+     & 1.18254E-01_JPRB, 1.02602E-01_JPRB, 8.90210E-02_JPRB, 7.72380E-02_JPRB, 6.70147E-02_JPRB/)
+      SELFREFO(:,14) = (/ &
+     & 2.40670E-01_JPRB, 2.08811E-01_JPRB, 1.81170E-01_JPRB, 1.57188E-01_JPRB, 1.36380E-01_JPRB, &
+     & 1.18327E-01_JPRB, 1.02663E-01_JPRB, 8.90730E-02_JPRB, 7.72819E-02_JPRB, 6.70517E-02_JPRB/)
+      SELFREFO(:,15) = (/ &
+     & 2.40711E-01_JPRB, 2.08846E-01_JPRB, 1.81200E-01_JPRB, 1.57213E-01_JPRB, 1.36402E-01_JPRB, &
+     & 1.18346E-01_JPRB, 1.02679E-01_JPRB, 8.90870E-02_JPRB, 7.72939E-02_JPRB, 6.70621E-02_JPRB/)
+      SELFREFO(:,16) = (/ &
+     & 2.40727E-01_JPRB, 2.08859E-01_JPRB, 1.81210E-01_JPRB, 1.57221E-01_JPRB, 1.36408E-01_JPRB, &
+     & 1.18350E-01_JPRB, 1.02682E-01_JPRB, 8.90890E-02_JPRB, 7.72952E-02_JPRB, 6.70627E-02_JPRB/)
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB4',1,ZHOOK_HANDLE)
+RETURN
+
+1001 CONTINUE
+CALL ABOR1("RRTM_KGB4:ERROR READING FILE RADRRTM")
+
+END SUBROUTINE RRTM_KGB4
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb4.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb4.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb4.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_KGB4
+END SUBROUTINE RRTM_KGB4
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb5.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb5.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb5.F90	(revision 3908)
@@ -0,0 +1,972 @@
+SUBROUTINE RRTM_KGB5
+
+!     Originally by Eli J. Mlawer, Atmospheric & Environmental Research.
+!     BAND 5:  700-820 cm-1 (low - H2O,CO2; high - O3,CO2)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     R. Elkhatib 12-10-2005 Split for faster and more robust compilation
+!     G.Mozdzynski March 2011 read constants from files
+!     ABozzo 201306 updated to rrtmg v4.85
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+USE YOMLUN    ,ONLY : NULRAD
+USE MPL_MODULE,ONLY : MPL_BROADCAST
+USE YOMTAG    ,ONLY : MTAGRAD
+
+USE YOERRTO5 , ONLY : KAO     ,KBO     ,KAO_D,KBO_D,SELFREFO   ,FORREFO, FRACREFAO  ,&
+ & FRACREFBO, CCL4O  , KAO_MO3
+
+USE YOMMP0    , ONLY : NPROC, MYPROC
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB5',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+  READ(NULRAD,ERR=1001) KAO_D,KBO_D
+ ! Convert the data into model actual precision.
+  KAO = REAL(KAO_D,JPRB)
+  KBO = REAL(KBO_D,JPRB) 
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KAO,MTAGRAD,1,CDSTRING='RRTM_KGB5:')
+  CALL MPL_BROADCAST (KBO,MTAGRAD,1,CDSTRING='RRTM_KGB5:')
+ENDIF
+
+
+! Planck fraction mapping level : P = 473.42 mb, T = 259.83
+      FRACREFAO(:, 1) = (/ &
+       & 1.4111E-01_JPRB,1.4222E-01_JPRB,1.3802E-01_JPRB,1.3101E-01_JPRB,1.2244E-01_JPRB,1.0691E-01_JPRB, &
+       & 8.8703E-02_JPRB,6.7130E-02_JPRB,4.5509E-02_JPRB,4.9866E-03_JPRB,4.1214E-03_JPRB,3.2557E-03_JPRB, &
+       & 2.3805E-03_JPRB,1.5450E-03_JPRB,5.8423E-04_JPRB,8.2275E-05_JPRB/)
+      FRACREFAO(:, 2) = (/ &
+       & 1.4152E-01_JPRB,1.4271E-01_JPRB,1.3784E-01_JPRB,1.3075E-01_JPRB,1.2215E-01_JPRB,1.0674E-01_JPRB, &
+       & 8.8686E-02_JPRB,6.7135E-02_JPRB,4.5508E-02_JPRB,4.9866E-03_JPRB,4.1214E-03_JPRB,3.2558E-03_JPRB, &
+       & 2.3805E-03_JPRB,1.5450E-03_JPRB,5.8423E-04_JPRB,8.2275E-05_JPRB/)
+      FRACREFAO(:, 3) = (/ &
+       & 1.4159E-01_JPRB,1.4300E-01_JPRB,1.3781E-01_JPRB,1.3094E-01_JPRB,1.2192E-01_JPRB,1.0661E-01_JPRB, &
+       & 8.8529E-02_JPRB,6.7127E-02_JPRB,4.5511E-02_JPRB,4.9877E-03_JPRB,4.1214E-03_JPRB,3.2558E-03_JPRB, &
+       & 2.3805E-03_JPRB,1.5450E-03_JPRB,5.8423E-04_JPRB,8.2275E-05_JPRB/)
+      FRACREFAO(:, 4) = (/ &
+       & 1.4162E-01_JPRB,1.4337E-01_JPRB,1.3774E-01_JPRB,1.3122E-01_JPRB,1.2172E-01_JPRB,1.0641E-01_JPRB, &
+       & 8.8384E-02_JPRB,6.7056E-02_JPRB,4.5514E-02_JPRB,4.9880E-03_JPRB,4.1214E-03_JPRB,3.2557E-03_JPRB, &
+       & 2.3805E-03_JPRB,1.5450E-03_JPRB,5.8423E-04_JPRB,8.2275E-05_JPRB/)
+      FRACREFAO(:, 5) = (/ &
+       & 1.4161E-01_JPRB,1.4370E-01_JPRB,1.3770E-01_JPRB,1.3143E-01_JPRB,1.2173E-01_JPRB,1.0613E-01_JPRB, &
+       & 8.8357E-02_JPRB,6.6874E-02_JPRB,4.5509E-02_JPRB,4.9883E-03_JPRB,4.1214E-03_JPRB,3.2558E-03_JPRB, &
+       & 2.3804E-03_JPRB,1.5450E-03_JPRB,5.8423E-04_JPRB,8.2275E-05_JPRB/)
+      FRACREFAO(:, 6) = (/ &
+       & 1.4154E-01_JPRB,1.4405E-01_JPRB,1.3771E-01_JPRB,1.3169E-01_JPRB,1.2166E-01_JPRB,1.0603E-01_JPRB, &
+       & 8.8193E-02_JPRB,6.6705E-02_JPRB,4.5469E-02_JPRB,4.9902E-03_JPRB,4.1214E-03_JPRB,3.2558E-03_JPRB, &
+       & 2.3804E-03_JPRB,1.5450E-03_JPRB,5.8423E-04_JPRB,8.2275E-05_JPRB/)
+      FRACREFAO(:, 7) = (/ &
+       & 1.4126E-01_JPRB,1.4440E-01_JPRB,1.3790E-01_JPRB,1.3214E-01_JPRB,1.2153E-01_JPRB,1.0603E-01_JPRB, &
+       & 8.7908E-02_JPRB,6.6612E-02_JPRB,4.5269E-02_JPRB,4.9900E-03_JPRB,4.1256E-03_JPRB,3.2558E-03_JPRB, &
+       & 2.3804E-03_JPRB,1.5451E-03_JPRB,5.8423E-04_JPRB,8.2275E-05_JPRB/)
+      FRACREFAO(:, 8) = (/ &
+       & 1.4076E-01_JPRB,1.4415E-01_JPRB,1.3885E-01_JPRB,1.3286E-01_JPRB,1.2147E-01_JPRB,1.0612E-01_JPRB, &
+       & 8.7579E-02_JPRB,6.6280E-02_JPRB,4.4977E-02_JPRB,4.9782E-03_JPRB,4.1200E-03_JPRB,3.2620E-03_JPRB, &
+       & 2.3820E-03_JPRB,1.5452E-03_JPRB,5.8423E-04_JPRB,8.2275E-05_JPRB/)
+      FRACREFAO(:, 9) = (/ &
+       & 1.4205E-01_JPRB,1.4496E-01_JPRB,1.4337E-01_JPRB,1.3504E-01_JPRB,1.2260E-01_JPRB,1.0428E-01_JPRB, &
+       & 8.4946E-02_JPRB,6.3625E-02_JPRB,4.2951E-02_JPRB,4.7313E-03_JPRB,3.9157E-03_JPRB,3.0879E-03_JPRB, &
+       & 2.2666E-03_JPRB,1.5193E-03_JPRB,5.7469E-04_JPRB,8.1674E-05_JPRB/)
+
+! Planck fraction mapping level : P = 0.2369280 mbar, T = 253.60 K
+      FRACREFBO(:, 1) = (/ &
+       & 1.4075E-01_JPRB,1.4196E-01_JPRB,1.3833E-01_JPRB,1.3345E-01_JPRB,1.2234E-01_JPRB,1.0718E-01_JPRB, &
+       & 8.8004E-02_JPRB,6.6308E-02_JPRB,4.5028E-02_JPRB,4.9029E-03_JPRB,4.0377E-03_JPRB,3.1870E-03_JPRB, &
+       & 2.3503E-03_JPRB,1.5146E-03_JPRB,5.7165E-04_JPRB,8.2371E-05_JPRB/)
+      FRACREFBO(:, 2) = (/ &
+       & 1.4081E-01_JPRB,1.4225E-01_JPRB,1.3890E-01_JPRB,1.3410E-01_JPRB,1.2254E-01_JPRB,1.0680E-01_JPRB, &
+       & 8.7391E-02_JPRB,6.5819E-02_JPRB,4.4725E-02_JPRB,4.9121E-03_JPRB,4.0420E-03_JPRB,3.1869E-03_JPRB, &
+       & 2.3504E-03_JPRB,1.5146E-03_JPRB,5.7165E-04_JPRB,8.2371E-05_JPRB/)
+      FRACREFBO(:, 3) = (/ &
+       & 1.4087E-01_JPRB,1.4227E-01_JPRB,1.3920E-01_JPRB,1.3395E-01_JPRB,1.2270E-01_JPRB,1.0694E-01_JPRB, &
+       & 8.7229E-02_JPRB,6.5653E-02_JPRB,4.4554E-02_JPRB,4.8797E-03_JPRB,4.0460E-03_JPRB,3.1939E-03_JPRB, &
+       & 2.3505E-03_JPRB,1.5146E-03_JPRB,5.7165E-04_JPRB,8.1910E-05_JPRB/)
+      FRACREFBO(:, 4) = (/ &
+       & 1.4089E-01_JPRB,1.4238E-01_JPRB,1.3956E-01_JPRB,1.3379E-01_JPRB,1.2284E-01_JPRB,1.0688E-01_JPRB, &
+       & 8.7192E-02_JPRB,6.5490E-02_JPRB,4.4390E-02_JPRB,4.8395E-03_JPRB,4.0173E-03_JPRB,3.2070E-03_JPRB, &
+       & 2.3559E-03_JPRB,1.5146E-03_JPRB,5.7165E-04_JPRB,8.2371E-05_JPRB/)
+      FRACREFBO(:, 5) = (/ &
+       & 1.4091E-01_JPRB,1.4417E-01_JPRB,1.4194E-01_JPRB,1.3457E-01_JPRB,1.2167E-01_JPRB,1.0551E-01_JPRB, &
+       & 8.6450E-02_JPRB,6.4889E-02_JPRB,4.3584E-02_JPRB,4.7551E-03_JPRB,3.9509E-03_JPRB,3.1374E-03_JPRB, &
+       & 2.3226E-03_JPRB,1.4942E-03_JPRB,5.7545E-04_JPRB,8.0887E-05_JPRB/)
+
+
+
+CCL4O( :) = (/&
+ & 26.1407_JPRB,  53.9776_JPRB,  63.8085_JPRB,  36.1701_JPRB,&
+ & 15.4099_JPRB, 10.23116_JPRB,  4.82948_JPRB,  5.03836_JPRB,&
+ & 1.75558_JPRB,  0.0_JPRB     ,  0.0_JPRB     ,  0.0_JPRB     ,&
+ & 0.0_JPRB     ,  0.0_JPRB     ,  0.0_JPRB     ,  0.0_JPRB      /)  
+
+
+!     ------------------------------------------------------------------
+
+!     The array KAO contains absorption coefs for each of the 16 g-intervals
+!     for a range of pressure levels > ~100mb, temperatures, and ratios
+!     of water vapor to CO2.  The first index in the array, JS, runs
+!     from 1 to 9 and corresponds to different water vapor to CO2 ratios,
+!     as expressed through the binary species parameter eta, defined as
+!     eta = h2o/(h20 + (rat) * co2), where rat is the ratio of the integrated
+!     line strength in the band of co2 to that of h2o.  For instance,
+!     JS=1 refers to dry air (eta = 0), JS = 9 corresponds to eta = 1.0.
+!     The 2nd index in the array, JT, which runs from 1 to 5, corresponds 
+!     to different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the reference temperature TREF for this  pressure 
+!     level, JT = 2 refers to the temperature TREF-15, 
+!     JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
+!     to the reference pressure level (e.g. JP = 1 is for a
+!     pressure of 1053.63 mb).  The fourth index, IG, goes from 1 to 16,
+!     and tells us which g-interval the absorption coefficients are for.
+
+
+
+!     The array KB contains absorption coefs for each of the 16 g-intervals
+!     for a range of pressure levels  < ~100mb, temperatures, and ratios
+!     of O3 to CO2.  The first index in the array, JS, runs from 1 to 5, 
+!     and corresponds to different O3 to CO2 ratios, as expressed through 
+!     the binary species parameter eta, defined as eta = O3/(O3+RAT*CO2), 
+!     where RAT is the ratio of the integrated line strength in the band 
+!     of co2 to that of O3.  For instance, JS=1 refers to no O3 (eta = 0) 
+!     and JS = 5 corresponds to eta = 1.0.  The second index, JT, which
+!     runs from 1 to 5, corresponds to different temperatures.  More 
+!     specifically, JT = 3 means that the data are for the corresponding 
+!     reference temperature TREF for this  pressure level, JT = 2 refers 
+!     to the TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and
+!     JT = 5 is for TREF+30.  The third index, JP, runs from 13 to 59 and
+!     refers to the corresponding pressure level in PREF (e.g. JP = 13 is
+!     for a pressure of 95.5835 mb).  The fourth index, IG, goes from 1 to
+!     16, and tells us which g-interval the absorption coefficients are for.
+
+
+
+!     The array KAO_Mxx contains the absorption coefficient for 
+!     a minor species at the 16 chosen g-values for a reference pressure
+!     level below 100~ mb.   The first index in the array, JS, runs
+!     from 1 to 10, and corresponds to different gas column amount ratios,
+!     as expressed through the binary species parameter eta, defined as
+!     eta = gas1/(gas1 + (rat) * gas2), where rat is the 
+!     ratio of the reference MLS column amount value of gas 1 
+!     to that of gas2.  The second index refers to temperature 
+!     in 7.2 degree increments.  For instance, JT = 1 refers to a 
+!     temperature of 188.0, JT = 2 refers to 195.2, etc. The third index 
+!     runs over the g-channel (1 to 16).
+
+      KAO_MO3( 1, :, 1) = (/ &
+     & 9.31040E-03_JPRB, 1.01286E-02_JPRB, 1.10186E-02_JPRB, 1.19869E-02_JPRB, 1.30403E-02_JPRB, &
+     & 1.41862E-02_JPRB, 1.54328E-02_JPRB, 1.67890E-02_JPRB, 1.82644E-02_JPRB, 1.98694E-02_JPRB, &
+     & 2.16154E-02_JPRB, 2.35149E-02_JPRB, 2.55813E-02_JPRB, 2.78293E-02_JPRB, 3.02749E-02_JPRB, &
+     & 3.29353E-02_JPRB, 3.58295E-02_JPRB, 3.89781E-02_JPRB, 4.24034E-02_JPRB/)
+      KAO_MO3( 2, :, 1) = (/ &
+     & 1.11200E-02_JPRB, 1.20461E-02_JPRB, 1.30493E-02_JPRB, 1.41360E-02_JPRB, 1.53133E-02_JPRB, &
+     & 1.65886E-02_JPRB, 1.79701E-02_JPRB, 1.94666E-02_JPRB, 2.10878E-02_JPRB, 2.28440E-02_JPRB, &
+     & 2.47465E-02_JPRB, 2.68074E-02_JPRB, 2.90399E-02_JPRB, 3.14583E-02_JPRB, 3.40782E-02_JPRB, &
+     & 3.69162E-02_JPRB, 3.99907E-02_JPRB, 4.33211E-02_JPRB, 4.69289E-02_JPRB/)
+      KAO_MO3( 3, :, 1) = (/ &
+     & 1.21630E-02_JPRB, 1.31401E-02_JPRB, 1.41956E-02_JPRB, 1.53359E-02_JPRB, 1.65679E-02_JPRB, &
+     & 1.78988E-02_JPRB, 1.93366E-02_JPRB, 2.08899E-02_JPRB, 2.25680E-02_JPRB, 2.43808E-02_JPRB, &
+     & 2.63394E-02_JPRB, 2.84552E-02_JPRB, 3.07410E-02_JPRB, 3.32104E-02_JPRB, 3.58782E-02_JPRB, &
+     & 3.87603E-02_JPRB, 4.18739E-02_JPRB, 4.52377E-02_JPRB, 4.88716E-02_JPRB/)
+      KAO_MO3( 4, :, 1) = (/ &
+     & 1.26231E-02_JPRB, 1.36243E-02_JPRB, 1.47049E-02_JPRB, 1.58713E-02_JPRB, 1.71301E-02_JPRB, &
+     & 1.84888E-02_JPRB, 1.99553E-02_JPRB, 2.15380E-02_JPRB, 2.32463E-02_JPRB, 2.50901E-02_JPRB, &
+     & 2.70801E-02_JPRB, 2.92280E-02_JPRB, 3.15463E-02_JPRB, 3.40484E-02_JPRB, 3.67489E-02_JPRB, &
+     & 3.96637E-02_JPRB, 4.28097E-02_JPRB, 4.62051E-02_JPRB, 4.98699E-02_JPRB/)
+      KAO_MO3( 5, :, 1) = (/ &
+     & 1.33345E-02_JPRB, 1.43736E-02_JPRB, 1.54938E-02_JPRB, 1.67012E-02_JPRB, 1.80027E-02_JPRB, &
+     & 1.94057E-02_JPRB, 2.09180E-02_JPRB, 2.25481E-02_JPRB, 2.43053E-02_JPRB, 2.61994E-02_JPRB, &
+     & 2.82411E-02_JPRB, 3.04419E-02_JPRB, 3.28142E-02_JPRB, 3.53714E-02_JPRB, 3.81279E-02_JPRB, &
+     & 4.10992E-02_JPRB, 4.43021E-02_JPRB, 4.77545E-02_JPRB, 5.14760E-02_JPRB/)
+      KAO_MO3( 6, :, 1) = (/ &
+     & 1.43294E-02_JPRB, 1.54133E-02_JPRB, 1.65791E-02_JPRB, 1.78331E-02_JPRB, 1.91819E-02_JPRB, &
+     & 2.06328E-02_JPRB, 2.21935E-02_JPRB, 2.38721E-02_JPRB, 2.56778E-02_JPRB, 2.76200E-02_JPRB, &
+     & 2.97091E-02_JPRB, 3.19562E-02_JPRB, 3.43733E-02_JPRB, 3.69732E-02_JPRB, 3.97698E-02_JPRB, &
+     & 4.27779E-02_JPRB, 4.60136E-02_JPRB, 4.94939E-02_JPRB, 5.32375E-02_JPRB/)
+      KAO_MO3( 7, :, 1) = (/ &
+     & 1.48298E-02_JPRB, 1.59503E-02_JPRB, 1.71554E-02_JPRB, 1.84517E-02_JPRB, 1.98458E-02_JPRB, &
+     & 2.13453E-02_JPRB, 2.29581E-02_JPRB, 2.46928E-02_JPRB, 2.65585E-02_JPRB, 2.85652E-02_JPRB, &
+     & 3.07235E-02_JPRB, 3.30449E-02_JPRB, 3.55417E-02_JPRB, 3.82272E-02_JPRB, 4.11155E-02_JPRB, &
+     & 4.42221E-02_JPRB, 4.75634E-02_JPRB, 5.11572E-02_JPRB, 5.50225E-02_JPRB/)
+      KAO_MO3( 8, :, 1) = (/ &
+     & 1.41792E-02_JPRB, 1.53141E-02_JPRB, 1.65398E-02_JPRB, 1.78637E-02_JPRB, 1.92935E-02_JPRB, &
+     & 2.08378E-02_JPRB, 2.25057E-02_JPRB, 2.43071E-02_JPRB, 2.62526E-02_JPRB, 2.83539E-02_JPRB, &
+     & 3.06234E-02_JPRB, 3.30745E-02_JPRB, 3.57218E-02_JPRB, 3.85810E-02_JPRB, 4.16690E-02_JPRB, &
+     & 4.50042E-02_JPRB, 4.86064E-02_JPRB, 5.24969E-02_JPRB, 5.66988E-02_JPRB/)
+      KAO_MO3( 9, :, 1) = (/ &
+     & 8.82784E-03_JPRB, 9.48321E-03_JPRB, 1.01872E-02_JPRB, 1.09435E-02_JPRB, 1.17560E-02_JPRB, &
+     & 1.26287E-02_JPRB, 1.35662E-02_JPRB, 1.45734E-02_JPRB, 1.56553E-02_JPRB, 1.68175E-02_JPRB, &
+     & 1.80660E-02_JPRB, 1.94072E-02_JPRB, 2.08480E-02_JPRB, 2.23958E-02_JPRB, 2.40584E-02_JPRB, &
+     & 2.58445E-02_JPRB, 2.77631E-02_JPRB, 2.98242E-02_JPRB, 3.20383E-02_JPRB/)
+      KAO_MO3( 1, :, 2) = (/ &
+     & 4.28238E-02_JPRB, 4.51015E-02_JPRB, 4.75003E-02_JPRB, 5.00266E-02_JPRB, 5.26873E-02_JPRB, &
+     & 5.54896E-02_JPRB, 5.84409E-02_JPRB, 6.15491E-02_JPRB, 6.48227E-02_JPRB, 6.82704E-02_JPRB, &
+     & 7.19014E-02_JPRB, 7.57256E-02_JPRB, 7.97532E-02_JPRB, 8.39949E-02_JPRB, 8.84623E-02_JPRB, &
+     & 9.31673E-02_JPRB, 9.81225E-02_JPRB, 1.03341E-01_JPRB, 1.08838E-01_JPRB/)
+      KAO_MO3( 2, :, 2) = (/ &
+     & 4.83672E-02_JPRB, 5.07219E-02_JPRB, 5.31911E-02_JPRB, 5.57806E-02_JPRB, 5.84962E-02_JPRB, &
+     & 6.13440E-02_JPRB, 6.43303E-02_JPRB, 6.74621E-02_JPRB, 7.07464E-02_JPRB, 7.41905E-02_JPRB, &
+     & 7.78023E-02_JPRB, 8.15899E-02_JPRB, 8.55619E-02_JPRB, 8.97273E-02_JPRB, 9.40955E-02_JPRB, &
+     & 9.86763E-02_JPRB, 1.03480E-01_JPRB, 1.08518E-01_JPRB, 1.13801E-01_JPRB/)
+      KAO_MO3( 3, :, 2) = (/ &
+     & 5.24315E-02_JPRB, 5.48650E-02_JPRB, 5.74115E-02_JPRB, 6.00762E-02_JPRB, 6.28645E-02_JPRB, &
+     & 6.57822E-02_JPRB, 6.88354E-02_JPRB, 7.20302E-02_JPRB, 7.53734E-02_JPRB, 7.88717E-02_JPRB, &
+     & 8.25324E-02_JPRB, 8.63630E-02_JPRB, 9.03714E-02_JPRB, 9.45658E-02_JPRB, 9.89549E-02_JPRB, &
+     & 1.03548E-01_JPRB, 1.08354E-01_JPRB, 1.13383E-01_JPRB, 1.18645E-01_JPRB/)
+      KAO_MO3( 4, :, 2) = (/ &
+     & 5.65191E-02_JPRB, 5.90383E-02_JPRB, 6.16699E-02_JPRB, 6.44187E-02_JPRB, 6.72901E-02_JPRB, &
+     & 7.02894E-02_JPRB, 7.34224E-02_JPRB, 7.66951E-02_JPRB, 8.01137E-02_JPRB, 8.36846E-02_JPRB, &
+     & 8.74147E-02_JPRB, 9.13111E-02_JPRB, 9.53812E-02_JPRB, 9.96326E-02_JPRB, 1.04074E-01_JPRB, &
+     & 1.08712E-01_JPRB, 1.13558E-01_JPRB, 1.18620E-01_JPRB, 1.23907E-01_JPRB/)
+      KAO_MO3( 5, :, 2) = (/ &
+     & 6.03171E-02_JPRB, 6.29114E-02_JPRB, 6.56172E-02_JPRB, 6.84394E-02_JPRB, 7.13830E-02_JPRB, &
+     & 7.44532E-02_JPRB, 7.76555E-02_JPRB, 8.09955E-02_JPRB, 8.44791E-02_JPRB, 8.81125E-02_JPRB, &
+     & 9.19023E-02_JPRB, 9.58550E-02_JPRB, 9.99778E-02_JPRB, 1.04278E-01_JPRB, 1.08763E-01_JPRB, &
+     & 1.13441E-01_JPRB, 1.18320E-01_JPRB, 1.23409E-01_JPRB, 1.28717E-01_JPRB/)
+      KAO_MO3( 6, :, 2) = (/ &
+     & 6.51092E-02_JPRB, 6.77827E-02_JPRB, 7.05660E-02_JPRB, 7.34635E-02_JPRB, 7.64801E-02_JPRB, &
+     & 7.96204E-02_JPRB, 8.28898E-02_JPRB, 8.62934E-02_JPRB, 8.98367E-02_JPRB, 9.35255E-02_JPRB, &
+     & 9.73658E-02_JPRB, 1.01364E-01_JPRB, 1.05526E-01_JPRB, 1.09859E-01_JPRB, 1.14370E-01_JPRB, &
+     & 1.19066E-01_JPRB, 1.23955E-01_JPRB, 1.29045E-01_JPRB, 1.34344E-01_JPRB/)
+      KAO_MO3( 7, :, 2) = (/ &
+     & 7.09653E-02_JPRB, 7.37378E-02_JPRB, 7.66187E-02_JPRB, 7.96121E-02_JPRB, 8.27225E-02_JPRB, &
+     & 8.59543E-02_JPRB, 8.93125E-02_JPRB, 9.28018E-02_JPRB, 9.64275E-02_JPRB, 1.00195E-01_JPRB, &
+     & 1.04109E-01_JPRB, 1.08177E-01_JPRB, 1.12403E-01_JPRB, 1.16795E-01_JPRB, 1.21358E-01_JPRB, &
+     & 1.26099E-01_JPRB, 1.31026E-01_JPRB, 1.36145E-01_JPRB, 1.41464E-01_JPRB/)
+      KAO_MO3( 8, :, 2) = (/ &
+     & 7.69193E-02_JPRB, 7.97926E-02_JPRB, 8.27733E-02_JPRB, 8.58653E-02_JPRB, 8.90728E-02_JPRB, &
+     & 9.24002E-02_JPRB, 9.58518E-02_JPRB, 9.94324E-02_JPRB, 1.03147E-01_JPRB, 1.07000E-01_JPRB, &
+     & 1.10997E-01_JPRB, 1.15143E-01_JPRB, 1.19444E-01_JPRB, 1.23906E-01_JPRB, 1.28535E-01_JPRB, &
+     & 1.33336E-01_JPRB, 1.38317E-01_JPRB, 1.43484E-01_JPRB, 1.48844E-01_JPRB/)
+      KAO_MO3( 9, :, 2) = (/ &
+     & 4.57962E-02_JPRB, 4.76027E-02_JPRB, 4.94805E-02_JPRB, 5.14323E-02_JPRB, 5.34611E-02_JPRB, &
+     & 5.55700E-02_JPRB, 5.77620E-02_JPRB, 6.00405E-02_JPRB, 6.24089E-02_JPRB, 6.48707E-02_JPRB, &
+     & 6.74296E-02_JPRB, 7.00895E-02_JPRB, 7.28542E-02_JPRB, 7.57281E-02_JPRB, 7.87153E-02_JPRB, &
+     & 8.18203E-02_JPRB, 8.50478E-02_JPRB, 8.84027E-02_JPRB, 9.18898E-02_JPRB/)
+      KAO_MO3( 1, :, 3) = (/ &
+     & 1.12607E-01_JPRB, 1.16047E-01_JPRB, 1.19591E-01_JPRB, 1.23244E-01_JPRB, 1.27009E-01_JPRB, &
+     & 1.30888E-01_JPRB, 1.34886E-01_JPRB, 1.39006E-01_JPRB, 1.43252E-01_JPRB, 1.47628E-01_JPRB, &
+     & 1.52137E-01_JPRB, 1.56785E-01_JPRB, 1.61574E-01_JPRB, 1.66509E-01_JPRB, 1.71595E-01_JPRB, &
+     & 1.76836E-01_JPRB, 1.82238E-01_JPRB, 1.87804E-01_JPRB, 1.93541E-01_JPRB/)
+      KAO_MO3( 2, :, 3) = (/ &
+     & 1.14531E-01_JPRB, 1.17850E-01_JPRB, 1.21266E-01_JPRB, 1.24781E-01_JPRB, 1.28397E-01_JPRB, &
+     & 1.32119E-01_JPRB, 1.35948E-01_JPRB, 1.39888E-01_JPRB, 1.43943E-01_JPRB, 1.48115E-01_JPRB, &
+     & 1.52407E-01_JPRB, 1.56825E-01_JPRB, 1.61370E-01_JPRB, 1.66047E-01_JPRB, 1.70860E-01_JPRB, &
+     & 1.75812E-01_JPRB, 1.80907E-01_JPRB, 1.86150E-01_JPRB, 1.91546E-01_JPRB/)
+      KAO_MO3( 3, :, 3) = (/ &
+     & 1.13986E-01_JPRB, 1.17222E-01_JPRB, 1.20551E-01_JPRB, 1.23974E-01_JPRB, 1.27494E-01_JPRB, &
+     & 1.31114E-01_JPRB, 1.34837E-01_JPRB, 1.38666E-01_JPRB, 1.42604E-01_JPRB, 1.46653E-01_JPRB, &
+     & 1.50817E-01_JPRB, 1.55099E-01_JPRB, 1.59503E-01_JPRB, 1.64032E-01_JPRB, 1.68690E-01_JPRB, &
+     & 1.73480E-01_JPRB, 1.78406E-01_JPRB, 1.83472E-01_JPRB, 1.88682E-01_JPRB/)
+      KAO_MO3( 4, :, 3) = (/ &
+     & 1.13713E-01_JPRB, 1.16892E-01_JPRB, 1.20160E-01_JPRB, 1.23519E-01_JPRB, 1.26972E-01_JPRB, &
+     & 1.30522E-01_JPRB, 1.34171E-01_JPRB, 1.37922E-01_JPRB, 1.41778E-01_JPRB, 1.45742E-01_JPRB, &
+     & 1.49817E-01_JPRB, 1.54005E-01_JPRB, 1.58311E-01_JPRB, 1.62737E-01_JPRB, 1.67287E-01_JPRB, &
+     & 1.71964E-01_JPRB, 1.76771E-01_JPRB, 1.81714E-01_JPRB, 1.86794E-01_JPRB/)
+      KAO_MO3( 5, :, 3) = (/ &
+     & 1.12321E-01_JPRB, 1.15413E-01_JPRB, 1.18591E-01_JPRB, 1.21856E-01_JPRB, 1.25211E-01_JPRB, &
+     & 1.28658E-01_JPRB, 1.32200E-01_JPRB, 1.35840E-01_JPRB, 1.39580E-01_JPRB, 1.43423E-01_JPRB, &
+     & 1.47372E-01_JPRB, 1.51429E-01_JPRB, 1.55599E-01_JPRB, 1.59883E-01_JPRB, 1.64284E-01_JPRB, &
+     & 1.68808E-01_JPRB, 1.73455E-01_JPRB, 1.78231E-01_JPRB, 1.83138E-01_JPRB/)
+      KAO_MO3( 6, :, 3) = (/ &
+     & 1.14158E-01_JPRB, 1.17218E-01_JPRB, 1.20360E-01_JPRB, 1.23586E-01_JPRB, 1.26899E-01_JPRB, &
+     & 1.30300E-01_JPRB, 1.33793E-01_JPRB, 1.37379E-01_JPRB, 1.41061E-01_JPRB, 1.44842E-01_JPRB, &
+     & 1.48724E-01_JPRB, 1.52711E-01_JPRB, 1.56804E-01_JPRB, 1.61007E-01_JPRB, 1.65322E-01_JPRB, &
+     & 1.69754E-01_JPRB, 1.74304E-01_JPRB, 1.78976E-01_JPRB, 1.83773E-01_JPRB/)
+      KAO_MO3( 7, :, 3) = (/ &
+     & 1.21015E-01_JPRB, 1.23989E-01_JPRB, 1.27036E-01_JPRB, 1.30157E-01_JPRB, 1.33355E-01_JPRB, &
+     & 1.36632E-01_JPRB, 1.39990E-01_JPRB, 1.43429E-01_JPRB, 1.46954E-01_JPRB, 1.50565E-01_JPRB, &
+     & 1.54264E-01_JPRB, 1.58055E-01_JPRB, 1.61939E-01_JPRB, 1.65918E-01_JPRB, 1.69995E-01_JPRB, &
+     & 1.74172E-01_JPRB, 1.78452E-01_JPRB, 1.82836E-01_JPRB, 1.87329E-01_JPRB/)
+      KAO_MO3( 8, :, 3) = (/ &
+     & 1.33952E-01_JPRB, 1.36939E-01_JPRB, 1.39992E-01_JPRB, 1.43114E-01_JPRB, 1.46305E-01_JPRB, &
+     & 1.49567E-01_JPRB, 1.52902E-01_JPRB, 1.56311E-01_JPRB, 1.59797E-01_JPRB, 1.63360E-01_JPRB, &
+     & 1.67002E-01_JPRB, 1.70726E-01_JPRB, 1.74533E-01_JPRB, 1.78424E-01_JPRB, 1.82403E-01_JPRB, &
+     & 1.86470E-01_JPRB, 1.90627E-01_JPRB, 1.94878E-01_JPRB, 1.99223E-01_JPRB/)
+      KAO_MO3( 9, :, 3) = (/ &
+     & 1.01003E-01_JPRB, 1.03713E-01_JPRB, 1.06495E-01_JPRB, 1.09352E-01_JPRB, 1.12285E-01_JPRB, &
+     & 1.15297E-01_JPRB, 1.18390E-01_JPRB, 1.21566E-01_JPRB, 1.24827E-01_JPRB, 1.28176E-01_JPRB, &
+     & 1.31614E-01_JPRB, 1.35145E-01_JPRB, 1.38770E-01_JPRB, 1.42493E-01_JPRB, 1.46315E-01_JPRB, &
+     & 1.50240E-01_JPRB, 1.54271E-01_JPRB, 1.58409E-01_JPRB, 1.62659E-01_JPRB/)
+      KAO_MO3( 1, :, 4) = (/ &
+     & 2.35597E-01_JPRB, 2.37975E-01_JPRB, 2.40376E-01_JPRB, 2.42802E-01_JPRB, 2.45253E-01_JPRB, &
+     & 2.47728E-01_JPRB, 2.50228E-01_JPRB, 2.52753E-01_JPRB, 2.55304E-01_JPRB, 2.57881E-01_JPRB, &
+     & 2.60483E-01_JPRB, 2.63112E-01_JPRB, 2.65767E-01_JPRB, 2.68450E-01_JPRB, 2.71159E-01_JPRB, &
+     & 2.73895E-01_JPRB, 2.76660E-01_JPRB, 2.79452E-01_JPRB, 2.82272E-01_JPRB/)
+      KAO_MO3( 2, :, 4) = (/ &
+     & 2.27965E-01_JPRB, 2.30334E-01_JPRB, 2.32728E-01_JPRB, 2.35146E-01_JPRB, 2.37590E-01_JPRB, &
+     & 2.40059E-01_JPRB, 2.42554E-01_JPRB, 2.45075E-01_JPRB, 2.47621E-01_JPRB, 2.50195E-01_JPRB, &
+     & 2.52795E-01_JPRB, 2.55422E-01_JPRB, 2.58077E-01_JPRB, 2.60759E-01_JPRB, 2.63468E-01_JPRB, &
+     & 2.66206E-01_JPRB, 2.68973E-01_JPRB, 2.71768E-01_JPRB, 2.74593E-01_JPRB/)
+      KAO_MO3( 3, :, 4) = (/ &
+     & 2.25956E-01_JPRB, 2.28277E-01_JPRB, 2.30622E-01_JPRB, 2.32991E-01_JPRB, 2.35384E-01_JPRB, &
+     & 2.37802E-01_JPRB, 2.40244E-01_JPRB, 2.42712E-01_JPRB, 2.45205E-01_JPRB, 2.47724E-01_JPRB, &
+     & 2.50268E-01_JPRB, 2.52839E-01_JPRB, 2.55436E-01_JPRB, 2.58060E-01_JPRB, 2.60711E-01_JPRB, &
+     & 2.63389E-01_JPRB, 2.66094E-01_JPRB, 2.68827E-01_JPRB, 2.71589E-01_JPRB/)
+      KAO_MO3( 4, :, 4) = (/ &
+     & 2.28371E-01_JPRB, 2.30595E-01_JPRB, 2.32840E-01_JPRB, 2.35107E-01_JPRB, 2.37397E-01_JPRB, &
+     & 2.39708E-01_JPRB, 2.42042E-01_JPRB, 2.44399E-01_JPRB, 2.46779E-01_JPRB, 2.49182E-01_JPRB, &
+     & 2.51608E-01_JPRB, 2.54058E-01_JPRB, 2.56532E-01_JPRB, 2.59030E-01_JPRB, 2.61552E-01_JPRB, &
+     & 2.64099E-01_JPRB, 2.66671E-01_JPRB, 2.69267E-01_JPRB, 2.71889E-01_JPRB/)
+      KAO_MO3( 5, :, 4) = (/ &
+     & 2.42563E-01_JPRB, 2.44620E-01_JPRB, 2.46695E-01_JPRB, 2.48787E-01_JPRB, 2.50897E-01_JPRB, &
+     & 2.53024E-01_JPRB, 2.55170E-01_JPRB, 2.57334E-01_JPRB, 2.59516E-01_JPRB, 2.61717E-01_JPRB, &
+     & 2.63936E-01_JPRB, 2.66174E-01_JPRB, 2.68431E-01_JPRB, 2.70708E-01_JPRB, 2.73003E-01_JPRB, &
+     & 2.75318E-01_JPRB, 2.77653E-01_JPRB, 2.80008E-01_JPRB, 2.82382E-01_JPRB/)
+      KAO_MO3( 6, :, 4) = (/ &
+     & 2.54052E-01_JPRB, 2.56017E-01_JPRB, 2.57997E-01_JPRB, 2.59992E-01_JPRB, 2.62003E-01_JPRB, &
+     & 2.64029E-01_JPRB, 2.66071E-01_JPRB, 2.68129E-01_JPRB, 2.70203E-01_JPRB, 2.72293E-01_JPRB, &
+     & 2.74398E-01_JPRB, 2.76521E-01_JPRB, 2.78659E-01_JPRB, 2.80814E-01_JPRB, 2.82986E-01_JPRB, &
+     & 2.85175E-01_JPRB, 2.87380E-01_JPRB, 2.89603E-01_JPRB, 2.91842E-01_JPRB/)
+      KAO_MO3( 7, :, 4) = (/ &
+     & 2.54061E-01_JPRB, 2.55982E-01_JPRB, 2.57917E-01_JPRB, 2.59867E-01_JPRB, 2.61832E-01_JPRB, &
+     & 2.63811E-01_JPRB, 2.65806E-01_JPRB, 2.67815E-01_JPRB, 2.69840E-01_JPRB, 2.71880E-01_JPRB, &
+     & 2.73936E-01_JPRB, 2.76007E-01_JPRB, 2.78093E-01_JPRB, 2.80196E-01_JPRB, 2.82314E-01_JPRB, &
+     & 2.84449E-01_JPRB, 2.86599E-01_JPRB, 2.88766E-01_JPRB, 2.90949E-01_JPRB/)
+      KAO_MO3( 8, :, 4) = (/ &
+     & 2.72482E-01_JPRB, 2.73916E-01_JPRB, 2.75358E-01_JPRB, 2.76807E-01_JPRB, 2.78264E-01_JPRB, &
+     & 2.79729E-01_JPRB, 2.81201E-01_JPRB, 2.82681E-01_JPRB, 2.84169E-01_JPRB, 2.85665E-01_JPRB, &
+     & 2.87168E-01_JPRB, 2.88680E-01_JPRB, 2.90199E-01_JPRB, 2.91726E-01_JPRB, 2.93262E-01_JPRB, &
+     & 2.94805E-01_JPRB, 2.96357E-01_JPRB, 2.97917E-01_JPRB, 2.99485E-01_JPRB/)
+      KAO_MO3( 9, :, 4) = (/ &
+     & 1.93414E-01_JPRB, 1.95498E-01_JPRB, 1.97605E-01_JPRB, 1.99734E-01_JPRB, 2.01886E-01_JPRB, &
+     & 2.04062E-01_JPRB, 2.06261E-01_JPRB, 2.08483E-01_JPRB, 2.10730E-01_JPRB, 2.13001E-01_JPRB, &
+     & 2.15296E-01_JPRB, 2.17616E-01_JPRB, 2.19961E-01_JPRB, 2.22331E-01_JPRB, 2.24727E-01_JPRB, &
+     & 2.27148E-01_JPRB, 2.29596E-01_JPRB, 2.32070E-01_JPRB, 2.34571E-01_JPRB/)
+      KAO_MO3( 1, :, 5) = (/ &
+     & 5.30785E-01_JPRB, 5.30477E-01_JPRB, 5.30169E-01_JPRB, 5.29861E-01_JPRB, 5.29553E-01_JPRB, &
+     & 5.29246E-01_JPRB, 5.28938E-01_JPRB, 5.28631E-01_JPRB, 5.28324E-01_JPRB, 5.28017E-01_JPRB, &
+     & 5.27711E-01_JPRB, 5.27404E-01_JPRB, 5.27098E-01_JPRB, 5.26792E-01_JPRB, 5.26486E-01_JPRB, &
+     & 5.26180E-01_JPRB, 5.25875E-01_JPRB, 5.25569E-01_JPRB, 5.25264E-01_JPRB/)
+      KAO_MO3( 2, :, 5) = (/ &
+     & 5.33406E-01_JPRB, 5.32997E-01_JPRB, 5.32587E-01_JPRB, 5.32178E-01_JPRB, 5.31769E-01_JPRB, &
+     & 5.31360E-01_JPRB, 5.30952E-01_JPRB, 5.30544E-01_JPRB, 5.30137E-01_JPRB, 5.29729E-01_JPRB, &
+     & 5.29322E-01_JPRB, 5.28916E-01_JPRB, 5.28509E-01_JPRB, 5.28103E-01_JPRB, 5.27697E-01_JPRB, &
+     & 5.27292E-01_JPRB, 5.26887E-01_JPRB, 5.26482E-01_JPRB, 5.26077E-01_JPRB/)
+      KAO_MO3( 3, :, 5) = (/ &
+     & 5.39814E-01_JPRB, 5.39234E-01_JPRB, 5.38655E-01_JPRB, 5.38077E-01_JPRB, 5.37499E-01_JPRB, &
+     & 5.36922E-01_JPRB, 5.36345E-01_JPRB, 5.35769E-01_JPRB, 5.35194E-01_JPRB, 5.34620E-01_JPRB, &
+     & 5.34045E-01_JPRB, 5.33472E-01_JPRB, 5.32899E-01_JPRB, 5.32327E-01_JPRB, 5.31756E-01_JPRB, &
+     & 5.31185E-01_JPRB, 5.30614E-01_JPRB, 5.30045E-01_JPRB, 5.29475E-01_JPRB/)
+      KAO_MO3( 4, :, 5) = (/ &
+     & 5.39054E-01_JPRB, 5.38348E-01_JPRB, 5.37643E-01_JPRB, 5.36938E-01_JPRB, 5.36235E-01_JPRB, &
+     & 5.35532E-01_JPRB, 5.34831E-01_JPRB, 5.34130E-01_JPRB, 5.33431E-01_JPRB, 5.32732E-01_JPRB, &
+     & 5.32034E-01_JPRB, 5.31337E-01_JPRB, 5.30641E-01_JPRB, 5.29946E-01_JPRB, 5.29252E-01_JPRB, &
+     & 5.28559E-01_JPRB, 5.27866E-01_JPRB, 5.27175E-01_JPRB, 5.26484E-01_JPRB/)
+      KAO_MO3( 5, :, 5) = (/ &
+     & 5.29240E-01_JPRB, 5.28475E-01_JPRB, 5.27711E-01_JPRB, 5.26949E-01_JPRB, 5.26187E-01_JPRB, &
+     & 5.25427E-01_JPRB, 5.24668E-01_JPRB, 5.23909E-01_JPRB, 5.23152E-01_JPRB, 5.22396E-01_JPRB, &
+     & 5.21641E-01_JPRB, 5.20888E-01_JPRB, 5.20135E-01_JPRB, 5.19383E-01_JPRB, 5.18633E-01_JPRB, &
+     & 5.17883E-01_JPRB, 5.17135E-01_JPRB, 5.16388E-01_JPRB, 5.15642E-01_JPRB/)
+      KAO_MO3( 6, :, 5) = (/ &
+     & 5.21746E-01_JPRB, 5.20815E-01_JPRB, 5.19886E-01_JPRB, 5.18958E-01_JPRB, 5.18032E-01_JPRB, &
+     & 5.17107E-01_JPRB, 5.16184E-01_JPRB, 5.15263E-01_JPRB, 5.14343E-01_JPRB, 5.13425E-01_JPRB, &
+     & 5.12509E-01_JPRB, 5.11594E-01_JPRB, 5.10681E-01_JPRB, 5.09770E-01_JPRB, 5.08860E-01_JPRB, &
+     & 5.07952E-01_JPRB, 5.07045E-01_JPRB, 5.06140E-01_JPRB, 5.05237E-01_JPRB/)
+      KAO_MO3( 7, :, 5) = (/ &
+     & 5.26752E-01_JPRB, 5.25550E-01_JPRB, 5.24352E-01_JPRB, 5.23156E-01_JPRB, 5.21963E-01_JPRB, &
+     & 5.20772E-01_JPRB, 5.19584E-01_JPRB, 5.18399E-01_JPRB, 5.17217E-01_JPRB, 5.16038E-01_JPRB, &
+     & 5.14861E-01_JPRB, 5.13686E-01_JPRB, 5.12515E-01_JPRB, 5.11346E-01_JPRB, 5.10180E-01_JPRB, &
+     & 5.09016E-01_JPRB, 5.07855E-01_JPRB, 5.06697E-01_JPRB, 5.05541E-01_JPRB/)
+      KAO_MO3( 8, :, 5) = (/ &
+     & 5.23581E-01_JPRB, 5.22513E-01_JPRB, 5.21446E-01_JPRB, 5.20382E-01_JPRB, 5.19320E-01_JPRB, &
+     & 5.18260E-01_JPRB, 5.17203E-01_JPRB, 5.16147E-01_JPRB, 5.15094E-01_JPRB, 5.14042E-01_JPRB, &
+     & 5.12993E-01_JPRB, 5.11946E-01_JPRB, 5.10901E-01_JPRB, 5.09859E-01_JPRB, 5.08818E-01_JPRB, &
+     & 5.07780E-01_JPRB, 5.06743E-01_JPRB, 5.05709E-01_JPRB, 5.04677E-01_JPRB/)
+      KAO_MO3( 9, :, 5) = (/ &
+     & 3.80393E-01_JPRB, 3.80680E-01_JPRB, 3.80967E-01_JPRB, 3.81254E-01_JPRB, 3.81542E-01_JPRB, &
+     & 3.81829E-01_JPRB, 3.82117E-01_JPRB, 3.82405E-01_JPRB, 3.82693E-01_JPRB, 3.82982E-01_JPRB, &
+     & 3.83271E-01_JPRB, 3.83559E-01_JPRB, 3.83849E-01_JPRB, 3.84138E-01_JPRB, 3.84428E-01_JPRB, &
+     & 3.84717E-01_JPRB, 3.85007E-01_JPRB, 3.85298E-01_JPRB, 3.85588E-01_JPRB/)
+      KAO_MO3( 1, :, 6) = (/ &
+     & 6.14818E-01_JPRB, 6.10664E-01_JPRB, 6.06539E-01_JPRB, 6.02441E-01_JPRB, 5.98372E-01_JPRB, &
+     & 5.94330E-01_JPRB, 5.90315E-01_JPRB, 5.86327E-01_JPRB, 5.82366E-01_JPRB, 5.78432E-01_JPRB, &
+     & 5.74524E-01_JPRB, 5.70643E-01_JPRB, 5.66788E-01_JPRB, 5.62959E-01_JPRB, 5.59156E-01_JPRB, &
+     & 5.55379E-01_JPRB, 5.51627E-01_JPRB, 5.47901E-01_JPRB, 5.44199E-01_JPRB/)
+      KAO_MO3( 2, :, 6) = (/ &
+     & 6.10199E-01_JPRB, 6.06143E-01_JPRB, 6.02114E-01_JPRB, 5.98112E-01_JPRB, 5.94136E-01_JPRB, &
+     & 5.90187E-01_JPRB, 5.86264E-01_JPRB, 5.82367E-01_JPRB, 5.78496E-01_JPRB, 5.74651E-01_JPRB, &
+     & 5.70831E-01_JPRB, 5.67037E-01_JPRB, 5.63268E-01_JPRB, 5.59524E-01_JPRB, 5.55805E-01_JPRB, &
+     & 5.52110E-01_JPRB, 5.48440E-01_JPRB, 5.44795E-01_JPRB, 5.41174E-01_JPRB/)
+      KAO_MO3( 3, :, 6) = (/ &
+     & 6.02949E-01_JPRB, 5.99057E-01_JPRB, 5.95190E-01_JPRB, 5.91348E-01_JPRB, 5.87531E-01_JPRB, &
+     & 5.83739E-01_JPRB, 5.79971E-01_JPRB, 5.76227E-01_JPRB, 5.72508E-01_JPRB, 5.68812E-01_JPRB, &
+     & 5.65140E-01_JPRB, 5.61493E-01_JPRB, 5.57868E-01_JPRB, 5.54267E-01_JPRB, 5.50690E-01_JPRB, &
+     & 5.47135E-01_JPRB, 5.43603E-01_JPRB, 5.40094E-01_JPRB, 5.36608E-01_JPRB/)
+      KAO_MO3( 4, :, 6) = (/ &
+     & 6.05047E-01_JPRB, 6.01155E-01_JPRB, 5.97289E-01_JPRB, 5.93448E-01_JPRB, 5.89631E-01_JPRB, &
+     & 5.85838E-01_JPRB, 5.82071E-01_JPRB, 5.78327E-01_JPRB, 5.74607E-01_JPRB, 5.70912E-01_JPRB, &
+     & 5.67240E-01_JPRB, 5.63592E-01_JPRB, 5.59967E-01_JPRB, 5.56365E-01_JPRB, 5.52787E-01_JPRB, &
+     & 5.49232E-01_JPRB, 5.45699E-01_JPRB, 5.42190E-01_JPRB, 5.38703E-01_JPRB/)
+      KAO_MO3( 5, :, 6) = (/ &
+     & 6.03593E-01_JPRB, 5.99867E-01_JPRB, 5.96164E-01_JPRB, 5.92483E-01_JPRB, 5.88825E-01_JPRB, &
+     & 5.85190E-01_JPRB, 5.81577E-01_JPRB, 5.77987E-01_JPRB, 5.74419E-01_JPRB, 5.70872E-01_JPRB, &
+     & 5.67348E-01_JPRB, 5.63846E-01_JPRB, 5.60365E-01_JPRB, 5.56905E-01_JPRB, 5.53467E-01_JPRB, &
+     & 5.50050E-01_JPRB, 5.46654E-01_JPRB, 5.43279E-01_JPRB, 5.39926E-01_JPRB/)
+      KAO_MO3( 6, :, 6) = (/ &
+     & 6.03940E-01_JPRB, 6.00224E-01_JPRB, 5.96531E-01_JPRB, 5.92861E-01_JPRB, 5.89213E-01_JPRB, &
+     & 5.85588E-01_JPRB, 5.81985E-01_JPRB, 5.78404E-01_JPRB, 5.74845E-01_JPRB, 5.71308E-01_JPRB, &
+     & 5.67793E-01_JPRB, 5.64299E-01_JPRB, 5.60827E-01_JPRB, 5.57377E-01_JPRB, 5.53947E-01_JPRB, &
+     & 5.50539E-01_JPRB, 5.47151E-01_JPRB, 5.43785E-01_JPRB, 5.40439E-01_JPRB/)
+      KAO_MO3( 7, :, 6) = (/ &
+     & 6.06242E-01_JPRB, 6.02257E-01_JPRB, 5.98299E-01_JPRB, 5.94367E-01_JPRB, 5.90461E-01_JPRB, &
+     & 5.86580E-01_JPRB, 5.82725E-01_JPRB, 5.78895E-01_JPRB, 5.75090E-01_JPRB, 5.71311E-01_JPRB, &
+     & 5.67556E-01_JPRB, 5.63826E-01_JPRB, 5.60120E-01_JPRB, 5.56439E-01_JPRB, 5.52782E-01_JPRB, &
+     & 5.49149E-01_JPRB, 5.45540E-01_JPRB, 5.41954E-01_JPRB, 5.38393E-01_JPRB/)
+      KAO_MO3( 8, :, 6) = (/ &
+     & 6.11929E-01_JPRB, 6.07173E-01_JPRB, 6.02454E-01_JPRB, 5.97773E-01_JPRB, 5.93127E-01_JPRB, &
+     & 5.88518E-01_JPRB, 5.83944E-01_JPRB, 5.79406E-01_JPRB, 5.74903E-01_JPRB, 5.70436E-01_JPRB, &
+     & 5.66002E-01_JPRB, 5.61604E-01_JPRB, 5.57239E-01_JPRB, 5.52909E-01_JPRB, 5.48612E-01_JPRB, &
+     & 5.44349E-01_JPRB, 5.40118E-01_JPRB, 5.35921E-01_JPRB, 5.31756E-01_JPRB/)
+      KAO_MO3( 9, :, 6) = (/ &
+     & 6.21189E-01_JPRB, 6.17338E-01_JPRB, 6.13511E-01_JPRB, 6.09707E-01_JPRB, 6.05927E-01_JPRB, &
+     & 6.02170E-01_JPRB, 5.98437E-01_JPRB, 5.94726E-01_JPRB, 5.91039E-01_JPRB, 5.87375E-01_JPRB, &
+     & 5.83733E-01_JPRB, 5.80114E-01_JPRB, 5.76517E-01_JPRB, 5.72943E-01_JPRB, 5.69390E-01_JPRB, &
+     & 5.65860E-01_JPRB, 5.62352E-01_JPRB, 5.58865E-01_JPRB, 5.55400E-01_JPRB/)
+      KAO_MO3( 1, :, 7) = (/ &
+     & 7.41310E-01_JPRB, 7.30108E-01_JPRB, 7.19075E-01_JPRB, 7.08209E-01_JPRB, 6.97507E-01_JPRB, &
+     & 6.86967E-01_JPRB, 6.76586E-01_JPRB, 6.66362E-01_JPRB, 6.56292E-01_JPRB, 6.46374E-01_JPRB, &
+     & 6.36607E-01_JPRB, 6.26987E-01_JPRB, 6.17512E-01_JPRB, 6.08181E-01_JPRB, 5.98990E-01_JPRB, &
+     & 5.89939E-01_JPRB, 5.81024E-01_JPRB, 5.72244E-01_JPRB, 5.63597E-01_JPRB/)
+      KAO_MO3( 2, :, 7) = (/ &
+     & 7.38780E-01_JPRB, 7.27631E-01_JPRB, 7.16651E-01_JPRB, 7.05836E-01_JPRB, 6.95185E-01_JPRB, &
+     & 6.84695E-01_JPRB, 6.74362E-01_JPRB, 6.64186E-01_JPRB, 6.54163E-01_JPRB, 6.44292E-01_JPRB, &
+     & 6.34569E-01_JPRB, 6.24993E-01_JPRB, 6.15562E-01_JPRB, 6.06273E-01_JPRB, 5.97124E-01_JPRB, &
+     & 5.88113E-01_JPRB, 5.79238E-01_JPRB, 5.70498E-01_JPRB, 5.61889E-01_JPRB/)
+      KAO_MO3( 3, :, 7) = (/ &
+     & 7.33846E-01_JPRB, 7.22799E-01_JPRB, 7.11919E-01_JPRB, 7.01203E-01_JPRB, 6.90648E-01_JPRB, &
+     & 6.80252E-01_JPRB, 6.70012E-01_JPRB, 6.59927E-01_JPRB, 6.49993E-01_JPRB, 6.40209E-01_JPRB, &
+     & 6.30572E-01_JPRB, 6.21080E-01_JPRB, 6.11731E-01_JPRB, 6.02523E-01_JPRB, 5.93453E-01_JPRB, &
+     & 5.84520E-01_JPRB, 5.75721E-01_JPRB, 5.67055E-01_JPRB, 5.58519E-01_JPRB/)
+      KAO_MO3( 4, :, 7) = (/ &
+     & 7.21218E-01_JPRB, 7.10492E-01_JPRB, 6.99926E-01_JPRB, 6.89517E-01_JPRB, 6.79262E-01_JPRB, &
+     & 6.69160E-01_JPRB, 6.59209E-01_JPRB, 6.49405E-01_JPRB, 6.39747E-01_JPRB, 6.30233E-01_JPRB, &
+     & 6.20860E-01_JPRB, 6.11627E-01_JPRB, 6.02531E-01_JPRB, 5.93570E-01_JPRB, 5.84743E-01_JPRB, &
+     & 5.76047E-01_JPRB, 5.67480E-01_JPRB, 5.59040E-01_JPRB, 5.50726E-01_JPRB/)
+      KAO_MO3( 5, :, 7) = (/ &
+     & 7.10588E-01_JPRB, 7.00014E-01_JPRB, 6.89596E-01_JPRB, 6.79334E-01_JPRB, 6.69225E-01_JPRB, &
+     & 6.59266E-01_JPRB, 6.49455E-01_JPRB, 6.39790E-01_JPRB, 6.30269E-01_JPRB, 6.20889E-01_JPRB, &
+     & 6.11650E-01_JPRB, 6.02547E-01_JPRB, 5.93581E-01_JPRB, 5.84747E-01_JPRB, 5.76045E-01_JPRB, &
+     & 5.67473E-01_JPRB, 5.59028E-01_JPRB, 5.50709E-01_JPRB, 5.42513E-01_JPRB/)
+      KAO_MO3( 6, :, 7) = (/ &
+     & 6.98166E-01_JPRB, 6.87706E-01_JPRB, 6.77402E-01_JPRB, 6.67253E-01_JPRB, 6.57256E-01_JPRB, &
+     & 6.47408E-01_JPRB, 6.37708E-01_JPRB, 6.28154E-01_JPRB, 6.18742E-01_JPRB, 6.09472E-01_JPRB, &
+     & 6.00340E-01_JPRB, 5.91346E-01_JPRB, 5.82486E-01_JPRB, 5.73758E-01_JPRB, 5.65162E-01_JPRB, &
+     & 5.56694E-01_JPRB, 5.48353E-01_JPRB, 5.40138E-01_JPRB, 5.32045E-01_JPRB/)
+      KAO_MO3( 7, :, 7) = (/ &
+     & 6.76974E-01_JPRB, 6.67034E-01_JPRB, 6.57240E-01_JPRB, 6.47590E-01_JPRB, 6.38081E-01_JPRB, &
+     & 6.28712E-01_JPRB, 6.19481E-01_JPRB, 6.10385E-01_JPRB, 6.01422E-01_JPRB, 5.92592E-01_JPRB, &
+     & 5.83891E-01_JPRB, 5.75317E-01_JPRB, 5.66870E-01_JPRB, 5.58547E-01_JPRB, 5.50345E-01_JPRB, &
+     & 5.42265E-01_JPRB, 5.34303E-01_JPRB, 5.26457E-01_JPRB, 5.18727E-01_JPRB/)
+      KAO_MO3( 8, :, 7) = (/ &
+     & 6.30061E-01_JPRB, 6.21017E-01_JPRB, 6.12102E-01_JPRB, 6.03316E-01_JPRB, 5.94656E-01_JPRB, &
+     & 5.86120E-01_JPRB, 5.77706E-01_JPRB, 5.69414E-01_JPRB, 5.61240E-01_JPRB, 5.53184E-01_JPRB, &
+     & 5.45243E-01_JPRB, 5.37416E-01_JPRB, 5.29702E-01_JPRB, 5.22098E-01_JPRB, 5.14604E-01_JPRB, &
+     & 5.07217E-01_JPRB, 4.99936E-01_JPRB, 4.92760E-01_JPRB, 4.85687E-01_JPRB/)
+      KAO_MO3( 9, :, 7) = (/ &
+     & 8.97633E-01_JPRB, 8.87307E-01_JPRB, 8.77100E-01_JPRB, 8.67010E-01_JPRB, 8.57036E-01_JPRB, &
+     & 8.47176E-01_JPRB, 8.37431E-01_JPRB, 8.27797E-01_JPRB, 8.18274E-01_JPRB, 8.08861E-01_JPRB, &
+     & 7.99555E-01_JPRB, 7.90357E-01_JPRB, 7.81265E-01_JPRB, 7.72278E-01_JPRB, 7.63393E-01_JPRB, &
+     & 7.54611E-01_JPRB, 7.45930E-01_JPRB, 7.37349E-01_JPRB, 7.28867E-01_JPRB/)
+      KAO_MO3( 1, :, 8) = (/ &
+     & 4.87356E-01_JPRB, 4.80743E-01_JPRB, 4.74220E-01_JPRB, 4.67785E-01_JPRB, 4.61437E-01_JPRB, &
+     & 4.55176E-01_JPRB, 4.49000E-01_JPRB, 4.42907E-01_JPRB, 4.36897E-01_JPRB, 4.30969E-01_JPRB, &
+     & 4.25121E-01_JPRB, 4.19353E-01_JPRB, 4.13663E-01_JPRB, 4.08049E-01_JPRB, 4.02513E-01_JPRB, &
+     & 3.97051E-01_JPRB, 3.91663E-01_JPRB, 3.86349E-01_JPRB, 3.81106E-01_JPRB/)
+      KAO_MO3( 2, :, 8) = (/ &
+     & 4.86776E-01_JPRB, 4.80157E-01_JPRB, 4.73627E-01_JPRB, 4.67187E-01_JPRB, 4.60834E-01_JPRB, &
+     & 4.54567E-01_JPRB, 4.48386E-01_JPRB, 4.42289E-01_JPRB, 4.36274E-01_JPRB, 4.30342E-01_JPRB, &
+     & 4.24490E-01_JPRB, 4.18718E-01_JPRB, 4.13024E-01_JPRB, 4.07407E-01_JPRB, 4.01867E-01_JPRB, &
+     & 3.96403E-01_JPRB, 3.91012E-01_JPRB, 3.85695E-01_JPRB, 3.80450E-01_JPRB/)
+      KAO_MO3( 3, :, 8) = (/ &
+     & 4.86111E-01_JPRB, 4.79496E-01_JPRB, 4.72972E-01_JPRB, 4.66536E-01_JPRB, 4.60188E-01_JPRB, &
+     & 4.53926E-01_JPRB, 4.47750E-01_JPRB, 4.41657E-01_JPRB, 4.35648E-01_JPRB, 4.29720E-01_JPRB, &
+     & 4.23873E-01_JPRB, 4.18105E-01_JPRB, 4.12416E-01_JPRB, 4.06804E-01_JPRB, 4.01269E-01_JPRB, &
+     & 3.95809E-01_JPRB, 3.90423E-01_JPRB, 3.85111E-01_JPRB, 3.79871E-01_JPRB/)
+      KAO_MO3( 4, :, 8) = (/ &
+     & 4.85501E-01_JPRB, 4.78880E-01_JPRB, 4.72350E-01_JPRB, 4.65908E-01_JPRB, 4.59554E-01_JPRB, &
+     & 4.53288E-01_JPRB, 4.47106E-01_JPRB, 4.41009E-01_JPRB, 4.34995E-01_JPRB, 4.29063E-01_JPRB, &
+     & 4.23211E-01_JPRB, 4.17440E-01_JPRB, 4.11747E-01_JPRB, 4.06132E-01_JPRB, 4.00594E-01_JPRB, &
+     & 3.95131E-01_JPRB, 3.89743E-01_JPRB, 3.84428E-01_JPRB, 3.79185E-01_JPRB/)
+      KAO_MO3( 5, :, 8) = (/ &
+     & 4.83679E-01_JPRB, 4.77140E-01_JPRB, 4.70691E-01_JPRB, 4.64328E-01_JPRB, 4.58051E-01_JPRB, &
+     & 4.51859E-01_JPRB, 4.45751E-01_JPRB, 4.39726E-01_JPRB, 4.33781E-01_JPRB, 4.27918E-01_JPRB, &
+     & 4.22133E-01_JPRB, 4.16427E-01_JPRB, 4.10798E-01_JPRB, 4.05245E-01_JPRB, 3.99767E-01_JPRB, &
+     & 3.94363E-01_JPRB, 3.89032E-01_JPRB, 3.83773E-01_JPRB, 3.78585E-01_JPRB/)
+      KAO_MO3( 6, :, 8) = (/ &
+     & 4.72120E-01_JPRB, 4.65834E-01_JPRB, 4.59630E-01_JPRB, 4.53510E-01_JPRB, 4.47471E-01_JPRB, &
+     & 4.41513E-01_JPRB, 4.35633E-01_JPRB, 4.29833E-01_JPRB, 4.24109E-01_JPRB, 4.18461E-01_JPRB, &
+     & 4.12889E-01_JPRB, 4.07391E-01_JPRB, 4.01966E-01_JPRB, 3.96614E-01_JPRB, 3.91332E-01_JPRB, &
+     & 3.86122E-01_JPRB, 3.80980E-01_JPRB, 3.75907E-01_JPRB, 3.70901E-01_JPRB/)
+      KAO_MO3( 7, :, 8) = (/ &
+     & 4.58683E-01_JPRB, 4.52758E-01_JPRB, 4.46909E-01_JPRB, 4.41135E-01_JPRB, 4.35437E-01_JPRB, &
+     & 4.29812E-01_JPRB, 4.24259E-01_JPRB, 4.18779E-01_JPRB, 4.13369E-01_JPRB, 4.08029E-01_JPRB, &
+     & 4.02758E-01_JPRB, 3.97555E-01_JPRB, 3.92419E-01_JPRB, 3.87350E-01_JPRB, 3.82346E-01_JPRB, &
+     & 3.77406E-01_JPRB, 3.72531E-01_JPRB, 3.67719E-01_JPRB, 3.62968E-01_JPRB/)
+      KAO_MO3( 8, :, 8) = (/ &
+     & 4.56091E-01_JPRB, 4.50481E-01_JPRB, 4.44940E-01_JPRB, 4.39467E-01_JPRB, 4.34062E-01_JPRB, &
+     & 4.28722E-01_JPRB, 4.23449E-01_JPRB, 4.18240E-01_JPRB, 4.13096E-01_JPRB, 4.08015E-01_JPRB, &
+     & 4.02996E-01_JPRB, 3.98039E-01_JPRB, 3.93143E-01_JPRB, 3.88307E-01_JPRB, 3.83531E-01_JPRB, &
+     & 3.78813E-01_JPRB, 3.74154E-01_JPRB, 3.69552E-01_JPRB, 3.65006E-01_JPRB/)
+      KAO_MO3( 9, :, 8) = (/ &
+     & 9.11213E-01_JPRB, 9.03270E-01_JPRB, 8.95396E-01_JPRB, 8.87591E-01_JPRB, 8.79855E-01_JPRB, &
+     & 8.72185E-01_JPRB, 8.64583E-01_JPRB, 8.57046E-01_JPRB, 8.49576E-01_JPRB, 8.42170E-01_JPRB, &
+     & 8.34829E-01_JPRB, 8.27552E-01_JPRB, 8.20339E-01_JPRB, 8.13188E-01_JPRB, 8.06100E-01_JPRB, &
+     & 7.99073E-01_JPRB, 7.92108E-01_JPRB, 7.85204E-01_JPRB, 7.78359E-01_JPRB/)
+      KAO_MO3( 1, :, 9) = (/ &
+     & 5.56194E-01_JPRB, 5.48595E-01_JPRB, 5.41100E-01_JPRB, 5.33707E-01_JPRB, 5.26415E-01_JPRB, &
+     & 5.19223E-01_JPRB, 5.12129E-01_JPRB, 5.05132E-01_JPRB, 4.98231E-01_JPRB, 4.91424E-01_JPRB, &
+     & 4.84710E-01_JPRB, 4.78087E-01_JPRB, 4.71556E-01_JPRB, 4.65113E-01_JPRB, 4.58758E-01_JPRB, &
+     & 4.52491E-01_JPRB, 4.46309E-01_JPRB, 4.40211E-01_JPRB, 4.34197E-01_JPRB/)
+      KAO_MO3( 2, :, 9) = (/ &
+     & 5.56174E-01_JPRB, 5.48575E-01_JPRB, 5.41079E-01_JPRB, 5.33687E-01_JPRB, 5.26395E-01_JPRB, &
+     & 5.19203E-01_JPRB, 5.12109E-01_JPRB, 5.05112E-01_JPRB, 4.98211E-01_JPRB, 4.91404E-01_JPRB, &
+     & 4.84690E-01_JPRB, 4.78068E-01_JPRB, 4.71536E-01_JPRB, 4.65093E-01_JPRB, 4.58739E-01_JPRB, &
+     & 4.52471E-01_JPRB, 4.46289E-01_JPRB, 4.40191E-01_JPRB, 4.34177E-01_JPRB/)
+      KAO_MO3( 3, :, 9) = (/ &
+     & 5.55996E-01_JPRB, 5.48403E-01_JPRB, 5.40913E-01_JPRB, 5.33526E-01_JPRB, 5.26239E-01_JPRB, &
+     & 5.19052E-01_JPRB, 5.11963E-01_JPRB, 5.04971E-01_JPRB, 4.98074E-01_JPRB, 4.91272E-01_JPRB, &
+     & 4.84562E-01_JPRB, 4.77944E-01_JPRB, 4.71417E-01_JPRB, 4.64978E-01_JPRB, 4.58628E-01_JPRB, &
+     & 4.52364E-01_JPRB, 4.46186E-01_JPRB, 4.40092E-01_JPRB, 4.34081E-01_JPRB/)
+      KAO_MO3( 4, :, 9) = (/ &
+     & 5.55859E-01_JPRB, 5.48271E-01_JPRB, 5.40786E-01_JPRB, 5.33404E-01_JPRB, 5.26123E-01_JPRB, &
+     & 5.18941E-01_JPRB, 5.11856E-01_JPRB, 5.04869E-01_JPRB, 4.97977E-01_JPRB, 4.91179E-01_JPRB, &
+     & 4.84474E-01_JPRB, 4.77861E-01_JPRB, 4.71337E-01_JPRB, 4.64903E-01_JPRB, 4.58557E-01_JPRB, &
+     & 4.52297E-01_JPRB, 4.46123E-01_JPRB, 4.40033E-01_JPRB, 4.34026E-01_JPRB/)
+      KAO_MO3( 5, :, 9) = (/ &
+     & 5.54550E-01_JPRB, 5.46921E-01_JPRB, 5.39397E-01_JPRB, 5.31976E-01_JPRB, 5.24657E-01_JPRB, &
+     & 5.17439E-01_JPRB, 5.10320E-01_JPRB, 5.03300E-01_JPRB, 4.96376E-01_JPRB, 4.89547E-01_JPRB, &
+     & 4.82812E-01_JPRB, 4.76170E-01_JPRB, 4.69619E-01_JPRB, 4.63158E-01_JPRB, 4.56786E-01_JPRB, &
+     & 4.50502E-01_JPRB, 4.44304E-01_JPRB, 4.38192E-01_JPRB, 4.32163E-01_JPRB/)
+      KAO_MO3( 6, :, 9) = (/ &
+     & 5.53514E-01_JPRB, 5.45883E-01_JPRB, 5.38358E-01_JPRB, 5.30937E-01_JPRB, 5.23618E-01_JPRB, &
+     & 5.16399E-01_JPRB, 5.09280E-01_JPRB, 5.02260E-01_JPRB, 4.95336E-01_JPRB, 4.88507E-01_JPRB, &
+     & 4.81773E-01_JPRB, 4.75132E-01_JPRB, 4.68582E-01_JPRB, 4.62122E-01_JPRB, 4.55752E-01_JPRB, &
+     & 4.49469E-01_JPRB, 4.43273E-01_JPRB, 4.37162E-01_JPRB, 4.31136E-01_JPRB/)
+      KAO_MO3( 7, :, 9) = (/ &
+     & 5.49865E-01_JPRB, 5.42303E-01_JPRB, 5.34846E-01_JPRB, 5.27491E-01_JPRB, 5.20237E-01_JPRB, &
+     & 5.13084E-01_JPRB, 5.06028E-01_JPRB, 4.99070E-01_JPRB, 4.92207E-01_JPRB, 4.85438E-01_JPRB, &
+     & 4.78763E-01_JPRB, 4.72179E-01_JPRB, 4.65686E-01_JPRB, 4.59282E-01_JPRB, 4.52967E-01_JPRB, &
+     & 4.46738E-01_JPRB, 4.40595E-01_JPRB, 4.34536E-01_JPRB, 4.28561E-01_JPRB/)
+      KAO_MO3( 8, :, 9) = (/ &
+     & 5.25435E-01_JPRB, 5.18437E-01_JPRB, 5.11533E-01_JPRB, 5.04721E-01_JPRB, 4.97999E-01_JPRB, &
+     & 4.91367E-01_JPRB, 4.84823E-01_JPRB, 4.78366E-01_JPRB, 4.71996E-01_JPRB, 4.65710E-01_JPRB, &
+     & 4.59508E-01_JPRB, 4.53388E-01_JPRB, 4.47350E-01_JPRB, 4.41393E-01_JPRB, 4.35515E-01_JPRB, &
+     & 4.29715E-01_JPRB, 4.23992E-01_JPRB, 4.18345E-01_JPRB, 4.12774E-01_JPRB/)
+      KAO_MO3( 9, :, 9) = (/ &
+     & 3.48228E-01_JPRB, 3.45949E-01_JPRB, 3.43686E-01_JPRB, 3.41437E-01_JPRB, 3.39203E-01_JPRB, &
+     & 3.36983E-01_JPRB, 3.34778E-01_JPRB, 3.32588E-01_JPRB, 3.30412E-01_JPRB, 3.28250E-01_JPRB, &
+     & 3.26102E-01_JPRB, 3.23968E-01_JPRB, 3.21848E-01_JPRB, 3.19742E-01_JPRB, 3.17650E-01_JPRB, &
+     & 3.15572E-01_JPRB, 3.13507E-01_JPRB, 3.11456E-01_JPRB, 3.09418E-01_JPRB/)
+      KAO_MO3( 1, :,10) = (/ &
+     & 8.34107E-01_JPRB, 8.27276E-01_JPRB, 8.20501E-01_JPRB, 8.13781E-01_JPRB, 8.07117E-01_JPRB, &
+     & 8.00507E-01_JPRB, 7.93951E-01_JPRB, 7.87449E-01_JPRB, 7.81000E-01_JPRB, 7.74604E-01_JPRB, &
+     & 7.68260E-01_JPRB, 7.61968E-01_JPRB, 7.55728E-01_JPRB, 7.49539E-01_JPRB, 7.43400E-01_JPRB, &
+     & 7.37312E-01_JPRB, 7.31274E-01_JPRB, 7.25285E-01_JPRB, 7.19345E-01_JPRB/)
+      KAO_MO3( 2, :,10) = (/ &
+     & 8.32838E-01_JPRB, 8.26022E-01_JPRB, 8.19263E-01_JPRB, 8.12558E-01_JPRB, 8.05908E-01_JPRB, &
+     & 7.99313E-01_JPRB, 7.92772E-01_JPRB, 7.86284E-01_JPRB, 7.79849E-01_JPRB, 7.73467E-01_JPRB, &
+     & 7.67137E-01_JPRB, 7.60859E-01_JPRB, 7.54633E-01_JPRB, 7.48457E-01_JPRB, 7.42332E-01_JPRB, &
+     & 7.36257E-01_JPRB, 7.30232E-01_JPRB, 7.24256E-01_JPRB, 7.18329E-01_JPRB/)
+      KAO_MO3( 3, :,10) = (/ &
+     & 8.31167E-01_JPRB, 8.24361E-01_JPRB, 8.17611E-01_JPRB, 8.10916E-01_JPRB, 8.04276E-01_JPRB, &
+     & 7.97691E-01_JPRB, 7.91159E-01_JPRB, 7.84681E-01_JPRB, 7.78256E-01_JPRB, 7.71883E-01_JPRB, &
+     & 7.65563E-01_JPRB, 7.59294E-01_JPRB, 7.53077E-01_JPRB, 7.46910E-01_JPRB, 7.40795E-01_JPRB, &
+     & 7.34729E-01_JPRB, 7.28713E-01_JPRB, 7.22746E-01_JPRB, 7.16828E-01_JPRB/)
+      KAO_MO3( 4, :,10) = (/ &
+     & 8.29026E-01_JPRB, 8.22246E-01_JPRB, 8.15521E-01_JPRB, 8.08851E-01_JPRB, 8.02236E-01_JPRB, &
+     & 7.95675E-01_JPRB, 7.89167E-01_JPRB, 7.82713E-01_JPRB, 7.76312E-01_JPRB, 7.69962E-01_JPRB, &
+     & 7.63665E-01_JPRB, 7.57419E-01_JPRB, 7.51225E-01_JPRB, 7.45081E-01_JPRB, 7.38987E-01_JPRB, &
+     & 7.32943E-01_JPRB, 7.26949E-01_JPRB, 7.21003E-01_JPRB, 7.15107E-01_JPRB/)
+      KAO_MO3( 5, :,10) = (/ &
+     & 8.26226E-01_JPRB, 8.19471E-01_JPRB, 8.12771E-01_JPRB, 8.06126E-01_JPRB, 7.99536E-01_JPRB, &
+     & 7.92999E-01_JPRB, 7.86515E-01_JPRB, 7.80085E-01_JPRB, 7.73707E-01_JPRB, 7.67382E-01_JPRB, &
+     & 7.61108E-01_JPRB, 7.54885E-01_JPRB, 7.48714E-01_JPRB, 7.42592E-01_JPRB, 7.36521E-01_JPRB, &
+     & 7.30500E-01_JPRB, 7.24527E-01_JPRB, 7.18604E-01_JPRB, 7.12729E-01_JPRB/)
+      KAO_MO3( 6, :,10) = (/ &
+     & 8.33246E-01_JPRB, 8.26510E-01_JPRB, 8.19828E-01_JPRB, 8.13200E-01_JPRB, 8.06626E-01_JPRB, &
+     & 8.00105E-01_JPRB, 7.93637E-01_JPRB, 7.87221E-01_JPRB, 7.80856E-01_JPRB, 7.74544E-01_JPRB, &
+     & 7.68282E-01_JPRB, 7.62071E-01_JPRB, 7.55910E-01_JPRB, 7.49799E-01_JPRB, 7.43737E-01_JPRB, &
+     & 7.37725E-01_JPRB, 7.31760E-01_JPRB, 7.25845E-01_JPRB, 7.19977E-01_JPRB/)
+      KAO_MO3( 7, :,10) = (/ &
+     & 8.45693E-01_JPRB, 8.38967E-01_JPRB, 8.32295E-01_JPRB, 8.25675E-01_JPRB, 8.19108E-01_JPRB, &
+     & 8.12594E-01_JPRB, 8.06131E-01_JPRB, 7.99719E-01_JPRB, 7.93359E-01_JPRB, 7.87049E-01_JPRB, &
+     & 7.80789E-01_JPRB, 7.74579E-01_JPRB, 7.68419E-01_JPRB, 7.62307E-01_JPRB, 7.56244E-01_JPRB, &
+     & 7.50230E-01_JPRB, 7.44263E-01_JPRB, 7.38343E-01_JPRB, 7.32471E-01_JPRB/)
+      KAO_MO3( 8, :,10) = (/ &
+     & 8.32139E-01_JPRB, 8.25565E-01_JPRB, 8.19044E-01_JPRB, 8.12574E-01_JPRB, 8.06156E-01_JPRB, &
+     & 7.99788E-01_JPRB, 7.93470E-01_JPRB, 7.87202E-01_JPRB, 7.80984E-01_JPRB, 7.74815E-01_JPRB, &
+     & 7.68694E-01_JPRB, 7.62622E-01_JPRB, 7.56598E-01_JPRB, 7.50622E-01_JPRB, 7.44692E-01_JPRB, &
+     & 7.38810E-01_JPRB, 7.32974E-01_JPRB, 7.27184E-01_JPRB, 7.21440E-01_JPRB/)
+      KAO_MO3( 9, :,10) = (/ &
+     & 2.34258E-01_JPRB, 2.35247E-01_JPRB, 2.36239E-01_JPRB, 2.37236E-01_JPRB, 2.38237E-01_JPRB, &
+     & 2.39242E-01_JPRB, 2.40252E-01_JPRB, 2.41265E-01_JPRB, 2.42283E-01_JPRB, 2.43306E-01_JPRB, &
+     & 2.44332E-01_JPRB, 2.45363E-01_JPRB, 2.46398E-01_JPRB, 2.47438E-01_JPRB, 2.48482E-01_JPRB, &
+     & 2.49531E-01_JPRB, 2.50583E-01_JPRB, 2.51641E-01_JPRB, 2.52702E-01_JPRB/)
+      KAO_MO3( 1, :,11) = (/ &
+     & 8.31308E-01_JPRB, 8.22153E-01_JPRB, 8.13098E-01_JPRB, 8.04143E-01_JPRB, 7.95287E-01_JPRB, &
+     & 7.86528E-01_JPRB, 7.77866E-01_JPRB, 7.69299E-01_JPRB, 7.60827E-01_JPRB, 7.52448E-01_JPRB, &
+     & 7.44161E-01_JPRB, 7.35965E-01_JPRB, 7.27860E-01_JPRB, 7.19844E-01_JPRB, 7.11916E-01_JPRB, &
+     & 7.04075E-01_JPRB, 6.96321E-01_JPRB, 6.88652E-01_JPRB, 6.81068E-01_JPRB/)
+      KAO_MO3( 2, :,11) = (/ &
+     & 8.31577E-01_JPRB, 8.22400E-01_JPRB, 8.13324E-01_JPRB, 8.04349E-01_JPRB, 7.95472E-01_JPRB, &
+     & 7.86693E-01_JPRB, 7.78011E-01_JPRB, 7.69425E-01_JPRB, 7.60934E-01_JPRB, 7.52537E-01_JPRB, &
+     & 7.44232E-01_JPRB, 7.36019E-01_JPRB, 7.27896E-01_JPRB, 7.19863E-01_JPRB, 7.11919E-01_JPRB, &
+     & 7.04062E-01_JPRB, 6.96292E-01_JPRB, 6.88608E-01_JPRB, 6.81009E-01_JPRB/)
+      KAO_MO3( 3, :,11) = (/ &
+     & 8.31578E-01_JPRB, 8.22422E-01_JPRB, 8.13368E-01_JPRB, 8.04413E-01_JPRB, 7.95557E-01_JPRB, &
+     & 7.86798E-01_JPRB, 7.78136E-01_JPRB, 7.69569E-01_JPRB, 7.61097E-01_JPRB, 7.52717E-01_JPRB, &
+     & 7.44430E-01_JPRB, 7.36235E-01_JPRB, 7.28129E-01_JPRB, 7.20113E-01_JPRB, 7.12185E-01_JPRB, &
+     & 7.04344E-01_JPRB, 6.96589E-01_JPRB, 6.88920E-01_JPRB, 6.81336E-01_JPRB/)
+      KAO_MO3( 4, :,11) = (/ &
+     & 8.31261E-01_JPRB, 8.22111E-01_JPRB, 8.13062E-01_JPRB, 8.04112E-01_JPRB, 7.95261E-01_JPRB, &
+     & 7.86507E-01_JPRB, 7.77850E-01_JPRB, 7.69288E-01_JPRB, 7.60820E-01_JPRB, 7.52445E-01_JPRB, &
+     & 7.44163E-01_JPRB, 7.35971E-01_JPRB, 7.27870E-01_JPRB, 7.19858E-01_JPRB, 7.11935E-01_JPRB, &
+     & 7.04098E-01_JPRB, 6.96348E-01_JPRB, 6.88683E-01_JPRB, 6.81102E-01_JPRB/)
+      KAO_MO3( 5, :,11) = (/ &
+     & 8.31565E-01_JPRB, 8.22404E-01_JPRB, 8.13344E-01_JPRB, 8.04384E-01_JPRB, 7.95523E-01_JPRB, &
+     & 7.86760E-01_JPRB, 7.78092E-01_JPRB, 7.69521E-01_JPRB, 7.61044E-01_JPRB, 7.52660E-01_JPRB, &
+     & 7.44368E-01_JPRB, 7.36168E-01_JPRB, 7.28058E-01_JPRB, 7.20038E-01_JPRB, 7.12106E-01_JPRB, &
+     & 7.04261E-01_JPRB, 6.96503E-01_JPRB, 6.88830E-01_JPRB, 6.81242E-01_JPRB/)
+      KAO_MO3( 6, :,11) = (/ &
+     & 8.17636E-01_JPRB, 8.08497E-01_JPRB, 7.99461E-01_JPRB, 7.90525E-01_JPRB, 7.81690E-01_JPRB, &
+     & 7.72953E-01_JPRB, 7.64314E-01_JPRB, 7.55771E-01_JPRB, 7.47324E-01_JPRB, 7.38971E-01_JPRB, &
+     & 7.30712E-01_JPRB, 7.22545E-01_JPRB, 7.14469E-01_JPRB, 7.06483E-01_JPRB, 6.98587E-01_JPRB, &
+     & 6.90779E-01_JPRB, 6.83058E-01_JPRB, 6.75424E-01_JPRB, 6.67875E-01_JPRB/)
+      KAO_MO3( 7, :,11) = (/ &
+     & 7.95247E-01_JPRB, 7.86140E-01_JPRB, 7.77137E-01_JPRB, 7.68238E-01_JPRB, 7.59440E-01_JPRB, &
+     & 7.50743E-01_JPRB, 7.42145E-01_JPRB, 7.33646E-01_JPRB, 7.25245E-01_JPRB, 7.16939E-01_JPRB, &
+     & 7.08729E-01_JPRB, 7.00612E-01_JPRB, 6.92589E-01_JPRB, 6.84658E-01_JPRB, 6.76817E-01_JPRB, &
+     & 6.69066E-01_JPRB, 6.61404E-01_JPRB, 6.53830E-01_JPRB, 6.46342E-01_JPRB/)
+      KAO_MO3( 8, :,11) = (/ &
+     & 7.63069E-01_JPRB, 7.54006E-01_JPRB, 7.45051E-01_JPRB, 7.36202E-01_JPRB, 7.27458E-01_JPRB, &
+     & 7.18818E-01_JPRB, 7.10281E-01_JPRB, 7.01845E-01_JPRB, 6.93509E-01_JPRB, 6.85272E-01_JPRB, &
+     & 6.77133E-01_JPRB, 6.69091E-01_JPRB, 6.61144E-01_JPRB, 6.53292E-01_JPRB, 6.45533E-01_JPRB, &
+     & 6.37866E-01_JPRB, 6.30290E-01_JPRB, 6.22804E-01_JPRB, 6.15407E-01_JPRB/)
+      KAO_MO3( 9, :,11) = (/ &
+     & 2.03255E-01_JPRB, 2.03004E-01_JPRB, 2.02753E-01_JPRB, 2.02502E-01_JPRB, 2.02252E-01_JPRB, &
+     & 2.02001E-01_JPRB, 2.01752E-01_JPRB, 2.01502E-01_JPRB, 2.01253E-01_JPRB, 2.01004E-01_JPRB, &
+     & 2.00755E-01_JPRB, 2.00507E-01_JPRB, 2.00259E-01_JPRB, 2.00011E-01_JPRB, 1.99764E-01_JPRB, &
+     & 1.99517E-01_JPRB, 1.99270E-01_JPRB, 1.99024E-01_JPRB, 1.98777E-01_JPRB/)
+      KAO_MO3( 1, :,12) = (/ &
+     & 4.13201E-01_JPRB, 4.05258E-01_JPRB, 3.97468E-01_JPRB, 3.89828E-01_JPRB, 3.82334E-01_JPRB, &
+     & 3.74985E-01_JPRB, 3.67777E-01_JPRB, 3.60707E-01_JPRB, 3.53774E-01_JPRB, 3.46973E-01_JPRB, &
+     & 3.40303E-01_JPRB, 3.33762E-01_JPRB, 3.27346E-01_JPRB, 3.21054E-01_JPRB, 3.14882E-01_JPRB, &
+     & 3.08829E-01_JPRB, 3.02893E-01_JPRB, 2.97071E-01_JPRB, 2.91360E-01_JPRB/)
+      KAO_MO3( 2, :,12) = (/ &
+     & 4.12835E-01_JPRB, 4.04897E-01_JPRB, 3.97112E-01_JPRB, 3.89477E-01_JPRB, 3.81988E-01_JPRB, &
+     & 3.74644E-01_JPRB, 3.67440E-01_JPRB, 3.60376E-01_JPRB, 3.53447E-01_JPRB, 3.46651E-01_JPRB, &
+     & 3.39986E-01_JPRB, 3.33449E-01_JPRB, 3.27038E-01_JPRB, 3.20750E-01_JPRB, 3.14582E-01_JPRB, &
+     & 3.08534E-01_JPRB, 3.02602E-01_JPRB, 2.96784E-01_JPRB, 2.91077E-01_JPRB/)
+      KAO_MO3( 3, :,12) = (/ &
+     & 4.13023E-01_JPRB, 4.05079E-01_JPRB, 3.97289E-01_JPRB, 3.89648E-01_JPRB, 3.82155E-01_JPRB, &
+     & 3.74805E-01_JPRB, 3.67597E-01_JPRB, 3.60527E-01_JPRB, 3.53594E-01_JPRB, 3.46793E-01_JPRB, &
+     & 3.40124E-01_JPRB, 3.33583E-01_JPRB, 3.27167E-01_JPRB, 3.20875E-01_JPRB, 3.14704E-01_JPRB, &
+     & 3.08652E-01_JPRB, 3.02716E-01_JPRB, 2.96894E-01_JPRB, 2.91184E-01_JPRB/)
+      KAO_MO3( 4, :,12) = (/ &
+     & 4.13397E-01_JPRB, 4.05437E-01_JPRB, 3.97630E-01_JPRB, 3.89973E-01_JPRB, 3.82463E-01_JPRB, &
+     & 3.75099E-01_JPRB, 3.67876E-01_JPRB, 3.60792E-01_JPRB, 3.53844E-01_JPRB, 3.47031E-01_JPRB, &
+     & 3.40348E-01_JPRB, 3.33794E-01_JPRB, 3.27367E-01_JPRB, 3.21063E-01_JPRB, 3.14880E-01_JPRB, &
+     & 3.08817E-01_JPRB, 3.02870E-01_JPRB, 2.97038E-01_JPRB, 2.91318E-01_JPRB/)
+      KAO_MO3( 5, :,12) = (/ &
+     & 4.13043E-01_JPRB, 4.05106E-01_JPRB, 3.97321E-01_JPRB, 3.89686E-01_JPRB, 3.82198E-01_JPRB, &
+     & 3.74854E-01_JPRB, 3.67651E-01_JPRB, 3.60586E-01_JPRB, 3.53657E-01_JPRB, 3.46861E-01_JPRB, &
+     & 3.40195E-01_JPRB, 3.33658E-01_JPRB, 3.27246E-01_JPRB, 3.20958E-01_JPRB, 3.14790E-01_JPRB, &
+     & 3.08741E-01_JPRB, 3.02808E-01_JPRB, 2.96990E-01_JPRB, 2.91283E-01_JPRB/)
+      KAO_MO3( 6, :,12) = (/ &
+     & 4.13151E-01_JPRB, 4.05202E-01_JPRB, 3.97406E-01_JPRB, 3.89760E-01_JPRB, 3.82261E-01_JPRB, &
+     & 3.74906E-01_JPRB, 3.67693E-01_JPRB, 3.60619E-01_JPRB, 3.53680E-01_JPRB, 3.46876E-01_JPRB, &
+     & 3.40202E-01_JPRB, 3.33656E-01_JPRB, 3.27237E-01_JPRB, 3.20941E-01_JPRB, 3.14766E-01_JPRB, &
+     & 3.08710E-01_JPRB, 3.02770E-01_JPRB, 2.96945E-01_JPRB, 2.91232E-01_JPRB/)
+      KAO_MO3( 7, :,12) = (/ &
+     & 4.13052E-01_JPRB, 4.05109E-01_JPRB, 3.97319E-01_JPRB, 3.89678E-01_JPRB, 3.82185E-01_JPRB, &
+     & 3.74835E-01_JPRB, 3.67627E-01_JPRB, 3.60557E-01_JPRB, 3.53624E-01_JPRB, 3.46823E-01_JPRB, &
+     & 3.40154E-01_JPRB, 3.33612E-01_JPRB, 3.27197E-01_JPRB, 3.20905E-01_JPRB, 3.14734E-01_JPRB, &
+     & 3.08681E-01_JPRB, 3.02745E-01_JPRB, 2.96923E-01_JPRB, 2.91213E-01_JPRB/)
+      KAO_MO3( 8, :,12) = (/ &
+     & 4.13152E-01_JPRB, 4.05209E-01_JPRB, 3.97418E-01_JPRB, 3.89778E-01_JPRB, 3.82284E-01_JPRB, &
+     & 3.74935E-01_JPRB, 3.67727E-01_JPRB, 3.60657E-01_JPRB, 3.53723E-01_JPRB, 3.46923E-01_JPRB, &
+     & 3.40253E-01_JPRB, 3.33712E-01_JPRB, 3.27296E-01_JPRB, 3.21004E-01_JPRB, 3.14833E-01_JPRB, &
+     & 3.08780E-01_JPRB, 3.02844E-01_JPRB, 2.97021E-01_JPRB, 2.91311E-01_JPRB/)
+      KAO_MO3( 9, :,12) = (/ &
+     & 1.31008E-01_JPRB, 1.30607E-01_JPRB, 1.30208E-01_JPRB, 1.29810E-01_JPRB, 1.29413E-01_JPRB, &
+     & 1.29017E-01_JPRB, 1.28623E-01_JPRB, 1.28229E-01_JPRB, 1.27837E-01_JPRB, 1.27446E-01_JPRB, &
+     & 1.27056E-01_JPRB, 1.26668E-01_JPRB, 1.26280E-01_JPRB, 1.25894E-01_JPRB, 1.25509E-01_JPRB, &
+     & 1.25125E-01_JPRB, 1.24743E-01_JPRB, 1.24361E-01_JPRB, 1.23981E-01_JPRB/)
+      KAO_MO3( 1, :,13) = (/ &
+     & 4.66826E-01_JPRB, 4.71437E-01_JPRB, 4.76094E-01_JPRB, 4.80798E-01_JPRB, 4.85547E-01_JPRB, &
+     & 4.90344E-01_JPRB, 4.95187E-01_JPRB, 5.00079E-01_JPRB, 5.05019E-01_JPRB, 5.10008E-01_JPRB, &
+     & 5.15046E-01_JPRB, 5.20134E-01_JPRB, 5.25272E-01_JPRB, 5.30461E-01_JPRB, 5.35701E-01_JPRB, &
+     & 5.40993E-01_JPRB, 5.46338E-01_JPRB, 5.51735E-01_JPRB, 5.57185E-01_JPRB/)
+      KAO_MO3( 2, :,13) = (/ &
+     & 4.66579E-01_JPRB, 4.71199E-01_JPRB, 4.75865E-01_JPRB, 4.80577E-01_JPRB, 4.85336E-01_JPRB, &
+     & 4.90141E-01_JPRB, 4.94995E-01_JPRB, 4.99896E-01_JPRB, 5.04846E-01_JPRB, 5.09845E-01_JPRB, &
+     & 5.14893E-01_JPRB, 5.19992E-01_JPRB, 5.25141E-01_JPRB, 5.30340E-01_JPRB, 5.35592E-01_JPRB, &
+     & 5.40895E-01_JPRB, 5.46251E-01_JPRB, 5.51660E-01_JPRB, 5.57122E-01_JPRB/)
+      KAO_MO3( 3, :,13) = (/ &
+     & 4.66956E-01_JPRB, 4.71567E-01_JPRB, 4.76224E-01_JPRB, 4.80927E-01_JPRB, 4.85677E-01_JPRB, &
+     & 4.90474E-01_JPRB, 4.95318E-01_JPRB, 5.00209E-01_JPRB, 5.05149E-01_JPRB, 5.10138E-01_JPRB, &
+     & 5.15176E-01_JPRB, 5.20264E-01_JPRB, 5.25402E-01_JPRB, 5.30591E-01_JPRB, 5.35831E-01_JPRB, &
+     & 5.41123E-01_JPRB, 5.46467E-01_JPRB, 5.51864E-01_JPRB, 5.57314E-01_JPRB/)
+      KAO_MO3( 4, :,13) = (/ &
+     & 4.66456E-01_JPRB, 4.71080E-01_JPRB, 4.75750E-01_JPRB, 4.80467E-01_JPRB, 4.85230E-01_JPRB, &
+     & 4.90040E-01_JPRB, 4.94898E-01_JPRB, 4.99804E-01_JPRB, 5.04759E-01_JPRB, 5.09763E-01_JPRB, &
+     & 5.14817E-01_JPRB, 5.19920E-01_JPRB, 5.25075E-01_JPRB, 5.30280E-01_JPRB, 5.35537E-01_JPRB, &
+     & 5.40846E-01_JPRB, 5.46208E-01_JPRB, 5.51622E-01_JPRB, 5.57091E-01_JPRB/)
+      KAO_MO3( 5, :,13) = (/ &
+     & 4.66853E-01_JPRB, 4.71456E-01_JPRB, 4.76104E-01_JPRB, 4.80798E-01_JPRB, 4.85539E-01_JPRB, &
+     & 4.90326E-01_JPRB, 4.95160E-01_JPRB, 5.00042E-01_JPRB, 5.04973E-01_JPRB, 5.09952E-01_JPRB, &
+     & 5.14979E-01_JPRB, 5.20057E-01_JPRB, 5.25185E-01_JPRB, 5.30363E-01_JPRB, 5.35592E-01_JPRB, &
+     & 5.40873E-01_JPRB, 5.46205E-01_JPRB, 5.51591E-01_JPRB, 5.57029E-01_JPRB/)
+      KAO_MO3( 6, :,13) = (/ &
+     & 4.66832E-01_JPRB, 4.71448E-01_JPRB, 4.76110E-01_JPRB, 4.80817E-01_JPRB, 4.85571E-01_JPRB, &
+     & 4.90372E-01_JPRB, 4.95221E-01_JPRB, 5.00118E-01_JPRB, 5.05063E-01_JPRB, 5.10056E-01_JPRB, &
+     & 5.15100E-01_JPRB, 5.20193E-01_JPRB, 5.25336E-01_JPRB, 5.30531E-01_JPRB, 5.35776E-01_JPRB, &
+     & 5.41074E-01_JPRB, 5.46424E-01_JPRB, 5.51826E-01_JPRB, 5.57283E-01_JPRB/)
+      KAO_MO3( 7, :,13) = (/ &
+     & 4.66679E-01_JPRB, 4.71299E-01_JPRB, 4.75965E-01_JPRB, 4.80677E-01_JPRB, 4.85436E-01_JPRB, &
+     & 4.90241E-01_JPRB, 4.95095E-01_JPRB, 4.99996E-01_JPRB, 5.04946E-01_JPRB, 5.09945E-01_JPRB, &
+     & 5.14993E-01_JPRB, 5.20092E-01_JPRB, 5.25240E-01_JPRB, 5.30440E-01_JPRB, 5.35692E-01_JPRB, &
+     & 5.40995E-01_JPRB, 5.46351E-01_JPRB, 5.51759E-01_JPRB, 5.57222E-01_JPRB/)
+      KAO_MO3( 8, :,13) = (/ &
+     & 4.66982E-01_JPRB, 4.71598E-01_JPRB, 4.76260E-01_JPRB, 4.80967E-01_JPRB, 4.85721E-01_JPRB, &
+     & 4.90522E-01_JPRB, 4.95371E-01_JPRB, 5.00268E-01_JPRB, 5.05213E-01_JPRB, 5.10206E-01_JPRB, &
+     & 5.15250E-01_JPRB, 5.20343E-01_JPRB, 5.25486E-01_JPRB, 5.30680E-01_JPRB, 5.35926E-01_JPRB, &
+     & 5.41223E-01_JPRB, 5.46573E-01_JPRB, 5.51976E-01_JPRB, 5.57432E-01_JPRB/)
+      KAO_MO3( 9, :,13) = (/ &
+     & 1.13709E-01_JPRB, 1.13141E-01_JPRB, 1.12576E-01_JPRB, 1.12013E-01_JPRB, 1.11453E-01_JPRB, &
+     & 1.10897E-01_JPRB, 1.10342E-01_JPRB, 1.09791E-01_JPRB, 1.09242E-01_JPRB, 1.08696E-01_JPRB, &
+     & 1.08153E-01_JPRB, 1.07613E-01_JPRB, 1.07075E-01_JPRB, 1.06540E-01_JPRB, 1.06007E-01_JPRB, &
+     & 1.05478E-01_JPRB, 1.04951E-01_JPRB, 1.04426E-01_JPRB, 1.03904E-01_JPRB/)
+      KAO_MO3( 1, :,14) = (/ &
+     & 5.67608E-01_JPRB, 5.55796E-01_JPRB, 5.44230E-01_JPRB, 5.32904E-01_JPRB, 5.21814E-01_JPRB, &
+     & 5.10955E-01_JPRB, 5.00322E-01_JPRB, 4.89910E-01_JPRB, 4.79714E-01_JPRB, 4.69731E-01_JPRB, &
+     & 4.59956E-01_JPRB, 4.50384E-01_JPRB, 4.41011E-01_JPRB, 4.31834E-01_JPRB, 4.22847E-01_JPRB, &
+     & 4.14048E-01_JPRB, 4.05431E-01_JPRB, 3.96994E-01_JPRB, 3.88732E-01_JPRB/)
+      KAO_MO3( 2, :,14) = (/ &
+     & 5.67766E-01_JPRB, 5.55948E-01_JPRB, 5.44376E-01_JPRB, 5.33045E-01_JPRB, 5.21950E-01_JPRB, &
+     & 5.11086E-01_JPRB, 5.00448E-01_JPRB, 4.90031E-01_JPRB, 4.79831E-01_JPRB, 4.69844E-01_JPRB, &
+     & 4.60064E-01_JPRB, 4.50488E-01_JPRB, 4.41111E-01_JPRB, 4.31930E-01_JPRB, 4.22939E-01_JPRB, &
+     & 4.14136E-01_JPRB, 4.05516E-01_JPRB, 3.97075E-01_JPRB, 3.88810E-01_JPRB/)
+      KAO_MO3( 3, :,14) = (/ &
+     & 5.67460E-01_JPRB, 5.55647E-01_JPRB, 5.44080E-01_JPRB, 5.32754E-01_JPRB, 5.21664E-01_JPRB, &
+     & 5.10805E-01_JPRB, 5.00172E-01_JPRB, 4.89760E-01_JPRB, 4.79564E-01_JPRB, 4.69582E-01_JPRB, &
+     & 4.59806E-01_JPRB, 4.50235E-01_JPRB, 4.40862E-01_JPRB, 4.31685E-01_JPRB, 4.22699E-01_JPRB, &
+     & 4.13900E-01_JPRB, 4.05284E-01_JPRB, 3.96847E-01_JPRB, 3.88586E-01_JPRB/)
+      KAO_MO3( 4, :,14) = (/ &
+     & 5.67925E-01_JPRB, 5.56107E-01_JPRB, 5.44536E-01_JPRB, 5.33205E-01_JPRB, 5.22110E-01_JPRB, &
+     & 5.11246E-01_JPRB, 5.00608E-01_JPRB, 4.90191E-01_JPRB, 4.79991E-01_JPRB, 4.70004E-01_JPRB, &
+     & 4.60224E-01_JPRB, 4.50647E-01_JPRB, 4.41270E-01_JPRB, 4.32088E-01_JPRB, 4.23097E-01_JPRB, &
+     & 4.14293E-01_JPRB, 4.05673E-01_JPRB, 3.97231E-01_JPRB, 3.88966E-01_JPRB/)
+      KAO_MO3( 5, :,14) = (/ &
+     & 5.67520E-01_JPRB, 5.55733E-01_JPRB, 5.44190E-01_JPRB, 5.32887E-01_JPRB, 5.21818E-01_JPRB, &
+     & 5.10980E-01_JPRB, 5.00366E-01_JPRB, 4.89974E-01_JPRB, 4.79797E-01_JPRB, 4.69831E-01_JPRB, &
+     & 4.60072E-01_JPRB, 4.50516E-01_JPRB, 4.41159E-01_JPRB, 4.31996E-01_JPRB, 4.23023E-01_JPRB, &
+     & 4.14236E-01_JPRB, 4.05633E-01_JPRB, 3.97207E-01_JPRB, 3.88957E-01_JPRB/)
+      KAO_MO3( 6, :,14) = (/ &
+     & 5.67549E-01_JPRB, 5.55749E-01_JPRB, 5.44195E-01_JPRB, 5.32880E-01_JPRB, 5.21801E-01_JPRB, &
+     & 5.10952E-01_JPRB, 5.00329E-01_JPRB, 4.89927E-01_JPRB, 4.79740E-01_JPRB, 4.69766E-01_JPRB, &
+     & 4.59999E-01_JPRB, 4.50435E-01_JPRB, 4.41070E-01_JPRB, 4.31900E-01_JPRB, 4.22920E-01_JPRB, &
+     & 4.14127E-01_JPRB, 4.05517E-01_JPRB, 3.97086E-01_JPRB, 3.88830E-01_JPRB/)
+      KAO_MO3( 7, :,14) = (/ &
+     & 5.67727E-01_JPRB, 5.55909E-01_JPRB, 5.44337E-01_JPRB, 5.33005E-01_JPRB, 5.21910E-01_JPRB, &
+     & 5.11046E-01_JPRB, 5.00408E-01_JPRB, 4.89991E-01_JPRB, 4.79791E-01_JPRB, 4.69804E-01_JPRB, &
+     & 4.60024E-01_JPRB, 4.50448E-01_JPRB, 4.41071E-01_JPRB, 4.31890E-01_JPRB, 4.22900E-01_JPRB, &
+     & 4.14096E-01_JPRB, 4.05476E-01_JPRB, 3.97036E-01_JPRB, 3.88771E-01_JPRB/)
+      KAO_MO3( 8, :,14) = (/ &
+     & 5.67795E-01_JPRB, 5.55965E-01_JPRB, 5.44381E-01_JPRB, 5.33039E-01_JPRB, 5.21933E-01_JPRB, &
+     & 5.11058E-01_JPRB, 5.00410E-01_JPRB, 4.89984E-01_JPRB, 4.79775E-01_JPRB, 4.69779E-01_JPRB, &
+     & 4.59991E-01_JPRB, 4.50407E-01_JPRB, 4.41023E-01_JPRB, 4.31834E-01_JPRB, 4.22836E-01_JPRB, &
+     & 4.14026E-01_JPRB, 4.05400E-01_JPRB, 3.96953E-01_JPRB, 3.88683E-01_JPRB/)
+      KAO_MO3( 9, :,14) = (/ &
+     & 1.32957E-01_JPRB, 1.31737E-01_JPRB, 1.30528E-01_JPRB, 1.29330E-01_JPRB, 1.28143E-01_JPRB, &
+     & 1.26967E-01_JPRB, 1.25802E-01_JPRB, 1.24648E-01_JPRB, 1.23504E-01_JPRB, 1.22370E-01_JPRB, &
+     & 1.21247E-01_JPRB, 1.20135E-01_JPRB, 1.19032E-01_JPRB, 1.17940E-01_JPRB, 1.16857E-01_JPRB, &
+     & 1.15785E-01_JPRB, 1.14722E-01_JPRB, 1.13669E-01_JPRB, 1.12626E-01_JPRB/)
+      KAO_MO3( 1, :,15) = (/ &
+     & 1.51281E-01_JPRB, 1.53439E-01_JPRB, 1.55628E-01_JPRB, 1.57848E-01_JPRB, 1.60100E-01_JPRB, &
+     & 1.62384E-01_JPRB, 1.64700E-01_JPRB, 1.67049E-01_JPRB, 1.69432E-01_JPRB, 1.71849E-01_JPRB, &
+     & 1.74301E-01_JPRB, 1.76787E-01_JPRB, 1.79309E-01_JPRB, 1.81866E-01_JPRB, 1.84461E-01_JPRB, &
+     & 1.87092E-01_JPRB, 1.89761E-01_JPRB, 1.92468E-01_JPRB, 1.95213E-01_JPRB/)
+      KAO_MO3( 2, :,15) = (/ &
+     & 1.51431E-01_JPRB, 1.53589E-01_JPRB, 1.55778E-01_JPRB, 1.57998E-01_JPRB, 1.60250E-01_JPRB, &
+     & 1.62534E-01_JPRB, 1.64850E-01_JPRB, 1.67199E-01_JPRB, 1.69582E-01_JPRB, 1.71999E-01_JPRB, &
+     & 1.74450E-01_JPRB, 1.76937E-01_JPRB, 1.79458E-01_JPRB, 1.82016E-01_JPRB, 1.84610E-01_JPRB, &
+     & 1.87241E-01_JPRB, 1.89909E-01_JPRB, 1.92616E-01_JPRB, 1.95361E-01_JPRB/)
+      KAO_MO3( 3, :,15) = (/ &
+     & 1.51299E-01_JPRB, 1.53461E-01_JPRB, 1.55654E-01_JPRB, 1.57878E-01_JPRB, 1.60134E-01_JPRB, &
+     & 1.62422E-01_JPRB, 1.64744E-01_JPRB, 1.67098E-01_JPRB, 1.69486E-01_JPRB, 1.71908E-01_JPRB, &
+     & 1.74364E-01_JPRB, 1.76856E-01_JPRB, 1.79383E-01_JPRB, 1.81947E-01_JPRB, 1.84547E-01_JPRB, &
+     & 1.87184E-01_JPRB, 1.89859E-01_JPRB, 1.92572E-01_JPRB, 1.95324E-01_JPRB/)
+      KAO_MO3( 4, :,15) = (/ &
+     & 1.51281E-01_JPRB, 1.53439E-01_JPRB, 1.55628E-01_JPRB, 1.57848E-01_JPRB, 1.60100E-01_JPRB, &
+     & 1.62384E-01_JPRB, 1.64700E-01_JPRB, 1.67049E-01_JPRB, 1.69432E-01_JPRB, 1.71849E-01_JPRB, &
+     & 1.74301E-01_JPRB, 1.76787E-01_JPRB, 1.79309E-01_JPRB, 1.81866E-01_JPRB, 1.84461E-01_JPRB, &
+     & 1.87092E-01_JPRB, 1.89761E-01_JPRB, 1.92468E-01_JPRB, 1.95213E-01_JPRB/)
+      KAO_MO3( 5, :,15) = (/ &
+     & 1.51281E-01_JPRB, 1.53439E-01_JPRB, 1.55628E-01_JPRB, 1.57848E-01_JPRB, 1.60100E-01_JPRB, &
+     & 1.62384E-01_JPRB, 1.64700E-01_JPRB, 1.67049E-01_JPRB, 1.69432E-01_JPRB, 1.71849E-01_JPRB, &
+     & 1.74301E-01_JPRB, 1.76787E-01_JPRB, 1.79309E-01_JPRB, 1.81866E-01_JPRB, 1.84461E-01_JPRB, &
+     & 1.87092E-01_JPRB, 1.89761E-01_JPRB, 1.92468E-01_JPRB, 1.95213E-01_JPRB/)
+      KAO_MO3( 6, :,15) = (/ &
+     & 1.51299E-01_JPRB, 1.53461E-01_JPRB, 1.55654E-01_JPRB, 1.57878E-01_JPRB, 1.60134E-01_JPRB, &
+     & 1.62422E-01_JPRB, 1.64744E-01_JPRB, 1.67098E-01_JPRB, 1.69486E-01_JPRB, 1.71908E-01_JPRB, &
+     & 1.74364E-01_JPRB, 1.76856E-01_JPRB, 1.79383E-01_JPRB, 1.81947E-01_JPRB, 1.84547E-01_JPRB, &
+     & 1.87184E-01_JPRB, 1.89859E-01_JPRB, 1.92572E-01_JPRB, 1.95324E-01_JPRB/)
+      KAO_MO3( 7, :,15) = (/ &
+     & 1.51299E-01_JPRB, 1.53461E-01_JPRB, 1.55654E-01_JPRB, 1.57878E-01_JPRB, 1.60134E-01_JPRB, &
+     & 1.62422E-01_JPRB, 1.64744E-01_JPRB, 1.67098E-01_JPRB, 1.69486E-01_JPRB, 1.71908E-01_JPRB, &
+     & 1.74364E-01_JPRB, 1.76856E-01_JPRB, 1.79383E-01_JPRB, 1.81947E-01_JPRB, 1.84547E-01_JPRB, &
+     & 1.87184E-01_JPRB, 1.89859E-01_JPRB, 1.92572E-01_JPRB, 1.95324E-01_JPRB/)
+      KAO_MO3( 8, :,15) = (/ &
+     & 1.51281E-01_JPRB, 1.53439E-01_JPRB, 1.55628E-01_JPRB, 1.57848E-01_JPRB, 1.60100E-01_JPRB, &
+     & 1.62384E-01_JPRB, 1.64700E-01_JPRB, 1.67049E-01_JPRB, 1.69432E-01_JPRB, 1.71849E-01_JPRB, &
+     & 1.74301E-01_JPRB, 1.76787E-01_JPRB, 1.79309E-01_JPRB, 1.81866E-01_JPRB, 1.84461E-01_JPRB, &
+     & 1.87092E-01_JPRB, 1.89761E-01_JPRB, 1.92468E-01_JPRB, 1.95213E-01_JPRB/)
+      KAO_MO3( 9, :,15) = (/ &
+     & 2.44180E-01_JPRB, 2.35686E-01_JPRB, 2.27487E-01_JPRB, 2.19574E-01_JPRB, 2.11935E-01_JPRB, &
+     & 2.04563E-01_JPRB, 1.97447E-01_JPRB, 1.90578E-01_JPRB, 1.83949E-01_JPRB, 1.77550E-01_JPRB, &
+     & 1.71373E-01_JPRB, 1.65412E-01_JPRB, 1.59658E-01_JPRB, 1.54104E-01_JPRB, 1.48743E-01_JPRB, &
+     & 1.43569E-01_JPRB, 1.38574E-01_JPRB, 1.33754E-01_JPRB, 1.29101E-01_JPRB/)
+      KAO_MO3( 1, :,16) = (/ &
+     & 1.02934E-01_JPRB, 1.04369E-01_JPRB, 1.05825E-01_JPRB, 1.07300E-01_JPRB, 1.08797E-01_JPRB, &
+     & 1.10314E-01_JPRB, 1.11852E-01_JPRB, 1.13412E-01_JPRB, 1.14993E-01_JPRB, 1.16597E-01_JPRB, &
+     & 1.18223E-01_JPRB, 1.19871E-01_JPRB, 1.21543E-01_JPRB, 1.23238E-01_JPRB, 1.24956E-01_JPRB, &
+     & 1.26699E-01_JPRB, 1.28466E-01_JPRB, 1.30257E-01_JPRB, 1.32073E-01_JPRB/)
+      KAO_MO3( 2, :,16) = (/ &
+     & 1.02934E-01_JPRB, 1.04369E-01_JPRB, 1.05825E-01_JPRB, 1.07300E-01_JPRB, 1.08797E-01_JPRB, &
+     & 1.10314E-01_JPRB, 1.11852E-01_JPRB, 1.13412E-01_JPRB, 1.14993E-01_JPRB, 1.16597E-01_JPRB, &
+     & 1.18223E-01_JPRB, 1.19871E-01_JPRB, 1.21543E-01_JPRB, 1.23238E-01_JPRB, 1.24956E-01_JPRB, &
+     & 1.26699E-01_JPRB, 1.28466E-01_JPRB, 1.30257E-01_JPRB, 1.32073E-01_JPRB/)
+      KAO_MO3( 3, :,16) = (/ &
+     & 1.02934E-01_JPRB, 1.04369E-01_JPRB, 1.05825E-01_JPRB, 1.07300E-01_JPRB, 1.08797E-01_JPRB, &
+     & 1.10314E-01_JPRB, 1.11852E-01_JPRB, 1.13412E-01_JPRB, 1.14993E-01_JPRB, 1.16597E-01_JPRB, &
+     & 1.18223E-01_JPRB, 1.19871E-01_JPRB, 1.21543E-01_JPRB, 1.23238E-01_JPRB, 1.24956E-01_JPRB, &
+     & 1.26699E-01_JPRB, 1.28466E-01_JPRB, 1.30257E-01_JPRB, 1.32073E-01_JPRB/)
+      KAO_MO3( 4, :,16) = (/ &
+     & 1.02934E-01_JPRB, 1.04369E-01_JPRB, 1.05825E-01_JPRB, 1.07300E-01_JPRB, 1.08797E-01_JPRB, &
+     & 1.10314E-01_JPRB, 1.11852E-01_JPRB, 1.13412E-01_JPRB, 1.14993E-01_JPRB, 1.16597E-01_JPRB, &
+     & 1.18223E-01_JPRB, 1.19871E-01_JPRB, 1.21543E-01_JPRB, 1.23238E-01_JPRB, 1.24956E-01_JPRB, &
+     & 1.26699E-01_JPRB, 1.28466E-01_JPRB, 1.30257E-01_JPRB, 1.32073E-01_JPRB/)
+      KAO_MO3( 5, :,16) = (/ &
+     & 1.02934E-01_JPRB, 1.04369E-01_JPRB, 1.05825E-01_JPRB, 1.07300E-01_JPRB, 1.08797E-01_JPRB, &
+     & 1.10314E-01_JPRB, 1.11852E-01_JPRB, 1.13412E-01_JPRB, 1.14993E-01_JPRB, 1.16597E-01_JPRB, &
+     & 1.18223E-01_JPRB, 1.19871E-01_JPRB, 1.21543E-01_JPRB, 1.23238E-01_JPRB, 1.24956E-01_JPRB, &
+     & 1.26699E-01_JPRB, 1.28466E-01_JPRB, 1.30257E-01_JPRB, 1.32073E-01_JPRB/)
+      KAO_MO3( 6, :,16) = (/ &
+     & 1.02934E-01_JPRB, 1.04369E-01_JPRB, 1.05825E-01_JPRB, 1.07300E-01_JPRB, 1.08797E-01_JPRB, &
+     & 1.10314E-01_JPRB, 1.11852E-01_JPRB, 1.13412E-01_JPRB, 1.14993E-01_JPRB, 1.16597E-01_JPRB, &
+     & 1.18223E-01_JPRB, 1.19871E-01_JPRB, 1.21543E-01_JPRB, 1.23238E-01_JPRB, 1.24956E-01_JPRB, &
+     & 1.26699E-01_JPRB, 1.28466E-01_JPRB, 1.30257E-01_JPRB, 1.32073E-01_JPRB/)
+      KAO_MO3( 7, :,16) = (/ &
+     & 1.02934E-01_JPRB, 1.04369E-01_JPRB, 1.05825E-01_JPRB, 1.07300E-01_JPRB, 1.08797E-01_JPRB, &
+     & 1.10314E-01_JPRB, 1.11852E-01_JPRB, 1.13412E-01_JPRB, 1.14993E-01_JPRB, 1.16597E-01_JPRB, &
+     & 1.18223E-01_JPRB, 1.19871E-01_JPRB, 1.21543E-01_JPRB, 1.23238E-01_JPRB, 1.24956E-01_JPRB, &
+     & 1.26699E-01_JPRB, 1.28466E-01_JPRB, 1.30257E-01_JPRB, 1.32073E-01_JPRB/)
+      KAO_MO3( 8, :,16) = (/ &
+     & 1.02934E-01_JPRB, 1.04369E-01_JPRB, 1.05825E-01_JPRB, 1.07300E-01_JPRB, 1.08797E-01_JPRB, &
+     & 1.10314E-01_JPRB, 1.11852E-01_JPRB, 1.13412E-01_JPRB, 1.14993E-01_JPRB, 1.16597E-01_JPRB, &
+     & 1.18223E-01_JPRB, 1.19871E-01_JPRB, 1.21543E-01_JPRB, 1.23238E-01_JPRB, 1.24956E-01_JPRB, &
+     & 1.26699E-01_JPRB, 1.28466E-01_JPRB, 1.30257E-01_JPRB, 1.32073E-01_JPRB/)
+      KAO_MO3( 9, :,16) = (/ &
+     & 3.91531E-01_JPRB, 3.78978E-01_JPRB, 3.66827E-01_JPRB, 3.55067E-01_JPRB, 3.43683E-01_JPRB, &
+     & 3.32664E-01_JPRB, 3.21999E-01_JPRB, 3.11675E-01_JPRB, 3.01683E-01_JPRB, 2.92011E-01_JPRB, &
+     & 2.82648E-01_JPRB, 2.73586E-01_JPRB, 2.64815E-01_JPRB, 2.56325E-01_JPRB, 2.48107E-01_JPRB, &
+     & 2.40152E-01_JPRB, 2.32453E-01_JPRB, 2.25000E-01_JPRB, 2.17787E-01_JPRB/)
+
+
+!     The array FORREFO contains the coefficient of the water vapor
+!     foreign-continuum (including the energy term).  The first 
+!     index refers to reference temperature (296,260,224,260) and 
+!     pressure (970,475,219,3 mbar) levels.  The second index 
+!     runs over the g-channel (1 to 16).
+
+      FORREFO(1,:) = (/ &
+     &1.0689E-05_JPRB,1.6987E-05_JPRB,1.8993E-05_JPRB,3.4470E-05_JPRB,4.0873E-05_JPRB,4.8275E-05_JPRB, &
+     &6.1178E-05_JPRB,6.4035E-05_JPRB,6.6253E-05_JPRB,7.8914E-05_JPRB,8.1640E-05_JPRB,7.9738E-05_JPRB, &
+     &7.8492E-05_JPRB,9.1565E-05_JPRB,1.0262E-04_JPRB,1.0368E-04_JPRB/)
+      FORREFO(2,:) = (/ &
+     &1.1194E-05_JPRB,1.6128E-05_JPRB,1.7213E-05_JPRB,2.6845E-05_JPRB,4.1361E-05_JPRB,5.1508E-05_JPRB, &
+     &6.8245E-05_JPRB,7.4063E-05_JPRB,7.6273E-05_JPRB,8.4061E-05_JPRB,8.2492E-05_JPRB,8.1720E-05_JPRB, &
+     &7.7626E-05_JPRB,1.0096E-04_JPRB,1.0519E-04_JPRB,1.0631E-04_JPRB/)
+      FORREFO(3,:) = (/ &
+     &1.0891E-05_JPRB,1.4933E-05_JPRB,1.7964E-05_JPRB,2.2577E-05_JPRB,4.4290E-05_JPRB,5.4675E-05_JPRB, &
+     &7.2494E-05_JPRB,7.8410E-05_JPRB,7.6948E-05_JPRB,7.5742E-05_JPRB,7.7654E-05_JPRB,8.2760E-05_JPRB, &
+     &7.8443E-05_JPRB,9.8384E-05_JPRB,1.0634E-04_JPRB,1.0838E-04_JPRB/)
+      FORREFO(4,:) = (/ &
+     &1.1316E-05_JPRB,1.5470E-05_JPRB,2.1246E-05_JPRB,3.3349E-05_JPRB,4.8704E-05_JPRB,5.6424E-05_JPRB, &
+     &5.8569E-05_JPRB,5.8780E-05_JPRB,6.0358E-05_JPRB,6.1586E-05_JPRB,6.4281E-05_JPRB,6.9333E-05_JPRB, &
+     &7.2763E-05_JPRB,7.2675E-05_JPRB,7.3754E-05_JPRB,1.0131E-04_JPRB/)
+
+
+!     The array SELFREFO contains the coefficient of the water vapor
+!     self-continuum (including the energy term).  The first index
+!     refers to temperature in 7.2 degree increments.  For instance,
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+!     etc.  The second index runs over the g-channel (1 to 16).
+      SELFREFO(:, 1) = (/ &
+     & 1.27686E-01_JPRB, 1.09347E-01_JPRB, 9.36410E-02_JPRB, 8.01912E-02_JPRB, 6.86732E-02_JPRB, &
+     & 5.88096E-02_JPRB, 5.03627E-02_JPRB, 4.31290E-02_JPRB, 3.69343E-02_JPRB, 3.16294E-02_JPRB/)
+      SELFREFO(:, 2) = (/ &
+     & 1.40051E-01_JPRB, 1.20785E-01_JPRB, 1.04170E-01_JPRB, 8.98402E-02_JPRB, 7.74816E-02_JPRB, &
+     & 6.68231E-02_JPRB, 5.76308E-02_JPRB, 4.97030E-02_JPRB, 4.28658E-02_JPRB, 3.69691E-02_JPRB/)
+      SELFREFO(:, 3) = (/ &
+     & 1.42322E-01_JPRB, 1.22872E-01_JPRB, 1.06080E-01_JPRB, 9.15829E-02_JPRB, 7.90671E-02_JPRB, &
+     & 6.82616E-02_JPRB, 5.89329E-02_JPRB, 5.08790E-02_JPRB, 4.39258E-02_JPRB, 3.79228E-02_JPRB/)
+      SELFREFO(:, 4) = (/ &
+     & 1.53244E-01_JPRB, 1.33057E-01_JPRB, 1.15530E-01_JPRB, 1.00311E-01_JPRB, 8.70977E-02_JPRB, &
+     & 7.56244E-02_JPRB, 6.56626E-02_JPRB, 5.70130E-02_JPRB, 4.95028E-02_JPRB, 4.29819E-02_JPRB/)
+      SELFREFO(:, 5) = (/ &
+     & 1.71011E-01_JPRB, 1.46680E-01_JPRB, 1.25810E-01_JPRB, 1.07910E-01_JPRB, 9.25563E-02_JPRB, &
+     & 7.93874E-02_JPRB, 6.80922E-02_JPRB, 5.84040E-02_JPRB, 5.00943E-02_JPRB, 4.29669E-02_JPRB/)
+      SELFREFO(:, 6) = (/ &
+     & 1.76012E-01_JPRB, 1.51010E-01_JPRB, 1.29560E-01_JPRB, 1.11157E-01_JPRB, 9.53672E-02_JPRB, &
+     & 8.18207E-02_JPRB, 7.01984E-02_JPRB, 6.02270E-02_JPRB, 5.16720E-02_JPRB, 4.43322E-02_JPRB/)
+      SELFREFO(:, 7) = (/ &
+     & 1.85600E-01_JPRB, 1.59051E-01_JPRB, 1.36300E-01_JPRB, 1.16803E-01_JPRB, 1.00095E-01_JPRB, &
+     & 8.57776E-02_JPRB, 7.35077E-02_JPRB, 6.29930E-02_JPRB, 5.39823E-02_JPRB, 4.62606E-02_JPRB/)
+      SELFREFO(:, 8) = (/ &
+     & 1.88931E-01_JPRB, 1.61727E-01_JPRB, 1.38440E-01_JPRB, 1.18506E-01_JPRB, 1.01442E-01_JPRB, &
+     & 8.68356E-02_JPRB, 7.43321E-02_JPRB, 6.36290E-02_JPRB, 5.44670E-02_JPRB, 4.66243E-02_JPRB/)
+      SELFREFO(:, 9) = (/ &
+     & 1.91122E-01_JPRB, 1.63407E-01_JPRB, 1.39710E-01_JPRB, 1.19450E-01_JPRB, 1.02128E-01_JPRB, &
+     & 8.73176E-02_JPRB, 7.46552E-02_JPRB, 6.38290E-02_JPRB, 5.45728E-02_JPRB, 4.66589E-02_JPRB/)
+      SELFREFO(:,10) = (/ &
+     & 1.91334E-01_JPRB, 1.64872E-01_JPRB, 1.42070E-01_JPRB, 1.22421E-01_JPRB, 1.05490E-01_JPRB, &
+     & 9.09008E-02_JPRB, 7.83291E-02_JPRB, 6.74960E-02_JPRB, 5.81612E-02_JPRB, 5.01174E-02_JPRB/)
+      SELFREFO(:,11) = (/ &
+     & 1.89858E-01_JPRB, 1.63934E-01_JPRB, 1.41550E-01_JPRB, 1.22222E-01_JPRB, 1.05534E-01_JPRB, &
+     & 9.11237E-02_JPRB, 7.86814E-02_JPRB, 6.79380E-02_JPRB, 5.86615E-02_JPRB, 5.06517E-02_JPRB/)
+      SELFREFO(:,12) = (/ &
+     & 1.89783E-01_JPRB, 1.63757E-01_JPRB, 1.41300E-01_JPRB, 1.21923E-01_JPRB, 1.05203E-01_JPRB, &
+     & 9.07760E-02_JPRB, 7.83274E-02_JPRB, 6.75860E-02_JPRB, 5.83176E-02_JPRB, 5.03202E-02_JPRB/)
+      SELFREFO(:,13) = (/ &
+     & 1.87534E-01_JPRB, 1.62016E-01_JPRB, 1.39970E-01_JPRB, 1.20924E-01_JPRB, 1.04470E-01_JPRB, &
+     & 9.02541E-02_JPRB, 7.79730E-02_JPRB, 6.73630E-02_JPRB, 5.81967E-02_JPRB, 5.02778E-02_JPRB/)
+      SELFREFO(:,14) = (/ &
+     & 1.99128E-01_JPRB, 1.71410E-01_JPRB, 1.47550E-01_JPRB, 1.27011E-01_JPRB, 1.09332E-01_JPRB, &
+     & 9.41131E-02_JPRB, 8.10128E-02_JPRB, 6.97360E-02_JPRB, 6.00289E-02_JPRB, 5.16731E-02_JPRB/)
+      SELFREFO(:,15) = (/ &
+     & 1.99460E-01_JPRB, 1.72342E-01_JPRB, 1.48910E-01_JPRB, 1.28664E-01_JPRB, 1.11171E-01_JPRB, &
+     & 9.60560E-02_JPRB, 8.29962E-02_JPRB, 7.17120E-02_JPRB, 6.19620E-02_JPRB, 5.35376E-02_JPRB/)
+      SELFREFO(:,16) = (/ &
+     & 1.99906E-01_JPRB, 1.72737E-01_JPRB, 1.49260E-01_JPRB, 1.28974E-01_JPRB, 1.11445E-01_JPRB, &
+     & 9.62982E-02_JPRB, 8.32102E-02_JPRB, 7.19010E-02_JPRB, 6.21288E-02_JPRB, 5.36848E-02_JPRB/)
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB5',1,ZHOOK_HANDLE)
+RETURN
+
+1001 CONTINUE
+CALL ABOR1("RRTM_KGB5:ERROR READING FILE RADRRTM")
+
+END SUBROUTINE RRTM_KGB5
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb5.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb5.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb5.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_KGB5
+END SUBROUTINE RRTM_KGB5
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb6.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb6.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb6.F90	(revision 3908)
@@ -0,0 +1,253 @@
+SUBROUTINE RRTM_KGB6
+
+!     Originally by Eli J. Mlawer, Atmospheric & Environmental Research.
+!     BAND 6:  820-980 cm-1 (low - H2O; high - nothing)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+!     G.Mozdzynski March 2011 read constants from files
+!     ABozzo 201306 updated to rrtmg v4.85
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+USE YOMLUN    ,ONLY : NULRAD
+USE MPL_MODULE,ONLY : MPL_BROADCAST
+USE YOMTAG    ,ONLY : MTAGRAD
+
+USE YOERRTO6 , ONLY : KAO     ,KAO_D,KAO_MCO2, SELFREFO, FORREFO ,FRACREFAO ,CFC11ADJO ,&
+ & CFC12O 
+USE YOMMP0    , ONLY : NPROC, MYPROC
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB6',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+  READ(NULRAD,ERR=1001) KAO_D
+  KAO = REAL(KAO_D,JPRB)
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KAO,MTAGRAD,1,CDSTRING='RRTM_KGB6:')
+ENDIF
+
+
+! Planck fraction mapping level : P = 473.4280 mb, T = 259.83 K
+FRACREFAO(:) = (/ &
+  &   1.4353E-01_JPRB,1.4774E-01_JPRB,1.4467E-01_JPRB,1.3785E-01_JPRB,1.2376E-01_JPRB,1.0214E-01_JPRB, &
+  &   8.1984E-02_JPRB,6.1152E-02_JPRB,4.0987E-02_JPRB,4.5067E-03_JPRB,4.0020E-03_JPRB,3.1772E-03_JPRB, &
+  &   2.3458E-03_JPRB,1.5025E-03_JPRB,5.7415E-04_JPRB,8.2970E-05_JPRB/)
+
+! Minor gas mapping level:
+!     lower - co2, p = 706.2720 mb, t = 294.2 k
+!     upper - cfc11, cfc12
+
+
+!     CFC11 is multiplied by 1.385 to account for the 1060-1107 cm-1 band.
+CFC11ADJO( :) = (/&
+ & 0.0_JPRB,      0.0_JPRB, 36.7627_JPRB, 150.757_JPRB,    &
+ & 81.4109_JPRB, 74.9112_JPRB, 56.9325_JPRB, 49.3226_JPRB,  &
+ & 57.1074_JPRB, 66.1202_JPRB, 109.557_JPRB, 89.0562_JPRB,  &
+ & 149.865_JPRB, 196.140_JPRB, 258.393_JPRB, 80.9923_JPRB/)  
+
+CFC12O( :) = (/&
+ & 62.8368_JPRB, 43.2626_JPRB, 26.7549_JPRB, 22.2487_JPRB,&
+ & 23.5029_JPRB, 34.8323_JPRB, 26.2335_JPRB, 23.2306_JPRB,&
+ & 18.4062_JPRB, 13.9534_JPRB, 22.6268_JPRB, 24.2604_JPRB,&
+ & 30.0088_JPRB, 26.3634_JPRB, 15.8237_JPRB, 57.5050_JPRB/)  
+
+
+!     ------------------------------------------------------------------
+
+!     The array KAO contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels > ~100mb and temperatures.  The first
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the corresponding TREF for this  pressure level, 
+!     JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, 
+!     JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  The second 
+!     index, JP, runs from 1 to 13 and refers to the corresponding 
+!     pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).  
+!     The third index, IG, goes from 1 to 16, and tells us which 
+!     g-interval the absorption coefficients are for.
+
+
+!     The array KAO_Mxx contains the absorption coefficient for 
+!     a minor species at the 16 chosen g-values for a reference pressure
+!     level below 100~ mb.   The first index refers to temperature 
+!     in 7.2 degree increments.  For instance, JT = 1 refers to a 
+!     temperature of 188.0, JT = 2 refers to 195.2, etc. The second index 
+!     runs over the g-channel (1 to 16).
+
+      KAO_MCO2(:, 1) = (/ &
+     & 1.45661E-05_JPRB, 1.73337E-05_JPRB, 2.06273E-05_JPRB, 2.45466E-05_JPRB, 2.92105E-05_JPRB, &
+     & 3.47607E-05_JPRB, 4.13654E-05_JPRB, 4.92251E-05_JPRB, 5.85781E-05_JPRB, 6.97083E-05_JPRB, &
+     & 8.29533E-05_JPRB, 9.87149E-05_JPRB, 1.17471E-04_JPRB, 1.39792E-04_JPRB, 1.66353E-04_JPRB, &
+     & 1.97961E-04_JPRB, 2.35574E-04_JPRB, 2.80335E-04_JPRB, 3.33600E-04_JPRB/)
+      KAO_MCO2(:, 2) = (/ &
+     & 9.96332E-06_JPRB, 1.21229E-05_JPRB, 1.47506E-05_JPRB, 1.79478E-05_JPRB, 2.18381E-05_JPRB, &
+     & 2.65716E-05_JPRB, 3.23310E-05_JPRB, 3.93389E-05_JPRB, 4.78658E-05_JPRB, 5.82408E-05_JPRB, &
+     & 7.08647E-05_JPRB, 8.62250E-05_JPRB, 1.04914E-04_JPRB, 1.27655E-04_JPRB, 1.55325E-04_JPRB, &
+     & 1.88992E-04_JPRB, 2.29957E-04_JPRB, 2.79801E-04_JPRB, 3.40448E-04_JPRB/)
+      KAO_MCO2(:, 3) = (/ &
+     & 1.14968E-05_JPRB, 1.39890E-05_JPRB, 1.70215E-05_JPRB, 2.07115E-05_JPRB, 2.52013E-05_JPRB, &
+     & 3.06644E-05_JPRB, 3.73118E-05_JPRB, 4.54002E-05_JPRB, 5.52420E-05_JPRB, 6.72173E-05_JPRB, &
+     & 8.17887E-05_JPRB, 9.95188E-05_JPRB, 1.21092E-04_JPRB, 1.47343E-04_JPRB, 1.79283E-04_JPRB, &
+     & 2.18148E-04_JPRB, 2.65438E-04_JPRB, 3.22980E-04_JPRB, 3.92995E-04_JPRB/)
+      KAO_MCO2(:, 4) = (/ &
+     & 1.02186E-05_JPRB, 1.23232E-05_JPRB, 1.48613E-05_JPRB, 1.79222E-05_JPRB, 2.16134E-05_JPRB, &
+     & 2.60649E-05_JPRB, 3.14332E-05_JPRB, 3.79071E-05_JPRB, 4.57145E-05_JPRB, 5.51297E-05_JPRB, &
+     & 6.64843E-05_JPRB, 8.01773E-05_JPRB, 9.66905E-05_JPRB, 1.16605E-04_JPRB, 1.40621E-04_JPRB, &
+     & 1.69583E-04_JPRB, 2.04510E-04_JPRB, 2.46631E-04_JPRB, 2.97426E-04_JPRB/)
+      KAO_MCO2(:, 5) = (/ &
+     & 1.03469E-05_JPRB, 1.24680E-05_JPRB, 1.50239E-05_JPRB, 1.81037E-05_JPRB, 2.18149E-05_JPRB, &
+     & 2.62869E-05_JPRB, 3.16756E-05_JPRB, 3.81690E-05_JPRB, 4.59935E-05_JPRB, 5.54220E-05_JPRB, &
+     & 6.67833E-05_JPRB, 8.04737E-05_JPRB, 9.69704E-05_JPRB, 1.16849E-04_JPRB, 1.40803E-04_JPRB, &
+     & 1.69667E-04_JPRB, 2.04448E-04_JPRB, 2.46359E-04_JPRB, 2.96861E-04_JPRB/)
+      KAO_MCO2(:, 6) = (/ &
+     & 1.71660E-05_JPRB, 2.07334E-05_JPRB, 2.50420E-05_JPRB, 3.02461E-05_JPRB, 3.65317E-05_JPRB, &
+     & 4.41235E-05_JPRB, 5.32930E-05_JPRB, 6.43680E-05_JPRB, 7.77446E-05_JPRB, 9.39010E-05_JPRB, &
+     & 1.13415E-04_JPRB, 1.36984E-04_JPRB, 1.65451E-04_JPRB, 1.99835E-04_JPRB, 2.41363E-04_JPRB, &
+     & 2.91522E-04_JPRB, 3.52104E-04_JPRB, 4.25276E-04_JPRB, 5.13654E-04_JPRB/)
+      KAO_MCO2(:, 7) = (/ &
+     & 4.78803E-05_JPRB, 5.79395E-05_JPRB, 7.01119E-05_JPRB, 8.48418E-05_JPRB, 1.02666E-04_JPRB, &
+     & 1.24235E-04_JPRB, 1.50336E-04_JPRB, 1.81920E-04_JPRB, 2.20139E-04_JPRB, 2.66388E-04_JPRB, &
+     & 3.22354E-04_JPRB, 3.90077E-04_JPRB, 4.72028E-04_JPRB, 5.71197E-04_JPRB, 6.91199E-04_JPRB, &
+     & 8.36413E-04_JPRB, 1.01214E-03_JPRB, 1.22477E-03_JPRB, 1.48209E-03_JPRB/)
+      KAO_MCO2(:, 8) = (/ &
+     & 1.27954E-04_JPRB, 1.55281E-04_JPRB, 1.88445E-04_JPRB, 2.28692E-04_JPRB, 2.77534E-04_JPRB, &
+     & 3.36808E-04_JPRB, 4.08741E-04_JPRB, 4.96037E-04_JPRB, 6.01977E-04_JPRB, 7.30542E-04_JPRB, &
+     & 8.86566E-04_JPRB, 1.07591E-03_JPRB, 1.30570E-03_JPRB, 1.58456E-03_JPRB, 1.92298E-03_JPRB, &
+     & 2.33367E-03_JPRB, 2.83208E-03_JPRB, 3.43694E-03_JPRB, 4.17097E-03_JPRB/)
+      KAO_MCO2(:, 9) = (/ &
+     & 2.93792E-05_JPRB, 3.55109E-05_JPRB, 4.29223E-05_JPRB, 5.18805E-05_JPRB, 6.27083E-05_JPRB, &
+     & 7.57960E-05_JPRB, 9.16151E-05_JPRB, 1.10736E-04_JPRB, 1.33847E-04_JPRB, 1.61782E-04_JPRB, &
+     & 1.95547E-04_JPRB, 2.36359E-04_JPRB, 2.85689E-04_JPRB, 3.45315E-04_JPRB, 4.17384E-04_JPRB, &
+     & 5.04495E-04_JPRB, 6.09787E-04_JPRB, 7.37054E-04_JPRB, 8.90882E-04_JPRB/)
+      KAO_MCO2(:,10) = (/ &
+     & 5.08569E-05_JPRB, 6.24700E-05_JPRB, 7.67350E-05_JPRB, 9.42574E-05_JPRB, 1.15781E-04_JPRB, &
+     & 1.42220E-04_JPRB, 1.74695E-04_JPRB, 2.14587E-04_JPRB, 2.63588E-04_JPRB, 3.23778E-04_JPRB, &
+     & 3.97712E-04_JPRB, 4.88530E-04_JPRB, 6.00085E-04_JPRB, 7.37114E-04_JPRB, 9.05433E-04_JPRB, &
+     & 1.11219E-03_JPRB, 1.36616E-03_JPRB, 1.67812E-03_JPRB, 2.06131E-03_JPRB/)
+      KAO_MCO2(:,11) = (/ &
+     & 4.82546E-06_JPRB, 6.21462E-06_JPRB, 8.00369E-06_JPRB, 1.03078E-05_JPRB, 1.32752E-05_JPRB, &
+     & 1.70969E-05_JPRB, 2.20188E-05_JPRB, 2.83575E-05_JPRB, 3.65211E-05_JPRB, 4.70348E-05_JPRB, &
+     & 6.05753E-05_JPRB, 7.80138E-05_JPRB, 1.00472E-04_JPRB, 1.29397E-04_JPRB, 1.66647E-04_JPRB, &
+     & 2.14622E-04_JPRB, 2.76407E-04_JPRB, 3.55980E-04_JPRB, 4.58459E-04_JPRB/)
+      KAO_MCO2(:,12) = (/ &
+     & 2.41346E-06_JPRB, 2.96282E-06_JPRB, 3.63723E-06_JPRB, 4.46516E-06_JPRB, 5.48153E-06_JPRB, &
+     & 6.72926E-06_JPRB, 8.26100E-06_JPRB, 1.01414E-05_JPRB, 1.24498E-05_JPRB, 1.52837E-05_JPRB, &
+     & 1.87627E-05_JPRB, 2.30335E-05_JPRB, 2.82765E-05_JPRB, 3.47129E-05_JPRB, 4.26144E-05_JPRB, &
+     & 5.23144E-05_JPRB, 6.42225E-05_JPRB, 7.88410E-05_JPRB, 9.67871E-05_JPRB/)
+      KAO_MCO2(:,13) = (/ &
+     & 2.76412E-06_JPRB, 3.46195E-06_JPRB, 4.33596E-06_JPRB, 5.43062E-06_JPRB, 6.80164E-06_JPRB, &
+     & 8.51879E-06_JPRB, 1.06695E-05_JPRB, 1.33631E-05_JPRB, 1.67367E-05_JPRB, 2.09621E-05_JPRB, &
+     & 2.62542E-05_JPRB, 3.28824E-05_JPRB, 4.11839E-05_JPRB, 5.15813E-05_JPRB, 6.46035E-05_JPRB, &
+     & 8.09134E-05_JPRB, 1.01341E-04_JPRB, 1.26925E-04_JPRB, 1.58969E-04_JPRB/)
+      KAO_MCO2(:,14) = (/ &
+     & 1.25126E-06_JPRB, 1.54971E-06_JPRB, 1.91935E-06_JPRB, 2.37715E-06_JPRB, 2.94416E-06_JPRB, &
+     & 3.64640E-06_JPRB, 4.51615E-06_JPRB, 5.59335E-06_JPRB, 6.92749E-06_JPRB, 8.57985E-06_JPRB, &
+     & 1.06263E-05_JPRB, 1.31610E-05_JPRB, 1.63001E-05_JPRB, 2.01881E-05_JPRB, 2.50034E-05_JPRB, &
+     & 3.09672E-05_JPRB, 3.83536E-05_JPRB, 4.75018E-05_JPRB, 5.88319E-05_JPRB/)
+      KAO_MCO2(:,15) = (/ &
+     & 1.59748E-06_JPRB, 2.08378E-06_JPRB, 2.71812E-06_JPRB, 3.54557E-06_JPRB, 4.62491E-06_JPRB, &
+     & 6.03282E-06_JPRB, 7.86932E-06_JPRB, 1.02649E-05_JPRB, 1.33897E-05_JPRB, 1.74658E-05_JPRB, &
+     & 2.27827E-05_JPRB, 2.97182E-05_JPRB, 3.87649E-05_JPRB, 5.05657E-05_JPRB, 6.59589E-05_JPRB, &
+     & 8.60380E-05_JPRB, 1.12230E-04_JPRB, 1.46394E-04_JPRB, 1.90959E-04_JPRB/)
+      KAO_MCO2(:,16) = (/ &
+     & 1.68148E-06_JPRB, 2.17133E-06_JPRB, 2.80388E-06_JPRB, 3.62071E-06_JPRB, 4.67549E-06_JPRB, &
+     & 6.03756E-06_JPRB, 7.79642E-06_JPRB, 1.00677E-05_JPRB, 1.30006E-05_JPRB, 1.67879E-05_JPRB, &
+     & 2.16786E-05_JPRB, 2.79941E-05_JPRB, 3.61493E-05_JPRB, 4.66803E-05_JPRB, 6.02792E-05_JPRB, &
+     & 7.78398E-05_JPRB, 1.00516E-04_JPRB, 1.29799E-04_JPRB, 1.67612E-04_JPRB/)
+
+!     The array FORREFO contains the coefficient of the water vapor
+!     foreign-continuum (including the energy term).  The first 
+!     index refers to reference temperature (296,260,224,260) and 
+!     pressure (970,475,219,3 mbar) levels.  The second index 
+!     runs over the g-channel (1 to 16).
+
+      FORREFO(1,:) = (/ &
+     &3.2710E-07_JPRB,5.2119E-07_JPRB,8.4740E-07_JPRB,1.6908E-06_JPRB,2.3433E-06_JPRB,4.4129E-06_JPRB, &
+     &3.8930E-06_JPRB,2.3338E-06_JPRB,2.4115E-06_JPRB,2.4271E-06_JPRB,2.4836E-06_JPRB,2.6470E-06_JPRB, &
+     &2.9559E-06_JPRB,2.3940E-06_JPRB,2.9711E-06_JPRB,2.9511E-06_JPRB/)
+      FORREFO(2,:) = (/ &
+     &6.5125E-07_JPRB,1.2128E-06_JPRB,1.7249E-06_JPRB,2.7126E-06_JPRB,3.1780E-06_JPRB,2.1444E-06_JPRB, &
+     &1.8265E-06_JPRB,1.7385E-06_JPRB,1.4574E-06_JPRB,1.6135E-06_JPRB,2.4966E-06_JPRB,2.8127E-06_JPRB, &
+     &2.5229E-06_JPRB,2.3251E-06_JPRB,2.5353E-06_JPRB,3.0200E-06_JPRB/)
+      FORREFO(3,:) = (/ &
+     &1.4969E-06_JPRB,1.8516E-06_JPRB,2.5791E-06_JPRB,2.7846E-06_JPRB,1.9789E-06_JPRB,1.6688E-06_JPRB, &
+     &1.1037E-06_JPRB,9.9065E-07_JPRB,1.1557E-06_JPRB,7.0847E-07_JPRB,5.7758E-07_JPRB,4.0425E-07_JPRB, &
+     &3.2427E-07_JPRB,3.2267E-07_JPRB,3.1444E-07_JPRB,2.6046E-07_JPRB/)
+      FORREFO(4,:) = (/ &
+     &1.7567E-06_JPRB,1.6891E-06_JPRB,2.1003E-06_JPRB,2.0957E-06_JPRB,2.3664E-06_JPRB,2.1538E-06_JPRB, &
+     &1.5275E-06_JPRB,1.0487E-06_JPRB,8.7390E-07_JPRB,7.9360E-07_JPRB,7.7778E-07_JPRB,8.1445E-07_JPRB, &
+     &8.2121E-07_JPRB,5.4395E-07_JPRB,3.1273E-07_JPRB,3.1848E-07_JPRB/)
+
+
+!     The array SELFREFO contains the coefficient of the water vapor
+!     self-continuum (including the energy term).  The first index
+!     refers to temperature in 7.2 degree increments.  For instance,
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+!     etc.  The second index runs over the g-channel (1 to 16).
+
+      SELFREFO(:, 1) = (/ &
+     & 7.73921E-02_JPRB, 6.45225E-02_JPRB, 5.37930E-02_JPRB, 4.48477E-02_JPRB, 3.73900E-02_JPRB, &
+     & 3.11723E-02_JPRB, 2.59887E-02_JPRB, 2.16670E-02_JPRB, 1.80640E-02_JPRB, 1.50601E-02_JPRB/)
+      SELFREFO(:, 2) = (/ &
+     & 8.47756E-02_JPRB, 7.10616E-02_JPRB, 5.95660E-02_JPRB, 4.99301E-02_JPRB, 4.18529E-02_JPRB, &
+     & 3.50824E-02_JPRB, 2.94072E-02_JPRB, 2.46500E-02_JPRB, 2.06624E-02_JPRB, 1.73199E-02_JPRB/)
+      SELFREFO(:, 3) = (/ &
+     & 8.84829E-02_JPRB, 7.46093E-02_JPRB, 6.29110E-02_JPRB, 5.30469E-02_JPRB, 4.47295E-02_JPRB, &
+     & 3.77161E-02_JPRB, 3.18025E-02_JPRB, 2.68160E-02_JPRB, 2.26114E-02_JPRB, 1.90661E-02_JPRB/)
+      SELFREFO(:, 4) = (/ &
+     & 9.27003E-02_JPRB, 7.88864E-02_JPRB, 6.71310E-02_JPRB, 5.71273E-02_JPRB, 4.86144E-02_JPRB, &
+     & 4.13700E-02_JPRB, 3.52052E-02_JPRB, 2.99590E-02_JPRB, 2.54946E-02_JPRB, 2.16955E-02_JPRB/)
+      SELFREFO(:, 5) = (/ &
+     & 9.14315E-02_JPRB, 7.85661E-02_JPRB, 6.75110E-02_JPRB, 5.80115E-02_JPRB, 4.98487E-02_JPRB, &
+     & 4.28344E-02_JPRB, 3.68072E-02_JPRB, 3.16280E-02_JPRB, 2.71776E-02_JPRB, 2.33534E-02_JPRB/)
+      SELFREFO(:, 6) = (/ &
+     & 7.72984E-02_JPRB, 6.91044E-02_JPRB, 6.17790E-02_JPRB, 5.52301E-02_JPRB, 4.93755E-02_JPRB, &
+     & 4.41414E-02_JPRB, 3.94622E-02_JPRB, 3.52790E-02_JPRB, 3.15392E-02_JPRB, 2.81959E-02_JPRB/)
+      SELFREFO(:, 7) = (/ &
+     & 7.46998E-02_JPRB, 6.66597E-02_JPRB, 5.94850E-02_JPRB, 5.30825E-02_JPRB, 4.73691E-02_JPRB, &
+     & 4.22707E-02_JPRB, 3.77210E-02_JPRB, 3.36610E-02_JPRB, 3.00380E-02_JPRB, 2.68049E-02_JPRB/)
+      SELFREFO(:, 8) = (/ &
+     & 7.59386E-02_JPRB, 6.66263E-02_JPRB, 5.84560E-02_JPRB, 5.12876E-02_JPRB, 4.49982E-02_JPRB, &
+     & 3.94801E-02_JPRB, 3.46387E-02_JPRB, 3.03910E-02_JPRB, 2.66642E-02_JPRB, 2.33944E-02_JPRB/)
+      SELFREFO(:, 9) = (/ &
+     & 7.26921E-02_JPRB, 6.43261E-02_JPRB, 5.69230E-02_JPRB, 5.03719E-02_JPRB, 4.45747E-02_JPRB, &
+     & 3.94447E-02_JPRB, 3.49051E-02_JPRB, 3.08880E-02_JPRB, 2.73332E-02_JPRB, 2.41875E-02_JPRB/)
+      SELFREFO(:,10) = (/ &
+     & 7.43684E-02_JPRB, 6.58735E-02_JPRB, 5.83490E-02_JPRB, 5.16840E-02_JPRB, 4.57803E-02_JPRB, &
+     & 4.05509E-02_JPRB, 3.59189E-02_JPRB, 3.18160E-02_JPRB, 2.81818E-02_JPRB, 2.49626E-02_JPRB/)
+      SELFREFO(:,11) = (/ &
+     & 8.97599E-02_JPRB, 7.73727E-02_JPRB, 6.66950E-02_JPRB, 5.74908E-02_JPRB, 4.95569E-02_JPRB, &
+     & 4.27179E-02_JPRB, 3.68227E-02_JPRB, 3.17410E-02_JPRB, 2.73606E-02_JPRB, 2.35848E-02_JPRB/)
+      SELFREFO(:,12) = (/ &
+     & 9.12262E-02_JPRB, 7.84848E-02_JPRB, 6.75230E-02_JPRB, 5.80922E-02_JPRB, 4.99786E-02_JPRB, &
+     & 4.29982E-02_JPRB, 3.69927E-02_JPRB, 3.18260E-02_JPRB, 2.73809E-02_JPRB, 2.35567E-02_JPRB/)
+      SELFREFO(:,13) = (/ &
+     & 9.03254E-02_JPRB, 7.83291E-02_JPRB, 6.79260E-02_JPRB, 5.89046E-02_JPRB, 5.10813E-02_JPRB, &
+     & 4.42970E-02_JPRB, 3.84139E-02_JPRB, 3.33120E-02_JPRB, 2.88877E-02_JPRB, 2.50511E-02_JPRB/)
+      SELFREFO(:,14) = (/ &
+     & 9.22803E-02_JPRB, 7.94172E-02_JPRB, 6.83470E-02_JPRB, 5.88199E-02_JPRB, 5.06209E-02_JPRB, &
+     & 4.35647E-02_JPRB, 3.74921E-02_JPRB, 3.22660E-02_JPRB, 2.77684E-02_JPRB, 2.38977E-02_JPRB/)
+      SELFREFO(:,15) = (/ &
+     & 9.36819E-02_JPRB, 8.10810E-02_JPRB, 7.01750E-02_JPRB, 6.07359E-02_JPRB, 5.25665E-02_JPRB, &
+     & 4.54959E-02_JPRB, 3.93764E-02_JPRB, 3.40800E-02_JPRB, 2.94960E-02_JPRB, 2.55286E-02_JPRB/)
+      SELFREFO(:,16) = (/ &
+     & 1.00195E-01_JPRB, 8.58713E-02_JPRB, 7.35950E-02_JPRB, 6.30737E-02_JPRB, 5.40566E-02_JPRB, &
+     & 4.63286E-02_JPRB, 3.97054E-02_JPRB, 3.40290E-02_JPRB, 2.91641E-02_JPRB, 2.49948E-02_JPRB/)
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB6',1,ZHOOK_HANDLE)
+RETURN
+
+1001 CONTINUE
+CALL ABOR1("RRTM_KGB6:ERROR READING FILE RADRRTM")
+
+END SUBROUTINE RRTM_KGB6
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb6.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb6.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb6.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_KGB6
+END SUBROUTINE RRTM_KGB6
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb7.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb7.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb7.F90	(revision 3908)
@@ -0,0 +1,1031 @@
+SUBROUTINE RRTM_KGB7
+
+!     Originally by Eli J. Mlawer, Atmospheric & Environmental Research.
+!     BAND 7:  980-1080 cm-1 (low - H2O,O3; high - O3)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+!     G.Mozdzynski March 2011 read constants from files
+!     ABozzo 201306 updated rrtmg v4.85
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+USE YOMLUN    ,ONLY : NULRAD
+USE MPL_MODULE,ONLY : MPL_BROADCAST
+USE YOMTAG    ,ONLY : MTAGRAD
+
+USE YOERRTO7 , ONLY : KAO     ,KBO,KAO_D,KBO_D, KAO_MCO2     ,KBO_MCO2     ,SELFREFO   ,FORREFO, &
+ & FRACREFAO  , FRACREFBO   
+
+USE YOMMP0    , ONLY : NPROC, MYPROC
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB7',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+  READ(NULRAD) KAO_D,KBO_D
+ ! Convert the data into model actual precision.
+  KAO = REAL(KAO_D,JPRB)
+  KBO = REAL(KBO_D,JPRB)   
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KAO,MTAGRAD,1,CDSTRING='RRTM_KGB7:')
+  CALL MPL_BROADCAST (KBO,MTAGRAD,1,CDSTRING='RRTM_KGB7:')
+ENDIF
+
+
+! Planck fraction mapping level : P = 706.27 mb, T = 278.94 K
+      FRACREFAO(:, 1) = (/ &
+      & 1.6312E-01_JPRB,1.4949E-01_JPRB,1.4305E-01_JPRB,1.3161E-01_JPRB,1.1684E-01_JPRB,9.9900E-02_JPRB, &
+      & 8.0912E-02_JPRB,6.0203E-02_JPRB,4.0149E-02_JPRB,4.3365E-03_JPRB,3.5844E-03_JPRB,2.8019E-03_JPRB, &
+      & 2.0756E-03_JPRB,1.3449E-03_JPRB,5.0492E-04_JPRB,7.1194E-05_JPRB/)
+      FRACREFAO(:, 2) = (/ &
+      & 1.6329E-01_JPRB,1.4989E-01_JPRB,1.4328E-01_JPRB,1.3101E-01_JPRB,1.1691E-01_JPRB,9.9754E-02_JPRB, &
+      & 8.0956E-02_JPRB,5.9912E-02_JPRB,4.0271E-02_JPRB,4.3298E-03_JPRB,3.5626E-03_JPRB,2.8421E-03_JPRB, &
+      & 2.1031E-03_JPRB,1.3360E-03_JPRB,4.8965E-04_JPRB,6.8900E-05_JPRB/)
+      FRACREFAO(:, 3) = (/ &
+      & 1.6236E-01_JPRB,1.5081E-01_JPRB,1.4341E-01_JPRB,1.3083E-01_JPRB,1.1684E-01_JPRB,9.9701E-02_JPRB, &
+      & 8.0956E-02_JPRB,5.9884E-02_JPRB,4.0245E-02_JPRB,4.3837E-03_JPRB,3.6683E-03_JPRB,2.9250E-03_JPRB, &
+      & 2.0969E-03_JPRB,1.3320E-03_JPRB,4.8965E-04_JPRB,6.8900E-05_JPRB/)
+      FRACREFAO(:, 4) = (/ &
+      & 1.6096E-01_JPRB,1.5183E-01_JPRB,1.4354E-01_JPRB,1.3081E-01_JPRB,1.1687E-01_JPRB,9.9619E-02_JPRB, &
+      & 8.0947E-02_JPRB,5.9899E-02_JPRB,4.0416E-02_JPRB,4.4389E-03_JPRB,3.7280E-03_JPRB,2.9548E-03_JPRB, &
+      & 2.0977E-03_JPRB,1.3305E-03_JPRB,4.8965E-04_JPRB,6.8900E-05_JPRB/)
+      FRACREFAO(:, 5) = (/ &
+      & 1.5661E-01_JPRB,1.5478E-01_JPRB,1.4414E-01_JPRB,1.3097E-01_JPRB,1.1695E-01_JPRB,9.9823E-02_JPRB, &
+      & 8.0750E-02_JPRB,6.0100E-02_JPRB,4.0741E-02_JPRB,4.4598E-03_JPRB,3.7366E-03_JPRB,2.9521E-03_JPRB, &
+      & 2.0980E-03_JPRB,1.3297E-03_JPRB,4.8965E-04_JPRB,6.8900E-05_JPRB/)
+      FRACREFAO(:, 6) = (/ &
+      & 1.4879E-01_JPRB,1.5853E-01_JPRB,1.4586E-01_JPRB,1.3162E-01_JPRB,1.1729E-01_JPRB,1.0031E-01_JPRB, &
+      & 8.0908E-02_JPRB,6.0460E-02_JPRB,4.1100E-02_JPRB,4.4578E-03_JPRB,3.7388E-03_JPRB,2.9508E-03_JPRB, &
+      & 2.0986E-03_JPRB,1.3288E-03_JPRB,4.8965E-04_JPRB,6.8900E-05_JPRB/)
+      FRACREFAO(:, 7) = (/ &
+      & 1.4117E-01_JPRB,1.4838E-01_JPRB,1.4807E-01_JPRB,1.3759E-01_JPRB,1.2218E-01_JPRB,1.0228E-01_JPRB, &
+      & 8.2130E-02_JPRB,6.1546E-02_JPRB,4.1522E-02_JPRB,4.4577E-03_JPRB,3.7428E-03_JPRB,2.9475E-03_JPRB, &
+      & 2.0997E-03_JPRB,1.3277E-03_JPRB,4.8965E-04_JPRB,6.8900E-05_JPRB/)
+      FRACREFAO(:, 8) = (/ &
+      & 1.4018E-01_JPRB,1.4207E-01_JPRB,1.3919E-01_JPRB,1.3332E-01_JPRB,1.2325E-01_JPRB,1.0915E-01_JPRB, &
+      & 9.0280E-02_JPRB,6.5554E-02_JPRB,4.1852E-02_JPRB,4.4707E-03_JPRB,3.7572E-03_JPRB,2.9364E-03_JPRB, &
+      & 2.1023E-03_JPRB,1.3249E-03_JPRB,4.8965E-04_JPRB,6.8900E-05_JPRB/)
+      FRACREFAO(:, 9) = (/ &
+      & 1.4863E-01_JPRB,1.4926E-01_JPRB,1.4740E-01_JPRB,1.3558E-01_JPRB,1.1999E-01_JPRB,1.0044E-01_JPRB, &
+      & 8.1927E-02_JPRB,6.0989E-02_JPRB,4.0665E-02_JPRB,4.4481E-03_JPRB,3.7369E-03_JPRB,2.9482E-03_JPRB, &
+      & 2.0976E-03_JPRB,1.3281E-03_JPRB,4.8965E-04_JPRB,6.8900E-05_JPRB/)
+
+! Planck fraction mapping level : P=95.58 mbar, T= 215.70 K
+FRACREFBO(:) = (/ &
+ &  1.5872E-01_JPRB,1.5443E-01_JPRB,1.4413E-01_JPRB,1.3147E-01_JPRB,1.1634E-01_JPRB,9.8914E-02_JPRB, &
+ &  8.0236E-02_JPRB,6.0197E-02_JPRB,4.0624E-02_JPRB,4.4225E-03_JPRB,3.6688E-03_JPRB,2.9074E-03_JPRB, &
+ &  2.0862E-03_JPRB,1.3039E-03_JPRB,4.8561E-04_JPRB,6.8854E-05_JPRB/)
+
+
+!     ------------------------------------------------------------------
+
+!     The array KAO contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels> ~100mb, temperatures, and binary
+!     species parameters (see taumol.f for definition).  The first 
+!     index in the array, JS, runs from 1 to 9, and corresponds to 
+!     different values of the binary species parameter.  For instance, 
+!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
+!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
+!     in the array, JT, which runs from 1 to 5, corresponds to different
+!     temperatures.  More specifically, JT = 3 means that the data are for
+!     the reference temperature TREF for this  pressure level, JT = 2 refers
+!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
+!     to the JPth reference pressure level (see taumol.f for these levels
+!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
+!     which g-interval the absorption coefficients are for.
+
+
+
+!     The array KBO contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels < ~100mb and temperatures. The first 
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the reference temperature TREF for this pressure 
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
+!     The second index, JP, runs from 13 to 59 and refers to the JPth
+!     reference pressure level (see taumol.f for the value of these
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
+!     and tells us which g-interval the absorption coefficients are for.
+
+
+!     The array KAO_Mxx contains the absorption coefficient for 
+!     a minor species at the 16 chosen g-values for a reference pressure
+!     level below 100~ mb.   The first index in the array, JS, runs
+!     from 1 to 10, and corresponds to different gas column amount ratios,
+!     as expressed through the binary species parameter eta, defined as
+!     eta = gas1/(gas1 + (rat) * gas2), where rat is the 
+!     ratio of the reference MLS column amount value of gas 1 
+!     to that of gas2.  The second index refers to temperature 
+!     in 7.2 degree increments.  For instance, JT = 1 refers to a 
+!     temperature of 188.0, JT = 2 refers to 195.2, etc. The third index 
+!     runs over the g-channel (1 to 16).
+
+      KAO_MCO2( 1, :, 1) = (/ &
+     & 7.38630E-06_JPRB, 8.97432E-06_JPRB, 1.09037E-05_JPRB, 1.32480E-05_JPRB, 1.60963E-05_JPRB, &
+     & 1.95569E-05_JPRB, 2.37615E-05_JPRB, 2.88701E-05_JPRB, 3.50770E-05_JPRB, 4.26184E-05_JPRB, &
+     & 5.17811E-05_JPRB, 6.29138E-05_JPRB, 7.64400E-05_JPRB, 9.28742E-05_JPRB, 1.12842E-04_JPRB, &
+     & 1.37102E-04_JPRB, 1.66578E-04_JPRB, 2.02392E-04_JPRB, 2.45905E-04_JPRB/)
+      KAO_MCO2( 2, :, 1) = (/ &
+     & 7.03916E-06_JPRB, 8.58785E-06_JPRB, 1.04773E-05_JPRB, 1.27824E-05_JPRB, 1.55947E-05_JPRB, &
+     & 1.90257E-05_JPRB, 2.32115E-05_JPRB, 2.83183E-05_JPRB, 3.45487E-05_JPRB, 4.21498E-05_JPRB, &
+     & 5.14233E-05_JPRB, 6.27370E-05_JPRB, 7.65398E-05_JPRB, 9.33794E-05_JPRB, 1.13924E-04_JPRB, &
+     & 1.38989E-04_JPRB, 1.69568E-04_JPRB, 2.06874E-04_JPRB, 2.52389E-04_JPRB/)
+      KAO_MCO2( 3, :, 1) = (/ &
+     & 7.80015E-06_JPRB, 9.48520E-06_JPRB, 1.15343E-05_JPRB, 1.40260E-05_JPRB, 1.70560E-05_JPRB, &
+     & 2.07405E-05_JPRB, 2.52211E-05_JPRB, 3.06695E-05_JPRB, 3.72950E-05_JPRB, 4.53517E-05_JPRB, &
+     & 5.51489E-05_JPRB, 6.70626E-05_JPRB, 8.15499E-05_JPRB, 9.91670E-05_JPRB, 1.20590E-04_JPRB, &
+     & 1.46640E-04_JPRB, 1.78319E-04_JPRB, 2.16841E-04_JPRB, 2.63684E-04_JPRB/)
+      KAO_MCO2( 4, :, 1) = (/ &
+     & 9.24267E-06_JPRB, 1.11747E-05_JPRB, 1.35105E-05_JPRB, 1.63346E-05_JPRB, 1.97490E-05_JPRB, &
+     & 2.38771E-05_JPRB, 2.88682E-05_JPRB, 3.49025E-05_JPRB, 4.21981E-05_JPRB, 5.10188E-05_JPRB, &
+     & 6.16832E-05_JPRB, 7.45768E-05_JPRB, 9.01656E-05_JPRB, 1.09013E-04_JPRB, 1.31800E-04_JPRB, &
+     & 1.59350E-04_JPRB, 1.92659E-04_JPRB, 2.32930E-04_JPRB, 2.81619E-04_JPRB/)
+      KAO_MCO2( 5, :, 1) = (/ &
+     & 1.59506E-05_JPRB, 1.90078E-05_JPRB, 2.26509E-05_JPRB, 2.69923E-05_JPRB, 3.21658E-05_JPRB, &
+     & 3.83309E-05_JPRB, 4.56777E-05_JPRB, 5.44325E-05_JPRB, 6.48654E-05_JPRB, 7.72978E-05_JPRB, &
+     & 9.21132E-05_JPRB, 1.09768E-04_JPRB, 1.30807E-04_JPRB, 1.55878E-04_JPRB, 1.85755E-04_JPRB, &
+     & 2.21357E-04_JPRB, 2.63784E-04_JPRB, 3.14342E-04_JPRB, 3.74591E-04_JPRB/)
+      KAO_MCO2( 6, :, 1) = (/ &
+     & 3.53189E-05_JPRB, 4.14789E-05_JPRB, 4.87131E-05_JPRB, 5.72092E-05_JPRB, 6.71870E-05_JPRB, &
+     & 7.89050E-05_JPRB, 9.26667E-05_JPRB, 1.08829E-04_JPRB, 1.27809E-04_JPRB, 1.50100E-04_JPRB, &
+     & 1.76279E-04_JPRB, 2.07024E-04_JPRB, 2.43131E-04_JPRB, 2.85535E-04_JPRB, 3.35335E-04_JPRB, &
+     & 3.93821E-04_JPRB, 4.62507E-04_JPRB, 5.43172E-04_JPRB, 6.37906E-04_JPRB/)
+      KAO_MCO2( 7, :, 1) = (/ &
+     & 6.63273E-05_JPRB, 7.76356E-05_JPRB, 9.08718E-05_JPRB, 1.06365E-04_JPRB, 1.24499E-04_JPRB, &
+     & 1.45725E-04_JPRB, 1.70570E-04_JPRB, 1.99651E-04_JPRB, 2.33689E-04_JPRB, 2.73531E-04_JPRB, &
+     & 3.20166E-04_JPRB, 3.74752E-04_JPRB, 4.38644E-04_JPRB, 5.13429E-04_JPRB, 6.00964E-04_JPRB, &
+     & 7.03424E-04_JPRB, 8.23352E-04_JPRB, 9.63726E-04_JPRB, 1.12803E-03_JPRB/)
+      KAO_MCO2( 8, :, 1) = (/ &
+     & 9.01134E-05_JPRB, 1.05517E-04_JPRB, 1.23553E-04_JPRB, 1.44673E-04_JPRB, 1.69402E-04_JPRB, &
+     & 1.98359E-04_JPRB, 2.32265E-04_JPRB, 2.71967E-04_JPRB, 3.18456E-04_JPRB, 3.72890E-04_JPRB, &
+     & 4.36630E-04_JPRB, 5.11265E-04_JPRB, 5.98657E-04_JPRB, 7.00989E-04_JPRB, 8.20811E-04_JPRB, &
+     & 9.61116E-04_JPRB, 1.12540E-03_JPRB, 1.31777E-03_JPRB, 1.54302E-03_JPRB/)
+      KAO_MCO2( 9, :, 1) = (/ &
+     & 1.14205E-05_JPRB, 1.36364E-05_JPRB, 1.62823E-05_JPRB, 1.94416E-05_JPRB, 2.32139E-05_JPRB, &
+     & 2.77181E-05_JPRB, 3.30963E-05_JPRB, 3.95181E-05_JPRB, 4.71858E-05_JPRB, 5.63414E-05_JPRB, &
+     & 6.72734E-05_JPRB, 8.03266E-05_JPRB, 9.59124E-05_JPRB, 1.14523E-04_JPRB, 1.36743E-04_JPRB, &
+     & 1.63276E-04_JPRB, 1.94957E-04_JPRB, 2.32784E-04_JPRB, 2.77952E-04_JPRB/)
+      KAO_MCO2( 1, :, 2) = (/ &
+     & 2.01754E-05_JPRB, 2.40506E-05_JPRB, 2.86701E-05_JPRB, 3.41769E-05_JPRB, 4.07414E-05_JPRB, &
+     & 4.85668E-05_JPRB, 5.78953E-05_JPRB, 6.90155E-05_JPRB, 8.22717E-05_JPRB, 9.80739E-05_JPRB, &
+     & 1.16912E-04_JPRB, 1.39367E-04_JPRB, 1.66136E-04_JPRB, 1.98047E-04_JPRB, 2.36087E-04_JPRB, &
+     & 2.81433E-04_JPRB, 3.35489E-04_JPRB, 3.99928E-04_JPRB, 4.76744E-04_JPRB/)
+      KAO_MCO2( 2, :, 2) = (/ &
+     & 2.08613E-05_JPRB, 2.48759E-05_JPRB, 2.96631E-05_JPRB, 3.53716E-05_JPRB, 4.21786E-05_JPRB, &
+     & 5.02955E-05_JPRB, 5.99746E-05_JPRB, 7.15163E-05_JPRB, 8.52791E-05_JPRB, 1.01690E-04_JPRB, &
+     & 1.21260E-04_JPRB, 1.44596E-04_JPRB, 1.72422E-04_JPRB, 2.05604E-04_JPRB, 2.45171E-04_JPRB, &
+     & 2.92352E-04_JPRB, 3.48613E-04_JPRB, 4.15702E-04_JPRB, 4.95700E-04_JPRB/)
+      KAO_MCO2( 3, :, 2) = (/ &
+     & 2.06879E-05_JPRB, 2.47009E-05_JPRB, 2.94924E-05_JPRB, 3.52133E-05_JPRB, 4.20439E-05_JPRB, &
+     & 5.01995E-05_JPRB, 5.99372E-05_JPRB, 7.15637E-05_JPRB, 8.54456E-05_JPRB, 1.02020E-04_JPRB, &
+     & 1.21810E-04_JPRB, 1.45439E-04_JPRB, 1.73651E-04_JPRB, 2.07335E-04_JPRB, 2.47554E-04_JPRB, &
+     & 2.95574E-04_JPRB, 3.52909E-04_JPRB, 4.21366E-04_JPRB, 5.03102E-04_JPRB/)
+      KAO_MCO2( 4, :, 2) = (/ &
+     & 2.12700E-05_JPRB, 2.54064E-05_JPRB, 3.03472E-05_JPRB, 3.62490E-05_JPRB, 4.32984E-05_JPRB, &
+     & 5.17188E-05_JPRB, 6.17767E-05_JPRB, 7.37906E-05_JPRB, 8.81410E-05_JPRB, 1.05282E-04_JPRB, &
+     & 1.25757E-04_JPRB, 1.50213E-04_JPRB, 1.79425E-04_JPRB, 2.14319E-04_JPRB, 2.55998E-04_JPRB, &
+     & 3.05782E-04_JPRB, 3.65249E-04_JPRB, 4.36280E-04_JPRB, 5.21125E-04_JPRB/)
+      KAO_MCO2( 5, :, 2) = (/ &
+     & 1.88144E-05_JPRB, 2.25220E-05_JPRB, 2.69602E-05_JPRB, 3.22730E-05_JPRB, 3.86328E-05_JPRB, &
+     & 4.62458E-05_JPRB, 5.53591E-05_JPRB, 6.62682E-05_JPRB, 7.93271E-05_JPRB, 9.49594E-05_JPRB, &
+     & 1.13672E-04_JPRB, 1.36073E-04_JPRB, 1.62887E-04_JPRB, 1.94986E-04_JPRB, 2.33410E-04_JPRB, &
+     & 2.79406E-04_JPRB, 3.34467E-04_JPRB, 4.00377E-04_JPRB, 4.79275E-04_JPRB/)
+      KAO_MCO2( 6, :, 2) = (/ &
+     & 1.20964E-05_JPRB, 1.46021E-05_JPRB, 1.76268E-05_JPRB, 2.12780E-05_JPRB, 2.56856E-05_JPRB, &
+     & 3.10062E-05_JPRB, 3.74289E-05_JPRB, 4.51820E-05_JPRB, 5.45411E-05_JPRB, 6.58388E-05_JPRB, &
+     & 7.94769E-05_JPRB, 9.59399E-05_JPRB, 1.15813E-04_JPRB, 1.39803E-04_JPRB, 1.68762E-04_JPRB, &
+     & 2.03720E-04_JPRB, 2.45919E-04_JPRB, 2.96859E-04_JPRB, 3.58350E-04_JPRB/)
+      KAO_MCO2( 7, :, 2) = (/ &
+     & 3.07117E-05_JPRB, 3.64441E-05_JPRB, 4.32465E-05_JPRB, 5.13186E-05_JPRB, 6.08974E-05_JPRB, &
+     & 7.22642E-05_JPRB, 8.57525E-05_JPRB, 1.01758E-04_JPRB, 1.20752E-04_JPRB, 1.43291E-04_JPRB, &
+     & 1.70037E-04_JPRB, 2.01775E-04_JPRB, 2.39436E-04_JPRB, 2.84128E-04_JPRB, 3.37161E-04_JPRB, &
+     & 4.00094E-04_JPRB, 4.74773E-04_JPRB, 5.63391E-04_JPRB, 6.68549E-04_JPRB/)
+      KAO_MCO2( 8, :, 2) = (/ &
+     & 9.34077E-05_JPRB, 1.10481E-04_JPRB, 1.30675E-04_JPRB, 1.54559E-04_JPRB, 1.82810E-04_JPRB, &
+     & 2.16224E-04_JPRB, 2.55745E-04_JPRB, 3.02491E-04_JPRB, 3.57780E-04_JPRB, 4.23175E-04_JPRB, &
+     & 5.00523E-04_JPRB, 5.92009E-04_JPRB, 7.00217E-04_JPRB, 8.28203E-04_JPRB, 9.79582E-04_JPRB, &
+     & 1.15863E-03_JPRB, 1.37041E-03_JPRB, 1.62089E-03_JPRB, 1.91716E-03_JPRB/)
+      KAO_MCO2( 9, :, 2) = (/ &
+     & 1.15325E-05_JPRB, 1.37935E-05_JPRB, 1.64978E-05_JPRB, 1.97322E-05_JPRB, 2.36007E-05_JPRB, &
+     & 2.82277E-05_JPRB, 3.37618E-05_JPRB, 4.03808E-05_JPRB, 4.82976E-05_JPRB, 5.77664E-05_JPRB, &
+     & 6.90916E-05_JPRB, 8.26372E-05_JPRB, 9.88384E-05_JPRB, 1.18216E-04_JPRB, 1.41392E-04_JPRB, &
+     & 1.69113E-04_JPRB, 2.02267E-04_JPRB, 2.41922E-04_JPRB, 2.89352E-04_JPRB/)
+      KAO_MCO2( 1, :, 3) = (/ &
+     & 2.56142E-05_JPRB, 3.05385E-05_JPRB, 3.64096E-05_JPRB, 4.34093E-05_JPRB, 5.17547E-05_JPRB, &
+     & 6.17045E-05_JPRB, 7.35672E-05_JPRB, 8.77104E-05_JPRB, 1.04573E-04_JPRB, 1.24677E-04_JPRB, &
+     & 1.48646E-04_JPRB, 1.77223E-04_JPRB, 2.11294E-04_JPRB, 2.51915E-04_JPRB, 3.00346E-04_JPRB, &
+     & 3.58087E-04_JPRB, 4.26929E-04_JPRB, 5.09006E-04_JPRB, 6.06862E-04_JPRB/)
+      KAO_MCO2( 2, :, 3) = (/ &
+     & 2.49802E-05_JPRB, 2.98040E-05_JPRB, 3.55593E-05_JPRB, 4.24259E-05_JPRB, 5.06186E-05_JPRB, &
+     & 6.03932E-05_JPRB, 7.20554E-05_JPRB, 8.59696E-05_JPRB, 1.02571E-04_JPRB, 1.22377E-04_JPRB, &
+     & 1.46009E-04_JPRB, 1.74204E-04_JPRB, 2.07844E-04_JPRB, 2.47979E-04_JPRB, 2.95865E-04_JPRB, &
+     & 3.52998E-04_JPRB, 4.21163E-04_JPRB, 5.02491E-04_JPRB, 5.99524E-04_JPRB/)
+      KAO_MCO2( 3, :, 3) = (/ &
+     & 2.54644E-05_JPRB, 3.03959E-05_JPRB, 3.62825E-05_JPRB, 4.33091E-05_JPRB, 5.16965E-05_JPRB, &
+     & 6.17083E-05_JPRB, 7.36589E-05_JPRB, 8.79240E-05_JPRB, 1.04952E-04_JPRB, 1.25277E-04_JPRB, &
+     & 1.49539E-04_JPRB, 1.78499E-04_JPRB, 2.13068E-04_JPRB, 2.54331E-04_JPRB, 3.03586E-04_JPRB, &
+     & 3.62380E-04_JPRB, 4.32560E-04_JPRB, 5.16331E-04_JPRB, 6.16326E-04_JPRB/)
+      KAO_MCO2( 4, :, 3) = (/ &
+     & 2.55054E-05_JPRB, 3.04699E-05_JPRB, 3.64007E-05_JPRB, 4.34859E-05_JPRB, 5.19501E-05_JPRB, &
+     & 6.20619E-05_JPRB, 7.41418E-05_JPRB, 8.85731E-05_JPRB, 1.05813E-04_JPRB, 1.26409E-04_JPRB, &
+     & 1.51014E-04_JPRB, 1.80408E-04_JPRB, 2.15523E-04_JPRB, 2.57474E-04_JPRB, 3.07589E-04_JPRB, &
+     & 3.67459E-04_JPRB, 4.38983E-04_JPRB, 5.24428E-04_JPRB, 6.26505E-04_JPRB/)
+      KAO_MCO2( 5, :, 3) = (/ &
+     & 2.48615E-05_JPRB, 2.97398E-05_JPRB, 3.55754E-05_JPRB, 4.25560E-05_JPRB, 5.09064E-05_JPRB, &
+     & 6.08952E-05_JPRB, 7.28441E-05_JPRB, 8.71375E-05_JPRB, 1.04236E-04_JPRB, 1.24689E-04_JPRB, &
+     & 1.49155E-04_JPRB, 1.78423E-04_JPRB, 2.13433E-04_JPRB, 2.55313E-04_JPRB, 3.05410E-04_JPRB, &
+     & 3.65338E-04_JPRB, 4.37024E-04_JPRB, 5.22777E-04_JPRB, 6.25356E-04_JPRB/)
+      KAO_MCO2( 6, :, 3) = (/ &
+     & 2.09074E-05_JPRB, 2.50891E-05_JPRB, 3.01072E-05_JPRB, 3.61290E-05_JPRB, 4.33553E-05_JPRB, &
+     & 5.20269E-05_JPRB, 6.24329E-05_JPRB, 7.49202E-05_JPRB, 8.99051E-05_JPRB, 1.07887E-04_JPRB, &
+     & 1.29466E-04_JPRB, 1.55361E-04_JPRB, 1.86435E-04_JPRB, 2.23724E-04_JPRB, 2.68471E-04_JPRB, &
+     & 3.22169E-04_JPRB, 3.86607E-04_JPRB, 4.63933E-04_JPRB, 5.56725E-04_JPRB/)
+      KAO_MCO2( 7, :, 3) = (/ &
+     & 1.25163E-05_JPRB, 1.51688E-05_JPRB, 1.83835E-05_JPRB, 2.22795E-05_JPRB, 2.70011E-05_JPRB, &
+     & 3.27234E-05_JPRB, 3.96583E-05_JPRB, 4.80630E-05_JPRB, 5.82488E-05_JPRB, 7.05933E-05_JPRB, &
+     & 8.55539E-05_JPRB, 1.03685E-04_JPRB, 1.25659E-04_JPRB, 1.52289E-04_JPRB, 1.84563E-04_JPRB, &
+     & 2.23677E-04_JPRB, 2.71081E-04_JPRB, 3.28530E-04_JPRB, 3.98154E-04_JPRB/)
+      KAO_MCO2( 8, :, 3) = (/ &
+     & 1.00408E-04_JPRB, 1.20081E-04_JPRB, 1.43608E-04_JPRB, 1.71745E-04_JPRB, 2.05395E-04_JPRB, &
+     & 2.45637E-04_JPRB, 2.93765E-04_JPRB, 3.51322E-04_JPRB, 4.20156E-04_JPRB, 5.02476E-04_JPRB, &
+     & 6.00926E-04_JPRB, 7.18665E-04_JPRB, 8.59472E-04_JPRB, 1.02787E-03_JPRB, 1.22926E-03_JPRB, &
+     & 1.47010E-03_JPRB, 1.75814E-03_JPRB, 2.10261E-03_JPRB, 2.51457E-03_JPRB/)
+      KAO_MCO2( 9, :, 3) = (/ &
+     & 8.50402E-06_JPRB, 1.02737E-05_JPRB, 1.24116E-05_JPRB, 1.49945E-05_JPRB, 1.81148E-05_JPRB, &
+     & 2.18844E-05_JPRB, 2.64385E-05_JPRB, 3.19403E-05_JPRB, 3.85871E-05_JPRB, 4.66169E-05_JPRB, &
+     & 5.63178E-05_JPRB, 6.80375E-05_JPRB, 8.21959E-05_JPRB, 9.93008E-05_JPRB, 1.19965E-04_JPRB, &
+     & 1.44930E-04_JPRB, 1.75089E-04_JPRB, 2.11525E-04_JPRB, 2.55543E-04_JPRB/)
+      KAO_MCO2( 1, :, 4) = (/ &
+     & 2.68659E-05_JPRB, 3.20986E-05_JPRB, 3.83506E-05_JPRB, 4.58203E-05_JPRB, 5.47450E-05_JPRB, &
+     & 6.54078E-05_JPRB, 7.81476E-05_JPRB, 9.33687E-05_JPRB, 1.11555E-04_JPRB, 1.33282E-04_JPRB, &
+     & 1.59242E-04_JPRB, 1.90259E-04_JPRB, 2.27316E-04_JPRB, 2.71592E-04_JPRB, 3.24490E-04_JPRB, &
+     & 3.87693E-04_JPRB, 4.63206E-04_JPRB, 5.53426E-04_JPRB, 6.61218E-04_JPRB/)
+      KAO_MCO2( 2, :, 4) = (/ &
+     & 2.74827E-05_JPRB, 3.28460E-05_JPRB, 3.92560E-05_JPRB, 4.69169E-05_JPRB, 5.60728E-05_JPRB, &
+     & 6.70155E-05_JPRB, 8.00937E-05_JPRB, 9.57241E-05_JPRB, 1.14405E-04_JPRB, 1.36731E-04_JPRB, &
+     & 1.63415E-04_JPRB, 1.95305E-04_JPRB, 2.33419E-04_JPRB, 2.78972E-04_JPRB, 3.33413E-04_JPRB, &
+     & 3.98480E-04_JPRB, 4.76244E-04_JPRB, 5.69184E-04_JPRB, 6.80261E-04_JPRB/)
+      KAO_MCO2( 3, :, 4) = (/ &
+     & 2.84702E-05_JPRB, 3.40189E-05_JPRB, 4.06490E-05_JPRB, 4.85713E-05_JPRB, 5.80375E-05_JPRB, &
+     & 6.93487E-05_JPRB, 8.28644E-05_JPRB, 9.90142E-05_JPRB, 1.18312E-04_JPRB, 1.41370E-04_JPRB, &
+     & 1.68922E-04_JPRB, 2.01844E-04_JPRB, 2.41182E-04_JPRB, 2.88188E-04_JPRB, 3.44354E-04_JPRB, &
+     & 4.11466E-04_JPRB, 4.91659E-04_JPRB, 5.87481E-04_JPRB, 7.01977E-04_JPRB/)
+      KAO_MCO2( 4, :, 4) = (/ &
+     & 2.92293E-05_JPRB, 3.49243E-05_JPRB, 4.17289E-05_JPRB, 4.98593E-05_JPRB, 5.95738E-05_JPRB, &
+     & 7.11810E-05_JPRB, 8.50498E-05_JPRB, 1.01621E-04_JPRB, 1.21420E-04_JPRB, 1.45078E-04_JPRB, &
+     & 1.73344E-04_JPRB, 2.07119E-04_JPRB, 2.47473E-04_JPRB, 2.95690E-04_JPRB, 3.53302E-04_JPRB, &
+     & 4.22139E-04_JPRB, 5.04388E-04_JPRB, 6.02662E-04_JPRB, 7.20083E-04_JPRB/)
+      KAO_MCO2( 5, :, 4) = (/ &
+     & 2.88531E-05_JPRB, 3.45646E-05_JPRB, 4.14067E-05_JPRB, 4.96033E-05_JPRB, 5.94224E-05_JPRB, &
+     & 7.11851E-05_JPRB, 8.52764E-05_JPRB, 1.02157E-04_JPRB, 1.22379E-04_JPRB, 1.46604E-04_JPRB, &
+     & 1.75625E-04_JPRB, 2.10391E-04_JPRB, 2.52038E-04_JPRB, 3.01929E-04_JPRB, 3.61697E-04_JPRB, &
+     & 4.33295E-04_JPRB, 5.19067E-04_JPRB, 6.21818E-04_JPRB, 7.44908E-04_JPRB/)
+      KAO_MCO2( 6, :, 4) = (/ &
+     & 2.79869E-05_JPRB, 3.36885E-05_JPRB, 4.05516E-05_JPRB, 4.88130E-05_JPRB, 5.87574E-05_JPRB, &
+     & 7.07278E-05_JPRB, 8.51368E-05_JPRB, 1.02481E-04_JPRB, 1.23359E-04_JPRB, 1.48490E-04_JPRB, &
+     & 1.78742E-04_JPRB, 2.15156E-04_JPRB, 2.58988E-04_JPRB, 3.11751E-04_JPRB, 3.75262E-04_JPRB, &
+     & 4.51712E-04_JPRB, 5.43737E-04_JPRB, 6.54510E-04_JPRB, 7.87849E-04_JPRB/)
+      KAO_MCO2( 7, :, 4) = (/ &
+     & 1.45797E-05_JPRB, 1.78204E-05_JPRB, 2.17815E-05_JPRB, 2.66230E-05_JPRB, 3.25407E-05_JPRB, &
+     & 3.97737E-05_JPRB, 4.86145E-05_JPRB, 5.94203E-05_JPRB, 7.26281E-05_JPRB, 8.87715E-05_JPRB, &
+     & 1.08503E-04_JPRB, 1.32621E-04_JPRB, 1.62100E-04_JPRB, 1.98130E-04_JPRB, 2.42170E-04_JPRB, &
+     & 2.95999E-04_JPRB, 3.61792E-04_JPRB, 4.42210E-04_JPRB, 5.40503E-04_JPRB/)
+      KAO_MCO2( 8, :, 4) = (/ &
+     & 6.32607E-05_JPRB, 7.63420E-05_JPRB, 9.21282E-05_JPRB, 1.11179E-04_JPRB, 1.34169E-04_JPRB, &
+     & 1.61913E-04_JPRB, 1.95393E-04_JPRB, 2.35797E-04_JPRB, 2.84557E-04_JPRB, 3.43398E-04_JPRB, &
+     & 4.14407E-04_JPRB, 5.00100E-04_JPRB, 6.03512E-04_JPRB, 7.28308E-04_JPRB, 8.78909E-04_JPRB, &
+     & 1.06065E-03_JPRB, 1.27998E-03_JPRB, 1.54466E-03_JPRB, 1.86407E-03_JPRB/)
+      KAO_MCO2( 9, :, 4) = (/ &
+     & 1.52296E-05_JPRB, 1.84301E-05_JPRB, 2.23032E-05_JPRB, 2.69902E-05_JPRB, 3.26622E-05_JPRB, &
+     & 3.95261E-05_JPRB, 4.78324E-05_JPRB, 5.78844E-05_JPRB, 7.00487E-05_JPRB, 8.47694E-05_JPRB, &
+     & 1.02584E-04_JPRB, 1.24142E-04_JPRB, 1.50230E-04_JPRB, 1.81800E-04_JPRB, 2.20005E-04_JPRB, &
+     & 2.66239E-04_JPRB, 3.22190E-04_JPRB, 3.89897E-04_JPRB, 4.71833E-04_JPRB/)
+      KAO_MCO2( 1, :, 5) = (/ &
+     & 3.43213E-05_JPRB, 4.11301E-05_JPRB, 4.92896E-05_JPRB, 5.90679E-05_JPRB, 7.07860E-05_JPRB, &
+     & 8.48288E-05_JPRB, 1.01657E-04_JPRB, 1.21825E-04_JPRB, 1.45993E-04_JPRB, 1.74955E-04_JPRB, &
+     & 2.09663E-04_JPRB, 2.51257E-04_JPRB, 3.01103E-04_JPRB, 3.60837E-04_JPRB, 4.32421E-04_JPRB, &
+     & 5.18206E-04_JPRB, 6.21010E-04_JPRB, 7.44208E-04_JPRB, 8.91846E-04_JPRB/)
+      KAO_MCO2( 2, :, 5) = (/ &
+     & 3.14792E-05_JPRB, 3.79075E-05_JPRB, 4.56485E-05_JPRB, 5.49703E-05_JPRB, 6.61956E-05_JPRB, &
+     & 7.97133E-05_JPRB, 9.59914E-05_JPRB, 1.15594E-04_JPRB, 1.39199E-04_JPRB, 1.67624E-04_JPRB, &
+     & 2.01854E-04_JPRB, 2.43075E-04_JPRB, 2.92712E-04_JPRB, 3.52487E-04_JPRB, 4.24467E-04_JPRB, &
+     & 5.11147E-04_JPRB, 6.15527E-04_JPRB, 7.41222E-04_JPRB, 8.92585E-04_JPRB/)
+      KAO_MCO2( 3, :, 5) = (/ &
+     & 3.21655E-05_JPRB, 3.87990E-05_JPRB, 4.68006E-05_JPRB, 5.64523E-05_JPRB, 6.80945E-05_JPRB, &
+     & 8.21377E-05_JPRB, 9.90770E-05_JPRB, 1.19510E-04_JPRB, 1.44156E-04_JPRB, 1.73886E-04_JPRB, &
+     & 2.09746E-04_JPRB, 2.53002E-04_JPRB, 3.05179E-04_JPRB, 3.68117E-04_JPRB, 4.44033E-04_JPRB, &
+     & 5.35607E-04_JPRB, 6.46066E-04_JPRB, 7.79304E-04_JPRB, 9.40020E-04_JPRB/)
+      KAO_MCO2( 4, :, 5) = (/ &
+     & 3.22870E-05_JPRB, 3.89864E-05_JPRB, 4.70759E-05_JPRB, 5.68439E-05_JPRB, 6.86388E-05_JPRB, &
+     & 8.28810E-05_JPRB, 1.00078E-04_JPRB, 1.20844E-04_JPRB, 1.45919E-04_JPRB, 1.76196E-04_JPRB, &
+     & 2.12756E-04_JPRB, 2.56902E-04_JPRB, 3.10207E-04_JPRB, 3.74574E-04_JPRB, 4.52296E-04_JPRB, &
+     & 5.46146E-04_JPRB, 6.59468E-04_JPRB, 7.96304E-04_JPRB, 9.61533E-04_JPRB/)
+      KAO_MCO2( 5, :, 5) = (/ &
+     & 3.31190E-05_JPRB, 3.99528E-05_JPRB, 4.81967E-05_JPRB, 5.81417E-05_JPRB, 7.01387E-05_JPRB, &
+     & 8.46111E-05_JPRB, 1.02070E-04_JPRB, 1.23131E-04_JPRB, 1.48538E-04_JPRB, 1.79187E-04_JPRB, &
+     & 2.16161E-04_JPRB, 2.60764E-04_JPRB, 3.14570E-04_JPRB, 3.79479E-04_JPRB, 4.57781E-04_JPRB, &
+     & 5.52240E-04_JPRB, 6.66190E-04_JPRB, 8.03652E-04_JPRB, 9.69477E-04_JPRB/)
+      KAO_MCO2( 6, :, 5) = (/ &
+     & 3.31287E-05_JPRB, 3.99772E-05_JPRB, 4.82413E-05_JPRB, 5.82139E-05_JPRB, 7.02480E-05_JPRB, &
+     & 8.47698E-05_JPRB, 1.02294E-04_JPRB, 1.23440E-04_JPRB, 1.48958E-04_JPRB, 1.79750E-04_JPRB, &
+     & 2.16909E-04_JPRB, 2.61749E-04_JPRB, 3.15858E-04_JPRB, 3.81153E-04_JPRB, 4.59945E-04_JPRB, &
+     & 5.55026E-04_JPRB, 6.69762E-04_JPRB, 8.08216E-04_JPRB, 9.75292E-04_JPRB/)
+      KAO_MCO2( 7, :, 5) = (/ &
+     & 3.35235E-05_JPRB, 4.02832E-05_JPRB, 4.84061E-05_JPRB, 5.81668E-05_JPRB, 6.98958E-05_JPRB, &
+     & 8.39898E-05_JPRB, 1.00926E-04_JPRB, 1.21277E-04_JPRB, 1.45731E-04_JPRB, 1.75117E-04_JPRB, &
+     & 2.10428E-04_JPRB, 2.52860E-04_JPRB, 3.03847E-04_JPRB, 3.65116E-04_JPRB, 4.38739E-04_JPRB, &
+     & 5.27208E-04_JPRB, 6.33516E-04_JPRB, 7.61260E-04_JPRB, 9.14762E-04_JPRB/)
+      KAO_MCO2( 8, :, 5) = (/ &
+     & 3.57666E-05_JPRB, 4.27511E-05_JPRB, 5.10995E-05_JPRB, 6.10783E-05_JPRB, 7.30057E-05_JPRB, &
+     & 8.72622E-05_JPRB, 1.04303E-04_JPRB, 1.24671E-04_JPRB, 1.49017E-04_JPRB, 1.78117E-04_JPRB, &
+     & 2.12900E-04_JPRB, 2.54475E-04_JPRB, 3.04169E-04_JPRB, 3.63567E-04_JPRB, 4.34565E-04_JPRB, &
+     & 5.19427E-04_JPRB, 6.20861E-04_JPRB, 7.42103E-04_JPRB, 8.87020E-04_JPRB/)
+      KAO_MCO2( 9, :, 5) = (/ &
+     & 2.96349E-05_JPRB, 3.55202E-05_JPRB, 4.25743E-05_JPRB, 5.10292E-05_JPRB, 6.11633E-05_JPRB, &
+     & 7.33099E-05_JPRB, 8.78687E-05_JPRB, 1.05319E-04_JPRB, 1.26234E-04_JPRB, 1.51304E-04_JPRB, &
+     & 1.81352E-04_JPRB, 2.17367E-04_JPRB, 2.60534E-04_JPRB, 3.12275E-04_JPRB, 3.74290E-04_JPRB, &
+     & 4.48622E-04_JPRB, 5.37715E-04_JPRB, 6.44502E-04_JPRB, 7.72495E-04_JPRB/)
+      KAO_MCO2( 1, :, 6) = (/ &
+     & 4.14659E-05_JPRB, 4.98693E-05_JPRB, 5.99757E-05_JPRB, 7.21302E-05_JPRB, 8.67479E-05_JPRB, &
+     & 1.04328E-04_JPRB, 1.25471E-04_JPRB, 1.50899E-04_JPRB, 1.81479E-04_JPRB, 2.18257E-04_JPRB, &
+     & 2.62489E-04_JPRB, 3.15685E-04_JPRB, 3.79660E-04_JPRB, 4.56601E-04_JPRB, 5.49135E-04_JPRB, &
+     & 6.60422E-04_JPRB, 7.94261E-04_JPRB, 9.55224E-04_JPRB, 1.14881E-03_JPRB/)
+      KAO_MCO2( 2, :, 6) = (/ &
+     & 4.25940E-05_JPRB, 5.11162E-05_JPRB, 6.13434E-05_JPRB, 7.36168E-05_JPRB, 8.83459E-05_JPRB, &
+     & 1.06022E-04_JPRB, 1.27235E-04_JPRB, 1.52691E-04_JPRB, 1.83241E-04_JPRB, 2.19904E-04_JPRB, &
+     & 2.63902E-04_JPRB, 3.16703E-04_JPRB, 3.80068E-04_JPRB, 4.56111E-04_JPRB, 5.47368E-04_JPRB, &
+     & 6.56885E-04_JPRB, 7.88313E-04_JPRB, 9.46036E-04_JPRB, 1.13532E-03_JPRB/)
+      KAO_MCO2( 3, :, 6) = (/ &
+     & 4.44940E-05_JPRB, 5.32922E-05_JPRB, 6.38303E-05_JPRB, 7.64522E-05_JPRB, 9.15700E-05_JPRB, &
+     & 1.09677E-04_JPRB, 1.31365E-04_JPRB, 1.57341E-04_JPRB, 1.88454E-04_JPRB, 2.25719E-04_JPRB, &
+     & 2.70353E-04_JPRB, 3.23813E-04_JPRB, 3.87844E-04_JPRB, 4.64537E-04_JPRB, 5.56395E-04_JPRB, &
+     & 6.66418E-04_JPRB, 7.98196E-04_JPRB, 9.56032E-04_JPRB, 1.14508E-03_JPRB/)
+      KAO_MCO2( 4, :, 6) = (/ &
+     & 4.83402E-05_JPRB, 5.78065E-05_JPRB, 6.91265E-05_JPRB, 8.26633E-05_JPRB, 9.88510E-05_JPRB, &
+     & 1.18209E-04_JPRB, 1.41357E-04_JPRB, 1.69038E-04_JPRB, 2.02140E-04_JPRB, 2.41725E-04_JPRB, &
+     & 2.89061E-04_JPRB, 3.45667E-04_JPRB, 4.13357E-04_JPRB, 4.94303E-04_JPRB, 5.91101E-04_JPRB, &
+     & 7.06854E-04_JPRB, 8.45275E-04_JPRB, 1.01080E-03_JPRB, 1.20874E-03_JPRB/)
+      KAO_MCO2( 5, :, 6) = (/ &
+     & 5.14797E-05_JPRB, 6.15328E-05_JPRB, 7.35491E-05_JPRB, 8.79120E-05_JPRB, 1.05080E-04_JPRB, &
+     & 1.25600E-04_JPRB, 1.50128E-04_JPRB, 1.79445E-04_JPRB, 2.14487E-04_JPRB, 2.56373E-04_JPRB, &
+     & 3.06438E-04_JPRB, 3.66281E-04_JPRB, 4.37809E-04_JPRB, 5.23305E-04_JPRB, 6.25498E-04_JPRB, &
+     & 7.47647E-04_JPRB, 8.93650E-04_JPRB, 1.06816E-03_JPRB, 1.27676E-03_JPRB/)
+      KAO_MCO2( 6, :, 6) = (/ &
+     & 5.71481E-05_JPRB, 6.83156E-05_JPRB, 8.16652E-05_JPRB, 9.76237E-05_JPRB, 1.16701E-04_JPRB, &
+     & 1.39505E-04_JPRB, 1.66766E-04_JPRB, 1.99354E-04_JPRB, 2.38311E-04_JPRB, 2.84879E-04_JPRB, &
+     & 3.40548E-04_JPRB, 4.07096E-04_JPRB, 4.86647E-04_JPRB, 5.81744E-04_JPRB, 6.95424E-04_JPRB, &
+     & 8.31318E-04_JPRB, 9.93769E-04_JPRB, 1.18796E-03_JPRB, 1.42010E-03_JPRB/)
+      KAO_MCO2( 7, :, 6) = (/ &
+     & 5.69513E-05_JPRB, 6.84420E-05_JPRB, 8.22512E-05_JPRB, 9.88466E-05_JPRB, 1.18790E-04_JPRB, &
+     & 1.42758E-04_JPRB, 1.71562E-04_JPRB, 2.06177E-04_JPRB, 2.47776E-04_JPRB, 2.97768E-04_JPRB, &
+     & 3.57848E-04_JPRB, 4.30049E-04_JPRB, 5.16817E-04_JPRB, 6.21093E-04_JPRB, 7.46407E-04_JPRB, &
+     & 8.97006E-04_JPRB, 1.07799E-03_JPRB, 1.29549E-03_JPRB, 1.55687E-03_JPRB/)
+      KAO_MCO2( 8, :, 6) = (/ &
+     & 4.39361E-06_JPRB, 5.50076E-06_JPRB, 6.88690E-06_JPRB, 8.62235E-06_JPRB, 1.07951E-05_JPRB, &
+     & 1.35154E-05_JPRB, 1.69212E-05_JPRB, 2.11851E-05_JPRB, 2.65236E-05_JPRB, 3.32074E-05_JPRB, &
+     & 4.15754E-05_JPRB, 5.20520E-05_JPRB, 6.51687E-05_JPRB, 8.15907E-05_JPRB, 1.02151E-04_JPRB, &
+     & 1.27892E-04_JPRB, 1.60120E-04_JPRB, 2.00469E-04_JPRB, 2.50985E-04_JPRB/)
+      KAO_MCO2( 9, :, 6) = (/ &
+     & 5.75515E-05_JPRB, 6.86850E-05_JPRB, 8.19722E-05_JPRB, 9.78298E-05_JPRB, 1.16755E-04_JPRB, &
+     & 1.39342E-04_JPRB, 1.66297E-04_JPRB, 1.98468E-04_JPRB, 2.36862E-04_JPRB, 2.82683E-04_JPRB, &
+     & 3.37369E-04_JPRB, 4.02633E-04_JPRB, 4.80523E-04_JPRB, 5.73481E-04_JPRB, 6.84422E-04_JPRB, &
+     & 8.16824E-04_JPRB, 9.74841E-04_JPRB, 1.16342E-03_JPRB, 1.38849E-03_JPRB/)
+      KAO_MCO2( 1, :, 7) = (/ &
+     & 6.84544E-05_JPRB, 8.16461E-05_JPRB, 9.73799E-05_JPRB, 1.16146E-04_JPRB, 1.38528E-04_JPRB, &
+     & 1.65223E-04_JPRB, 1.97063E-04_JPRB, 2.35039E-04_JPRB, 2.80333E-04_JPRB, 3.34355E-04_JPRB, &
+     & 3.98788E-04_JPRB, 4.75637E-04_JPRB, 5.67296E-04_JPRB, 6.76618E-04_JPRB, 8.07008E-04_JPRB, &
+     & 9.62525E-04_JPRB, 1.14801E-03_JPRB, 1.36924E-03_JPRB, 1.63310E-03_JPRB/)
+      KAO_MCO2( 2, :, 7) = (/ &
+     & 6.88332E-05_JPRB, 8.21719E-05_JPRB, 9.80955E-05_JPRB, 1.17105E-04_JPRB, 1.39798E-04_JPRB, &
+     & 1.66888E-04_JPRB, 1.99229E-04_JPRB, 2.37836E-04_JPRB, 2.83925E-04_JPRB, 3.38944E-04_JPRB, &
+     & 4.04627E-04_JPRB, 4.83037E-04_JPRB, 5.76641E-04_JPRB, 6.88385E-04_JPRB, 8.21782E-04_JPRB, &
+     & 9.81031E-04_JPRB, 1.17114E-03_JPRB, 1.39809E-03_JPRB, 1.66901E-03_JPRB/)
+      KAO_MCO2( 3, :, 7) = (/ &
+     & 7.49899E-05_JPRB, 8.94606E-05_JPRB, 1.06724E-04_JPRB, 1.27318E-04_JPRB, 1.51887E-04_JPRB, &
+     & 1.81196E-04_JPRB, 2.16161E-04_JPRB, 2.57873E-04_JPRB, 3.07635E-04_JPRB, 3.66999E-04_JPRB, &
+     & 4.37818E-04_JPRB, 5.22304E-04_JPRB, 6.23092E-04_JPRB, 7.43330E-04_JPRB, 8.86769E-04_JPRB, &
+     & 1.05789E-03_JPRB, 1.26203E-03_JPRB, 1.50556E-03_JPRB, 1.79608E-03_JPRB/)
+      KAO_MCO2( 4, :, 7) = (/ &
+     & 8.26801E-05_JPRB, 9.85802E-05_JPRB, 1.17538E-04_JPRB, 1.40141E-04_JPRB, 1.67092E-04_JPRB, &
+     & 1.99225E-04_JPRB, 2.37537E-04_JPRB, 2.83217E-04_JPRB, 3.37682E-04_JPRB, 4.02621E-04_JPRB, &
+     & 4.80048E-04_JPRB, 5.72365E-04_JPRB, 6.82435E-04_JPRB, 8.13673E-04_JPRB, 9.70148E-04_JPRB, &
+     & 1.15671E-03_JPRB, 1.37916E-03_JPRB, 1.64438E-03_JPRB, 1.96061E-03_JPRB/)
+      KAO_MCO2( 5, :, 7) = (/ &
+     & 9.29561E-05_JPRB, 1.10845E-04_JPRB, 1.32176E-04_JPRB, 1.57612E-04_JPRB, 1.87944E-04_JPRB, &
+     & 2.24112E-04_JPRB, 2.67241E-04_JPRB, 3.18669E-04_JPRB, 3.79995E-04_JPRB, 4.53121E-04_JPRB, &
+     & 5.40321E-04_JPRB, 6.44302E-04_JPRB, 7.68293E-04_JPRB, 9.16146E-04_JPRB, 1.09245E-03_JPRB, &
+     & 1.30268E-03_JPRB, 1.55338E-03_JPRB, 1.85231E-03_JPRB, 2.20877E-03_JPRB/)
+      KAO_MCO2( 6, :, 7) = (/ &
+     & 1.09700E-04_JPRB, 1.30879E-04_JPRB, 1.56148E-04_JPRB, 1.86294E-04_JPRB, 2.22261E-04_JPRB, &
+     & 2.65172E-04_JPRB, 3.16367E-04_JPRB, 3.77446E-04_JPRB, 4.50317E-04_JPRB, 5.37257E-04_JPRB, &
+     & 6.40983E-04_JPRB, 7.64734E-04_JPRB, 9.12376E-04_JPRB, 1.08852E-03_JPRB, 1.29868E-03_JPRB, &
+     & 1.54941E-03_JPRB, 1.84854E-03_JPRB, 2.20543E-03_JPRB, 2.63122E-03_JPRB/)
+      KAO_MCO2( 7, :, 7) = (/ &
+     & 1.43457E-04_JPRB, 1.71554E-04_JPRB, 2.05153E-04_JPRB, 2.45332E-04_JPRB, 2.93381E-04_JPRB, &
+     & 3.50840E-04_JPRB, 4.19552E-04_JPRB, 5.01722E-04_JPRB, 5.99985E-04_JPRB, 7.17492E-04_JPRB, &
+     & 8.58014E-04_JPRB, 1.02606E-03_JPRB, 1.22701E-03_JPRB, 1.46732E-03_JPRB, 1.75470E-03_JPRB, &
+     & 2.09836E-03_JPRB, 2.50933E-03_JPRB, 3.00078E-03_JPRB, 3.58849E-03_JPRB/)
+      KAO_MCO2( 8, :, 7) = (/ &
+     & 1.52152E-05_JPRB, 1.89421E-05_JPRB, 2.35819E-05_JPRB, 2.93582E-05_JPRB, 3.65494E-05_JPRB, &
+     & 4.55021E-05_JPRB, 5.66476E-05_JPRB, 7.05233E-05_JPRB, 8.77978E-05_JPRB, 1.09304E-04_JPRB, &
+     & 1.36077E-04_JPRB, 1.69409E-04_JPRB, 2.10905E-04_JPRB, 2.62565E-04_JPRB, 3.26880E-04_JPRB, &
+     & 4.06948E-04_JPRB, 5.06629E-04_JPRB, 6.30726E-04_JPRB, 7.85219E-04_JPRB/)
+      KAO_MCO2( 9, :, 7) = (/ &
+     & 1.15683E-04_JPRB, 1.37544E-04_JPRB, 1.63535E-04_JPRB, 1.94438E-04_JPRB, 2.31180E-04_JPRB, &
+     & 2.74866E-04_JPRB, 3.26807E-04_JPRB, 3.88563E-04_JPRB, 4.61989E-04_JPRB, 5.49289E-04_JPRB, &
+     & 6.53088E-04_JPRB, 7.76501E-04_JPRB, 9.23234E-04_JPRB, 1.09770E-03_JPRB, 1.30512E-03_JPRB, &
+     & 1.55175E-03_JPRB, 1.84498E-03_JPRB, 2.19362E-03_JPRB, 2.60815E-03_JPRB/)
+      KAO_MCO2( 1, :, 8) = (/ &
+     & 1.18154E-04_JPRB, 1.40516E-04_JPRB, 1.67111E-04_JPRB, 1.98739E-04_JPRB, 2.36353E-04_JPRB, &
+     & 2.81086E-04_JPRB, 3.34285E-04_JPRB, 3.97553E-04_JPRB, 4.72796E-04_JPRB, 5.62278E-04_JPRB, &
+     & 6.68697E-04_JPRB, 7.95257E-04_JPRB, 9.45770E-04_JPRB, 1.12477E-03_JPRB, 1.33765E-03_JPRB, &
+     & 1.59081E-03_JPRB, 1.89190E-03_JPRB, 2.24996E-03_JPRB, 2.67580E-03_JPRB/)
+      KAO_MCO2( 2, :, 8) = (/ &
+     & 1.40874E-04_JPRB, 1.67009E-04_JPRB, 1.97993E-04_JPRB, 2.34726E-04_JPRB, 2.78273E-04_JPRB, &
+     & 3.29899E-04_JPRB, 3.91102E-04_JPRB, 4.63661E-04_JPRB, 5.49680E-04_JPRB, 6.51659E-04_JPRB, &
+     & 7.72556E-04_JPRB, 9.15884E-04_JPRB, 1.08580E-03_JPRB, 1.28724E-03_JPRB, 1.52605E-03_JPRB, &
+     & 1.80917E-03_JPRB, 2.14482E-03_JPRB, 2.54273E-03_JPRB, 3.01446E-03_JPRB/)
+      KAO_MCO2( 3, :, 8) = (/ &
+     & 1.55092E-04_JPRB, 1.84132E-04_JPRB, 2.18609E-04_JPRB, 2.59542E-04_JPRB, 3.08140E-04_JPRB, &
+     & 3.65837E-04_JPRB, 4.34337E-04_JPRB, 5.15664E-04_JPRB, 6.12219E-04_JPRB, 7.26853E-04_JPRB, &
+     & 8.62952E-04_JPRB, 1.02453E-03_JPRB, 1.21637E-03_JPRB, 1.44413E-03_JPRB, 1.71453E-03_JPRB, &
+     & 2.03557E-03_JPRB, 2.41671E-03_JPRB, 2.86923E-03_JPRB, 3.40647E-03_JPRB/)
+      KAO_MCO2( 4, :, 8) = (/ &
+     & 1.80666E-04_JPRB, 2.14521E-04_JPRB, 2.54721E-04_JPRB, 3.02454E-04_JPRB, 3.59131E-04_JPRB, &
+     & 4.26429E-04_JPRB, 5.06339E-04_JPRB, 6.01223E-04_JPRB, 7.13887E-04_JPRB, 8.47663E-04_JPRB, &
+     & 1.00651E-03_JPRB, 1.19512E-03_JPRB, 1.41908E-03_JPRB, 1.68500E-03_JPRB, 2.00076E-03_JPRB, &
+     & 2.37568E-03_JPRB, 2.82087E-03_JPRB, 3.34947E-03_JPRB, 3.97714E-03_JPRB/)
+      KAO_MCO2( 5, :, 8) = (/ &
+     & 2.21554E-04_JPRB, 2.63265E-04_JPRB, 3.12829E-04_JPRB, 3.71724E-04_JPRB, 4.41707E-04_JPRB, &
+     & 5.24865E-04_JPRB, 6.23679E-04_JPRB, 7.41096E-04_JPRB, 8.80619E-04_JPRB, 1.04641E-03_JPRB, &
+     & 1.24341E-03_JPRB, 1.47750E-03_JPRB, 1.75567E-03_JPRB, 2.08620E-03_JPRB, 2.47896E-03_JPRB, &
+     & 2.94566E-03_JPRB, 3.50023E-03_JPRB, 4.15920E-03_JPRB, 4.94224E-03_JPRB/)
+      KAO_MCO2( 6, :, 8) = (/ &
+     & 2.78997E-04_JPRB, 3.32548E-04_JPRB, 3.96378E-04_JPRB, 4.72460E-04_JPRB, 5.63146E-04_JPRB, &
+     & 6.71238E-04_JPRB, 8.00077E-04_JPRB, 9.53647E-04_JPRB, 1.13669E-03_JPRB, 1.35487E-03_JPRB, &
+     & 1.61493E-03_JPRB, 1.92491E-03_JPRB, 2.29438E-03_JPRB, 2.73477E-03_JPRB, 3.25969E-03_JPRB, &
+     & 3.88537E-03_JPRB, 4.63114E-03_JPRB, 5.52005E-03_JPRB, 6.57958E-03_JPRB/)
+      KAO_MCO2( 7, :, 8) = (/ &
+     & 2.84939E-04_JPRB, 3.40606E-04_JPRB, 4.07149E-04_JPRB, 4.86691E-04_JPRB, 5.81774E-04_JPRB, &
+     & 6.95432E-04_JPRB, 8.31295E-04_JPRB, 9.93700E-04_JPRB, 1.18783E-03_JPRB, 1.41989E-03_JPRB, &
+     & 1.69729E-03_JPRB, 2.02888E-03_JPRB, 2.42526E-03_JPRB, 2.89907E-03_JPRB, 3.46544E-03_JPRB, &
+     & 4.14246E-03_JPRB, 4.95176E-03_JPRB, 5.91915E-03_JPRB, 7.07554E-03_JPRB/)
+      KAO_MCO2( 8, :, 8) = (/ &
+     & 5.30764E-05_JPRB, 6.47812E-05_JPRB, 7.90673E-05_JPRB, 9.65039E-05_JPRB, 1.17786E-04_JPRB, &
+     & 1.43761E-04_JPRB, 1.75464E-04_JPRB, 2.14159E-04_JPRB, 2.61387E-04_JPRB, 3.19030E-04_JPRB, &
+     & 3.89385E-04_JPRB, 4.75255E-04_JPRB, 5.80062E-04_JPRB, 7.07982E-04_JPRB, 8.64111E-04_JPRB, &
+     & 1.05467E-03_JPRB, 1.28726E-03_JPRB, 1.57113E-03_JPRB, 1.91761E-03_JPRB/)
+      KAO_MCO2( 9, :, 8) = (/ &
+     & 2.76806E-04_JPRB, 3.29639E-04_JPRB, 3.92556E-04_JPRB, 4.67481E-04_JPRB, 5.56708E-04_JPRB, &
+     & 6.62964E-04_JPRB, 7.89501E-04_JPRB, 9.40190E-04_JPRB, 1.11964E-03_JPRB, 1.33334E-03_JPRB, &
+     & 1.58783E-03_JPRB, 1.89089E-03_JPRB, 2.25180E-03_JPRB, 2.68159E-03_JPRB, 3.19341E-03_JPRB, &
+     & 3.80293E-03_JPRB, 4.52878E-03_JPRB, 5.39316E-03_JPRB, 6.42253E-03_JPRB/)
+      KAO_MCO2( 1, :, 9) = (/ &
+     & 3.30614E-04_JPRB, 3.93289E-04_JPRB, 4.67844E-04_JPRB, 5.56534E-04_JPRB, 6.62036E-04_JPRB, &
+     & 7.87539E-04_JPRB, 9.36833E-04_JPRB, 1.11443E-03_JPRB, 1.32569E-03_JPRB, 1.57700E-03_JPRB, &
+     & 1.87596E-03_JPRB, 2.23158E-03_JPRB, 2.65463E-03_JPRB, 3.15787E-03_JPRB, 3.75650E-03_JPRB, &
+     & 4.46862E-03_JPRB, 5.31575E-03_JPRB, 6.32345E-03_JPRB, 7.52219E-03_JPRB/)
+      KAO_MCO2( 2, :, 9) = (/ &
+     & 3.78453E-04_JPRB, 4.50735E-04_JPRB, 5.36824E-04_JPRB, 6.39355E-04_JPRB, 7.61469E-04_JPRB, &
+     & 9.06906E-04_JPRB, 1.08012E-03_JPRB, 1.28642E-03_JPRB, 1.53212E-03_JPRB, 1.82475E-03_JPRB, &
+     & 2.17326E-03_JPRB, 2.58835E-03_JPRB, 3.08271E-03_JPRB, 3.67149E-03_JPRB, 4.37273E-03_JPRB, &
+     & 5.20790E-03_JPRB, 6.20259E-03_JPRB, 7.38725E-03_JPRB, 8.79818E-03_JPRB/)
+      KAO_MCO2( 3, :, 9) = (/ &
+     & 4.57576E-04_JPRB, 5.45512E-04_JPRB, 6.50348E-04_JPRB, 7.75330E-04_JPRB, 9.24332E-04_JPRB, &
+     & 1.10197E-03_JPRB, 1.31374E-03_JPRB, 1.56621E-03_JPRB, 1.86721E-03_JPRB, 2.22604E-03_JPRB, &
+     & 2.65384E-03_JPRB, 3.16385E-03_JPRB, 3.77187E-03_JPRB, 4.49675E-03_JPRB, 5.36092E-03_JPRB, &
+     & 6.39117E-03_JPRB, 7.61942E-03_JPRB, 9.08370E-03_JPRB, 1.08294E-02_JPRB/)
+      KAO_MCO2( 4, :, 9) = (/ &
+     & 5.18277E-04_JPRB, 6.18764E-04_JPRB, 7.38735E-04_JPRB, 8.81967E-04_JPRB, 1.05297E-03_JPRB, &
+     & 1.25713E-03_JPRB, 1.50087E-03_JPRB, 1.79187E-03_JPRB, 2.13929E-03_JPRB, 2.55407E-03_JPRB, &
+     & 3.04928E-03_JPRB, 3.64050E-03_JPRB, 4.34635E-03_JPRB, 5.18905E-03_JPRB, 6.19514E-03_JPRB, &
+     & 7.39631E-03_JPRB, 8.83036E-03_JPRB, 1.05425E-02_JPRB, 1.25865E-02_JPRB/)
+      KAO_MCO2( 5, :, 9) = (/ &
+     & 4.45365E-04_JPRB, 5.32106E-04_JPRB, 6.35742E-04_JPRB, 7.59563E-04_JPRB, 9.07500E-04_JPRB, &
+     & 1.08425E-03_JPRB, 1.29542E-03_JPRB, 1.54773E-03_JPRB, 1.84917E-03_JPRB, 2.20933E-03_JPRB, &
+     & 2.63963E-03_JPRB, 3.15374E-03_JPRB, 3.76797E-03_JPRB, 4.50184E-03_JPRB, 5.37865E-03_JPRB, &
+     & 6.42622E-03_JPRB, 7.67783E-03_JPRB, 9.17320E-03_JPRB, 1.09598E-02_JPRB/)
+      KAO_MCO2( 6, :, 9) = (/ &
+     & 2.87301E-04_JPRB, 3.43009E-04_JPRB, 4.09519E-04_JPRB, 4.88926E-04_JPRB, 5.83730E-04_JPRB, &
+     & 6.96916E-04_JPRB, 8.32050E-04_JPRB, 9.93386E-04_JPRB, 1.18601E-03_JPRB, 1.41597E-03_JPRB, &
+     & 1.69053E-03_JPRB, 2.01833E-03_JPRB, 2.40969E-03_JPRB, 2.87693E-03_JPRB, 3.43478E-03_JPRB, &
+     & 4.10079E-03_JPRB, 4.89594E-03_JPRB, 5.84527E-03_JPRB, 6.97867E-03_JPRB/)
+      KAO_MCO2( 7, :, 9) = (/ &
+     & 1.10743E-04_JPRB, 1.32286E-04_JPRB, 1.58020E-04_JPRB, 1.88760E-04_JPRB, 2.25480E-04_JPRB, &
+     & 2.69342E-04_JPRB, 3.21738E-04_JPRB, 3.84326E-04_JPRB, 4.59090E-04_JPRB, 5.48397E-04_JPRB, &
+     & 6.55078E-04_JPRB, 7.82511E-04_JPRB, 9.34734E-04_JPRB, 1.11657E-03_JPRB, 1.33378E-03_JPRB, &
+     & 1.59324E-03_JPRB, 1.90318E-03_JPRB, 2.27340E-03_JPRB, 2.71565E-03_JPRB/)
+      KAO_MCO2( 8, :, 9) = (/ &
+     & 8.63177E-05_JPRB, 1.03067E-04_JPRB, 1.23066E-04_JPRB, 1.46946E-04_JPRB, 1.75459E-04_JPRB, &
+     & 2.09505E-04_JPRB, 2.50158E-04_JPRB, 2.98698E-04_JPRB, 3.56658E-04_JPRB, 4.25864E-04_JPRB, &
+     & 5.08498E-04_JPRB, 6.07168E-04_JPRB, 7.24982E-04_JPRB, 8.65658E-04_JPRB, 1.03363E-03_JPRB, &
+     & 1.23420E-03_JPRB, 1.47368E-03_JPRB, 1.75963E-03_JPRB, 2.10107E-03_JPRB/)
+      KAO_MCO2( 9, :, 9) = (/ &
+     & 4.52715E-04_JPRB, 5.41540E-04_JPRB, 6.47792E-04_JPRB, 7.74892E-04_JPRB, 9.26929E-04_JPRB, &
+     & 1.10880E-03_JPRB, 1.32635E-03_JPRB, 1.58658E-03_JPRB, 1.89787E-03_JPRB, 2.27024E-03_JPRB, &
+     & 2.71568E-03_JPRB, 3.24850E-03_JPRB, 3.88587E-03_JPRB, 4.64830E-03_JPRB, 5.56031E-03_JPRB, &
+     & 6.65127E-03_JPRB, 7.95627E-03_JPRB, 9.51732E-03_JPRB, 1.13847E-02_JPRB/)
+      KAO_MCO2( 1, :,10) = (/ &
+     & 9.10418E-04_JPRB, 1.08631E-03_JPRB, 1.29619E-03_JPRB, 1.54662E-03_JPRB, 1.84543E-03_JPRB, &
+     & 2.20198E-03_JPRB, 2.62741E-03_JPRB, 3.13503E-03_JPRB, 3.74073E-03_JPRB, 4.46344E-03_JPRB, &
+     & 5.32580E-03_JPRB, 6.35476E-03_JPRB, 7.58251E-03_JPRB, 9.04748E-03_JPRB, 1.07955E-02_JPRB, &
+     & 1.28812E-02_JPRB, 1.53699E-02_JPRB, 1.83394E-02_JPRB, 2.18826E-02_JPRB/)
+      KAO_MCO2( 2, :,10) = (/ &
+     & 9.06680E-04_JPRB, 1.08622E-03_JPRB, 1.30130E-03_JPRB, 1.55898E-03_JPRB, 1.86768E-03_JPRB, &
+     & 2.23750E-03_JPRB, 2.68056E-03_JPRB, 3.21135E-03_JPRB, 3.84724E-03_JPRB, 4.60905E-03_JPRB, &
+     & 5.52171E-03_JPRB, 6.61508E-03_JPRB, 7.92496E-03_JPRB, 9.49421E-03_JPRB, 1.13742E-02_JPRB, &
+     & 1.36265E-02_JPRB, 1.63247E-02_JPRB, 1.95572E-02_JPRB, 2.34298E-02_JPRB/)
+      KAO_MCO2( 3, :,10) = (/ &
+     & 8.17976E-04_JPRB, 9.79458E-04_JPRB, 1.17282E-03_JPRB, 1.40435E-03_JPRB, 1.68160E-03_JPRB, &
+     & 2.01357E-03_JPRB, 2.41108E-03_JPRB, 2.88707E-03_JPRB, 3.45703E-03_JPRB, 4.13950E-03_JPRB, &
+     & 4.95671E-03_JPRB, 5.93525E-03_JPRB, 7.10696E-03_JPRB, 8.51000E-03_JPRB, 1.01900E-02_JPRB, &
+     & 1.22017E-02_JPRB, 1.46105E-02_JPRB, 1.74949E-02_JPRB, 2.09486E-02_JPRB/)
+      KAO_MCO2( 4, :,10) = (/ &
+     & 3.70314E-04_JPRB, 4.41440E-04_JPRB, 5.26226E-04_JPRB, 6.27298E-04_JPRB, 7.47782E-04_JPRB, &
+     & 8.91407E-04_JPRB, 1.06262E-03_JPRB, 1.26671E-03_JPRB, 1.51001E-03_JPRB, 1.80003E-03_JPRB, &
+     & 2.14576E-03_JPRB, 2.55789E-03_JPRB, 3.04918E-03_JPRB, 3.63483E-03_JPRB, 4.33297E-03_JPRB, &
+     & 5.16520E-03_JPRB, 6.15727E-03_JPRB, 7.33988E-03_JPRB, 8.74963E-03_JPRB/)
+      KAO_MCO2( 5, :,10) = (/ &
+     & 1.00859E-04_JPRB, 1.19692E-04_JPRB, 1.42041E-04_JPRB, 1.68563E-04_JPRB, 2.00038E-04_JPRB, &
+     & 2.37389E-04_JPRB, 2.81715E-04_JPRB, 3.34318E-04_JPRB, 3.96742E-04_JPRB, 4.70823E-04_JPRB, &
+     & 5.58736E-04_JPRB, 6.63065E-04_JPRB, 7.86874E-04_JPRB, 9.33801E-04_JPRB, 1.10816E-03_JPRB, &
+     & 1.31508E-03_JPRB, 1.56064E-03_JPRB, 1.85204E-03_JPRB, 2.19786E-03_JPRB/)
+      KAO_MCO2( 6, :,10) = (/ &
+     & 9.24477E-05_JPRB, 1.09659E-04_JPRB, 1.30074E-04_JPRB, 1.54290E-04_JPRB, 1.83015E-04_JPRB, &
+     & 2.17087E-04_JPRB, 2.57503E-04_JPRB, 3.05442E-04_JPRB, 3.62307E-04_JPRB, 4.29759E-04_JPRB, &
+     & 5.09768E-04_JPRB, 6.04672E-04_JPRB, 7.17245E-04_JPRB, 8.50776E-04_JPRB, 1.00917E-03_JPRB, &
+     & 1.19704E-03_JPRB, 1.41990E-03_JPRB, 1.68425E-03_JPRB, 1.99780E-03_JPRB/)
+      KAO_MCO2( 7, :,10) = (/ &
+     & 8.42943E-05_JPRB, 1.00044E-04_JPRB, 1.18735E-04_JPRB, 1.40919E-04_JPRB, 1.67248E-04_JPRB, &
+     & 1.98496E-04_JPRB, 2.35582E-04_JPRB, 2.79597E-04_JPRB, 3.31836E-04_JPRB, 3.93835E-04_JPRB, &
+     & 4.67418E-04_JPRB, 5.54748E-04_JPRB, 6.58395E-04_JPRB, 7.81407E-04_JPRB, 9.27402E-04_JPRB, &
+     & 1.10067E-03_JPRB, 1.30632E-03_JPRB, 1.55039E-03_JPRB, 1.84005E-03_JPRB/)
+      KAO_MCO2( 8, :,10) = (/ &
+     & 6.86464E-05_JPRB, 8.18163E-05_JPRB, 9.75129E-05_JPRB, 1.16221E-04_JPRB, 1.38518E-04_JPRB, &
+     & 1.65093E-04_JPRB, 1.96767E-04_JPRB, 2.34517E-04_JPRB, 2.79509E-04_JPRB, 3.33133E-04_JPRB, &
+     & 3.97046E-04_JPRB, 4.73220E-04_JPRB, 5.64008E-04_JPRB, 6.72214E-04_JPRB, 8.01179E-04_JPRB, &
+     & 9.54887E-04_JPRB, 1.13808E-03_JPRB, 1.35643E-03_JPRB, 1.61666E-03_JPRB/)
+      KAO_MCO2( 9, :,10) = (/ &
+     & 1.03095E-04_JPRB, 1.21985E-04_JPRB, 1.44335E-04_JPRB, 1.70781E-04_JPRB, 2.02072E-04_JPRB, &
+     & 2.39096E-04_JPRB, 2.82904E-04_JPRB, 3.34739E-04_JPRB, 3.96070E-04_JPRB, 4.68639E-04_JPRB, &
+     & 5.54505E-04_JPRB, 6.56103E-04_JPRB, 7.76316E-04_JPRB, 9.18556E-04_JPRB, 1.08686E-03_JPRB, &
+     & 1.28599E-03_JPRB, 1.52162E-03_JPRB, 1.80041E-03_JPRB, 2.13029E-03_JPRB/)
+      KAO_MCO2( 1, :,11) = (/ &
+     & 1.01275E-03_JPRB, 1.21433E-03_JPRB, 1.45605E-03_JPRB, 1.74587E-03_JPRB, 2.09339E-03_JPRB, &
+     & 2.51007E-03_JPRB, 3.00970E-03_JPRB, 3.60878E-03_JPRB, 4.32711E-03_JPRB, 5.18842E-03_JPRB, &
+     & 6.22117E-03_JPRB, 7.45950E-03_JPRB, 8.94430E-03_JPRB, 1.07247E-02_JPRB, 1.28594E-02_JPRB, &
+     & 1.54191E-02_JPRB, 1.84882E-02_JPRB, 2.21683E-02_JPRB, 2.65809E-02_JPRB/)
+      KAO_MCO2( 2, :,11) = (/ &
+     & 1.06856E-03_JPRB, 1.27885E-03_JPRB, 1.53052E-03_JPRB, 1.83171E-03_JPRB, 2.19218E-03_JPRB, &
+     & 2.62359E-03_JPRB, 3.13990E-03_JPRB, 3.75781E-03_JPRB, 4.49732E-03_JPRB, 5.38236E-03_JPRB, &
+     & 6.44158E-03_JPRB, 7.70924E-03_JPRB, 9.22637E-03_JPRB, 1.10421E-02_JPRB, 1.32151E-02_JPRB, &
+     & 1.58157E-02_JPRB, 1.89281E-02_JPRB, 2.26531E-02_JPRB, 2.71110E-02_JPRB/)
+      KAO_MCO2( 3, :,11) = (/ &
+     & 7.34896E-04_JPRB, 8.77863E-04_JPRB, 1.04864E-03_JPRB, 1.25265E-03_JPRB, 1.49634E-03_JPRB, &
+     & 1.78744E-03_JPRB, 2.13516E-03_JPRB, 2.55054E-03_JPRB, 3.04672E-03_JPRB, 3.63943E-03_JPRB, &
+     & 4.34745E-03_JPRB, 5.19321E-03_JPRB, 6.20349E-03_JPRB, 7.41032E-03_JPRB, 8.85192E-03_JPRB, &
+     & 1.05740E-02_JPRB, 1.26311E-02_JPRB, 1.50883E-02_JPRB, 1.80236E-02_JPRB/)
+      KAO_MCO2( 4, :,11) = (/ &
+     & 5.89491E-05_JPRB, 7.12560E-05_JPRB, 8.61322E-05_JPRB, 1.04114E-04_JPRB, 1.25850E-04_JPRB, &
+     & 1.52124E-04_JPRB, 1.83883E-04_JPRB, 2.22272E-04_JPRB, 2.68676E-04_JPRB, 3.24768E-04_JPRB, &
+     & 3.92571E-04_JPRB, 4.74528E-04_JPRB, 5.73595E-04_JPRB, 6.93346E-04_JPRB, 8.38096E-04_JPRB, &
+     & 1.01307E-03_JPRB, 1.22457E-03_JPRB, 1.48022E-03_JPRB, 1.78924E-03_JPRB/)
+      KAO_MCO2( 5, :,11) = (/ &
+     & 5.32400E-05_JPRB, 6.45465E-05_JPRB, 7.82542E-05_JPRB, 9.48731E-05_JPRB, 1.15021E-04_JPRB, &
+     & 1.39448E-04_JPRB, 1.69063E-04_JPRB, 2.04966E-04_JPRB, 2.48495E-04_JPRB, 3.01268E-04_JPRB, &
+     & 3.65248E-04_JPRB, 4.42816E-04_JPRB, 5.36856E-04_JPRB, 6.50868E-04_JPRB, 7.89092E-04_JPRB, &
+     & 9.56672E-04_JPRB, 1.15984E-03_JPRB, 1.40615E-03_JPRB, 1.70478E-03_JPRB/)
+      KAO_MCO2( 6, :,11) = (/ &
+     & 5.31408E-05_JPRB, 6.42409E-05_JPRB, 7.76597E-05_JPRB, 9.38814E-05_JPRB, 1.13491E-04_JPRB, &
+     & 1.37198E-04_JPRB, 1.65856E-04_JPRB, 2.00500E-04_JPRB, 2.42381E-04_JPRB, 2.93010E-04_JPRB, &
+     & 3.54214E-04_JPRB, 4.28203E-04_JPRB, 5.17647E-04_JPRB, 6.25774E-04_JPRB, 7.56486E-04_JPRB, &
+     & 9.14503E-04_JPRB, 1.10553E-03_JPRB, 1.33645E-03_JPRB, 1.61561E-03_JPRB/)
+      KAO_MCO2( 7, :,11) = (/ &
+     & 5.24517E-05_JPRB, 6.32485E-05_JPRB, 7.62676E-05_JPRB, 9.19667E-05_JPRB, 1.10897E-04_JPRB, &
+     & 1.33725E-04_JPRB, 1.61251E-04_JPRB, 1.94443E-04_JPRB, 2.34467E-04_JPRB, 2.82730E-04_JPRB, &
+     & 3.40928E-04_JPRB, 4.11106E-04_JPRB, 4.95728E-04_JPRB, 5.97770E-04_JPRB, 7.20816E-04_JPRB, &
+     & 8.69190E-04_JPRB, 1.04811E-03_JPRB, 1.26385E-03_JPRB, 1.52400E-03_JPRB/)
+      KAO_MCO2( 8, :,11) = (/ &
+     & 5.01768E-05_JPRB, 6.02217E-05_JPRB, 7.22774E-05_JPRB, 8.67466E-05_JPRB, 1.04112E-04_JPRB, &
+     & 1.24955E-04_JPRB, 1.49969E-04_JPRB, 1.79991E-04_JPRB, 2.16024E-04_JPRB, 2.59270E-04_JPRB, &
+     & 3.11173E-04_JPRB, 3.73467E-04_JPRB, 4.48231E-04_JPRB, 5.37962E-04_JPRB, 6.45656E-04_JPRB, &
+     & 7.74910E-04_JPRB, 9.30039E-04_JPRB, 1.11622E-03_JPRB, 1.33968E-03_JPRB/)
+      KAO_MCO2( 9, :,11) = (/ &
+     & 5.46391E-05_JPRB, 6.58765E-05_JPRB, 7.94252E-05_JPRB, 9.57603E-05_JPRB, 1.15455E-04_JPRB, &
+     & 1.39200E-04_JPRB, 1.67829E-04_JPRB, 2.02346E-04_JPRB, 2.43962E-04_JPRB, 2.94137E-04_JPRB, &
+     & 3.54632E-04_JPRB, 4.27568E-04_JPRB, 5.15504E-04_JPRB, 6.21526E-04_JPRB, 7.49353E-04_JPRB, &
+     & 9.03471E-04_JPRB, 1.08929E-03_JPRB, 1.31331E-03_JPRB, 1.58342E-03_JPRB/)
+      KAO_MCO2( 1, :,12) = (/ &
+     & 1.18469E-03_JPRB, 1.41755E-03_JPRB, 1.69619E-03_JPRB, 2.02959E-03_JPRB, 2.42854E-03_JPRB, &
+     & 2.90589E-03_JPRB, 3.47708E-03_JPRB, 4.16055E-03_JPRB, 4.97836E-03_JPRB, 5.95691E-03_JPRB, &
+     & 7.12782E-03_JPRB, 8.52889E-03_JPRB, 1.02053E-02_JPRB, 1.22113E-02_JPRB, 1.46116E-02_JPRB, &
+     & 1.74837E-02_JPRB, 2.09204E-02_JPRB, 2.50325E-02_JPRB, 2.99530E-02_JPRB/)
+      KAO_MCO2( 2, :,12) = (/ &
+     & 1.09092E-03_JPRB, 1.30288E-03_JPRB, 1.55602E-03_JPRB, 1.85834E-03_JPRB, 2.21940E-03_JPRB, &
+     & 2.65061E-03_JPRB, 3.16560E-03_JPRB, 3.78064E-03_JPRB, 4.51519E-03_JPRB, 5.39245E-03_JPRB, &
+     & 6.44016E-03_JPRB, 7.69143E-03_JPRB, 9.18580E-03_JPRB, 1.09705E-02_JPRB, 1.31020E-02_JPRB, &
+     & 1.56476E-02_JPRB, 1.86878E-02_JPRB, 2.23187E-02_JPRB, 2.66550E-02_JPRB/)
+      KAO_MCO2( 3, :,12) = (/ &
+     & 3.97521E-04_JPRB, 4.74103E-04_JPRB, 5.65438E-04_JPRB, 6.74369E-04_JPRB, 8.04285E-04_JPRB, &
+     & 9.59228E-04_JPRB, 1.14402E-03_JPRB, 1.36442E-03_JPRB, 1.62727E-03_JPRB, 1.94076E-03_JPRB, &
+     & 2.31464E-03_JPRB, 2.76055E-03_JPRB, 3.29237E-03_JPRB, 3.92663E-03_JPRB, 4.68309E-03_JPRB, &
+     & 5.58528E-03_JPRB, 6.66128E-03_JPRB, 7.94456E-03_JPRB, 9.47505E-03_JPRB/)
+      KAO_MCO2( 4, :,12) = (/ &
+     & 7.18557E-05_JPRB, 8.56230E-05_JPRB, 1.02028E-04_JPRB, 1.21576E-04_JPRB, 1.44870E-04_JPRB, &
+     & 1.72626E-04_JPRB, 2.05701E-04_JPRB, 2.45112E-04_JPRB, 2.92075E-04_JPRB, 3.48035E-04_JPRB, &
+     & 4.14718E-04_JPRB, 4.94176E-04_JPRB, 5.88858E-04_JPRB, 7.01682E-04_JPRB, 8.36121E-04_JPRB, &
+     & 9.96319E-04_JPRB, 1.18721E-03_JPRB, 1.41467E-03_JPRB, 1.68572E-03_JPRB/)
+      KAO_MCO2( 5, :,12) = (/ &
+     & 7.33026E-05_JPRB, 8.69077E-05_JPRB, 1.03038E-04_JPRB, 1.22162E-04_JPRB, 1.44836E-04_JPRB, &
+     & 1.71717E-04_JPRB, 2.03588E-04_JPRB, 2.41375E-04_JPRB, 2.86175E-04_JPRB, 3.39289E-04_JPRB, &
+     & 4.02262E-04_JPRB, 4.76923E-04_JPRB, 5.65440E-04_JPRB, 6.70387E-04_JPRB, 7.94812E-04_JPRB, &
+     & 9.42331E-04_JPRB, 1.11723E-03_JPRB, 1.32459E-03_JPRB, 1.57044E-03_JPRB/)
+      KAO_MCO2( 6, :,12) = (/ &
+     & 7.44053E-05_JPRB, 8.82167E-05_JPRB, 1.04592E-04_JPRB, 1.24007E-04_JPRB, 1.47025E-04_JPRB, &
+     & 1.74317E-04_JPRB, 2.06674E-04_JPRB, 2.45038E-04_JPRB, 2.90523E-04_JPRB, 3.44451E-04_JPRB, &
+     & 4.08389E-04_JPRB, 4.84196E-04_JPRB, 5.74074E-04_JPRB, 6.80637E-04_JPRB, 8.06979E-04_JPRB, &
+     & 9.56774E-04_JPRB, 1.13437E-03_JPRB, 1.34494E-03_JPRB, 1.59459E-03_JPRB/)
+      KAO_MCO2( 7, :,12) = (/ &
+     & 7.68762E-05_JPRB, 9.11305E-05_JPRB, 1.08028E-04_JPRB, 1.28058E-04_JPRB, 1.51802E-04_JPRB, &
+     & 1.79949E-04_JPRB, 2.13315E-04_JPRB, 2.52868E-04_JPRB, 2.99754E-04_JPRB, 3.55334E-04_JPRB, &
+     & 4.21220E-04_JPRB, 4.99322E-04_JPRB, 5.91905E-04_JPRB, 7.01656E-04_JPRB, 8.31756E-04_JPRB, &
+     & 9.85979E-04_JPRB, 1.16880E-03_JPRB, 1.38551E-03_JPRB, 1.64241E-03_JPRB/)
+      KAO_MCO2( 8, :,12) = (/ &
+     & 8.45996E-05_JPRB, 1.00214E-04_JPRB, 1.18711E-04_JPRB, 1.40622E-04_JPRB, 1.66577E-04_JPRB, &
+     & 1.97323E-04_JPRB, 2.33743E-04_JPRB, 2.76885E-04_JPRB, 3.27991E-04_JPRB, 3.88529E-04_JPRB, &
+     & 4.60241E-04_JPRB, 5.45189E-04_JPRB, 6.45816E-04_JPRB, 7.65016E-04_JPRB, 9.06216E-04_JPRB, &
+     & 1.07348E-03_JPRB, 1.27161E-03_JPRB, 1.50632E-03_JPRB, 1.78434E-03_JPRB/)
+      KAO_MCO2( 9, :,12) = (/ &
+     & 7.73583E-05_JPRB, 9.16767E-05_JPRB, 1.08645E-04_JPRB, 1.28755E-04_JPRB, 1.52586E-04_JPRB, &
+     & 1.80829E-04_JPRB, 2.14299E-04_JPRB, 2.53964E-04_JPRB, 3.00970E-04_JPRB, 3.56678E-04_JPRB, &
+     & 4.22696E-04_JPRB, 5.00934E-04_JPRB, 5.93652E-04_JPRB, 7.03533E-04_JPRB, 8.33751E-04_JPRB, &
+     & 9.88072E-04_JPRB, 1.17096E-03_JPRB, 1.38769E-03_JPRB, 1.64454E-03_JPRB/)
+      KAO_MCO2( 1, :,13) = (/ &
+     & 1.20952E-03_JPRB, 1.44504E-03_JPRB, 1.72642E-03_JPRB, 2.06260E-03_JPRB, 2.46423E-03_JPRB, &
+     & 2.94407E-03_JPRB, 3.51735E-03_JPRB, 4.20226E-03_JPRB, 5.02053E-03_JPRB, 5.99814E-03_JPRB, &
+     & 7.16612E-03_JPRB, 8.56153E-03_JPRB, 1.02287E-02_JPRB, 1.22204E-02_JPRB, 1.46000E-02_JPRB, &
+     & 1.74430E-02_JPRB, 2.08395E-02_JPRB, 2.48974E-02_JPRB, 2.97455E-02_JPRB/)
+      KAO_MCO2( 2, :,13) = (/ &
+     & 8.47667E-04_JPRB, 1.01027E-03_JPRB, 1.20407E-03_JPRB, 1.43505E-03_JPRB, 1.71034E-03_JPRB, &
+     & 2.03843E-03_JPRB, 2.42946E-03_JPRB, 2.89550E-03_JPRB, 3.45094E-03_JPRB, 4.11293E-03_JPRB, &
+     & 4.90192E-03_JPRB, 5.84225E-03_JPRB, 6.96296E-03_JPRB, 8.29866E-03_JPRB, 9.89058E-03_JPRB, &
+     & 1.17879E-02_JPRB, 1.40492E-02_JPRB, 1.67442E-02_JPRB, 1.99562E-02_JPRB/)
+      KAO_MCO2( 3, :,13) = (/ &
+     & 1.45612E-04_JPRB, 1.71739E-04_JPRB, 2.02554E-04_JPRB, 2.38897E-04_JPRB, 2.81762E-04_JPRB, &
+     & 3.32318E-04_JPRB, 3.91945E-04_JPRB, 4.62271E-04_JPRB, 5.45215E-04_JPRB, 6.43041E-04_JPRB, &
+     & 7.58421E-04_JPRB, 8.94503E-04_JPRB, 1.05500E-03_JPRB, 1.24430E-03_JPRB, 1.46756E-03_JPRB, &
+     & 1.73088E-03_JPRB, 2.04145E-03_JPRB, 2.40774E-03_JPRB, 2.83975E-03_JPRB/)
+      KAO_MCO2( 4, :,13) = (/ &
+     & 1.40167E-04_JPRB, 1.65266E-04_JPRB, 1.94858E-04_JPRB, 2.29750E-04_JPRB, 2.70889E-04_JPRB, &
+     & 3.19394E-04_JPRB, 3.76585E-04_JPRB, 4.44016E-04_JPRB, 5.23522E-04_JPRB, 6.17264E-04_JPRB, &
+     & 7.27791E-04_JPRB, 8.58110E-04_JPRB, 1.01176E-03_JPRB, 1.19293E-03_JPRB, 1.40654E-03_JPRB, &
+     & 1.65839E-03_JPRB, 1.95534E-03_JPRB, 2.30547E-03_JPRB, 2.71828E-03_JPRB/)
+      KAO_MCO2( 5, :,13) = (/ &
+     & 1.37406E-04_JPRB, 1.61990E-04_JPRB, 1.90973E-04_JPRB, 2.25141E-04_JPRB, 2.65423E-04_JPRB, &
+     & 3.12911E-04_JPRB, 3.68896E-04_JPRB, 4.34898E-04_JPRB, 5.12709E-04_JPRB, 6.04442E-04_JPRB, &
+     & 7.12587E-04_JPRB, 8.40082E-04_JPRB, 9.90387E-04_JPRB, 1.16758E-03_JPRB, 1.37648E-03_JPRB, &
+     & 1.62276E-03_JPRB, 1.91310E-03_JPRB, 2.25539E-03_JPRB, 2.65892E-03_JPRB/)
+      KAO_MCO2( 6, :,13) = (/ &
+     & 1.35356E-04_JPRB, 1.59577E-04_JPRB, 1.88132E-04_JPRB, 2.21797E-04_JPRB, 2.61485E-04_JPRB, &
+     & 3.08276E-04_JPRB, 3.63440E-04_JPRB, 4.28475E-04_JPRB, 5.05147E-04_JPRB, 5.95539E-04_JPRB, &
+     & 7.02106E-04_JPRB, 8.27743E-04_JPRB, 9.75861E-04_JPRB, 1.15048E-03_JPRB, 1.35635E-03_JPRB, &
+     & 1.59906E-03_JPRB, 1.88520E-03_JPRB, 2.22255E-03_JPRB, 2.62025E-03_JPRB/)
+      KAO_MCO2( 7, :,13) = (/ &
+     & 1.33359E-04_JPRB, 1.57252E-04_JPRB, 1.85424E-04_JPRB, 2.18645E-04_JPRB, 2.57817E-04_JPRB, &
+     & 3.04007E-04_JPRB, 3.58472E-04_JPRB, 4.22695E-04_JPRB, 4.98425E-04_JPRB, 5.87722E-04_JPRB, &
+     & 6.93017E-04_JPRB, 8.17177E-04_JPRB, 9.63581E-04_JPRB, 1.13621E-03_JPRB, 1.33978E-03_JPRB, &
+     & 1.57981E-03_JPRB, 1.86284E-03_JPRB, 2.19659E-03_JPRB, 2.59012E-03_JPRB/)
+      KAO_MCO2( 8, :,13) = (/ &
+     & 1.29667E-04_JPRB, 1.53001E-04_JPRB, 1.80534E-04_JPRB, 2.13022E-04_JPRB, 2.51356E-04_JPRB, &
+     & 2.96589E-04_JPRB, 3.49961E-04_JPRB, 4.12938E-04_JPRB, 4.87249E-04_JPRB, 5.74931E-04_JPRB, &
+     & 6.78393E-04_JPRB, 8.00473E-04_JPRB, 9.44521E-04_JPRB, 1.11449E-03_JPRB, 1.31505E-03_JPRB, &
+     & 1.55170E-03_JPRB, 1.83094E-03_JPRB, 2.16042E-03_JPRB, 2.54920E-03_JPRB/)
+      KAO_MCO2( 9, :,13) = (/ &
+     & 1.37892E-04_JPRB, 1.62557E-04_JPRB, 1.91635E-04_JPRB, 2.25914E-04_JPRB, 2.66324E-04_JPRB, &
+     & 3.13963E-04_JPRB, 3.70124E-04_JPRB, 4.36330E-04_JPRB, 5.14379E-04_JPRB, 6.06389E-04_JPRB, &
+     & 7.14858E-04_JPRB, 8.42730E-04_JPRB, 9.93473E-04_JPRB, 1.17118E-03_JPRB, 1.38068E-03_JPRB, &
+     & 1.62765E-03_JPRB, 1.91880E-03_JPRB, 2.26202E-03_JPRB, 2.66665E-03_JPRB/)
+      KAO_MCO2( 1, :,14) = (/ &
+     & 1.28098E-03_JPRB, 1.52939E-03_JPRB, 1.82597E-03_JPRB, 2.18007E-03_JPRB, 2.60284E-03_JPRB, &
+     & 3.10759E-03_JPRB, 3.71022E-03_JPRB, 4.42972E-03_JPRB, 5.28874E-03_JPRB, 6.31435E-03_JPRB, &
+     & 7.53885E-03_JPRB, 9.00081E-03_JPRB, 1.07463E-02_JPRB, 1.28302E-02_JPRB, 1.53183E-02_JPRB, &
+     & 1.82889E-02_JPRB, 2.18355E-02_JPRB, 2.60699E-02_JPRB, 3.11255E-02_JPRB/)
+      KAO_MCO2( 2, :,14) = (/ &
+     & 1.27275E-04_JPRB, 1.48842E-04_JPRB, 1.74064E-04_JPRB, 2.03561E-04_JPRB, 2.38055E-04_JPRB, &
+     & 2.78395E-04_JPRB, 3.25570E-04_JPRB, 3.80740E-04_JPRB, 4.45259E-04_JPRB, 5.20710E-04_JPRB, &
+     & 6.08947E-04_JPRB, 7.12137E-04_JPRB, 8.32812E-04_JPRB, 9.73937E-04_JPRB, 1.13898E-03_JPRB, &
+     & 1.33198E-03_JPRB, 1.55769E-03_JPRB, 1.82165E-03_JPRB, 2.13034E-03_JPRB/)
+      KAO_MCO2( 3, :,14) = (/ &
+     & 1.27744E-04_JPRB, 1.49255E-04_JPRB, 1.74389E-04_JPRB, 2.03755E-04_JPRB, 2.38066E-04_JPRB, &
+     & 2.78155E-04_JPRB, 3.24995E-04_JPRB, 3.79722E-04_JPRB, 4.43666E-04_JPRB, 5.18376E-04_JPRB, &
+     & 6.05668E-04_JPRB, 7.07660E-04_JPRB, 8.26826E-04_JPRB, 9.66059E-04_JPRB, 1.12874E-03_JPRB, &
+     & 1.31881E-03_JPRB, 1.54089E-03_JPRB, 1.80037E-03_JPRB, 2.10354E-03_JPRB/)
+      KAO_MCO2( 4, :,14) = (/ &
+     & 1.28543E-04_JPRB, 1.50136E-04_JPRB, 1.75357E-04_JPRB, 2.04814E-04_JPRB, 2.39219E-04_JPRB, &
+     & 2.79404E-04_JPRB, 3.26339E-04_JPRB, 3.81159E-04_JPRB, 4.45188E-04_JPRB, 5.19972E-04_JPRB, &
+     & 6.07319E-04_JPRB, 7.09339E-04_JPRB, 8.28496E-04_JPRB, 9.67670E-04_JPRB, 1.13022E-03_JPRB, &
+     & 1.32008E-03_JPRB, 1.54184E-03_JPRB, 1.80084E-03_JPRB, 2.10335E-03_JPRB/)
+      KAO_MCO2( 5, :,14) = (/ &
+     & 1.29218E-04_JPRB, 1.50897E-04_JPRB, 1.76214E-04_JPRB, 2.05778E-04_JPRB, 2.40302E-04_JPRB, &
+     & 2.80618E-04_JPRB, 3.27698E-04_JPRB, 3.82678E-04_JPRB, 4.46881E-04_JPRB, 5.21855E-04_JPRB, &
+     & 6.09409E-04_JPRB, 7.11652E-04_JPRB, 8.31048E-04_JPRB, 9.70475E-04_JPRB, 1.13330E-03_JPRB, &
+     & 1.32343E-03_JPRB, 1.54547E-03_JPRB, 1.80476E-03_JPRB, 2.10755E-03_JPRB/)
+      KAO_MCO2( 6, :,14) = (/ &
+     & 1.30502E-04_JPRB, 1.52368E-04_JPRB, 1.77898E-04_JPRB, 2.07706E-04_JPRB, 2.42508E-04_JPRB, &
+     & 2.83141E-04_JPRB, 3.30583E-04_JPRB, 3.85974E-04_JPRB, 4.50646E-04_JPRB, 5.26153E-04_JPRB, &
+     & 6.14313E-04_JPRB, 7.17244E-04_JPRB, 8.37422E-04_JPRB, 9.77736E-04_JPRB, 1.14156E-03_JPRB, &
+     & 1.33283E-03_JPRB, 1.55616E-03_JPRB, 1.81690E-03_JPRB, 2.12133E-03_JPRB/)
+      KAO_MCO2( 7, :,14) = (/ &
+     & 1.32820E-04_JPRB, 1.55041E-04_JPRB, 1.80980E-04_JPRB, 2.11259E-04_JPRB, 2.46604E-04_JPRB, &
+     & 2.87862E-04_JPRB, 3.36022E-04_JPRB, 3.92240E-04_JPRB, 4.57864E-04_JPRB, 5.34467E-04_JPRB, &
+     & 6.23886E-04_JPRB, 7.28265E-04_JPRB, 8.50107E-04_JPRB, 9.92334E-04_JPRB, 1.15836E-03_JPRB, &
+     & 1.35215E-03_JPRB, 1.57838E-03_JPRB, 1.84244E-03_JPRB, 2.15069E-03_JPRB/)
+      KAO_MCO2( 8, :,14) = (/ &
+     & 1.40203E-04_JPRB, 1.63590E-04_JPRB, 1.90879E-04_JPRB, 2.22720E-04_JPRB, 2.59872E-04_JPRB, &
+     & 3.03221E-04_JPRB, 3.53801E-04_JPRB, 4.12819E-04_JPRB, 4.81681E-04_JPRB, 5.62031E-04_JPRB, &
+     & 6.55783E-04_JPRB, 7.65175E-04_JPRB, 8.92814E-04_JPRB, 1.04174E-03_JPRB, 1.21552E-03_JPRB, &
+     & 1.41828E-03_JPRB, 1.65486E-03_JPRB, 1.93091E-03_JPRB, 2.25301E-03_JPRB/)
+      KAO_MCO2( 9, :,14) = (/ &
+     & 1.30642E-04_JPRB, 1.52513E-04_JPRB, 1.78046E-04_JPRB, 2.07853E-04_JPRB, 2.42651E-04_JPRB, &
+     & 2.83275E-04_JPRB, 3.30699E-04_JPRB, 3.86063E-04_JPRB, 4.50696E-04_JPRB, 5.26149E-04_JPRB, &
+     & 6.14234E-04_JPRB, 7.17066E-04_JPRB, 8.37113E-04_JPRB, 9.77259E-04_JPRB, 1.14087E-03_JPRB, &
+     & 1.33186E-03_JPRB, 1.55484E-03_JPRB, 1.81514E-03_JPRB, 2.11902E-03_JPRB/)
+      KAO_MCO2( 1, :,15) = (/ &
+     & 1.37603E-03_JPRB, 1.64035E-03_JPRB, 1.95543E-03_JPRB, 2.33105E-03_JPRB, 2.77881E-03_JPRB, &
+     & 3.31257E-03_JPRB, 3.94887E-03_JPRB, 4.70739E-03_JPRB, 5.61162E-03_JPRB, 6.68952E-03_JPRB, &
+     & 7.97449E-03_JPRB, 9.50627E-03_JPRB, 1.13323E-02_JPRB, 1.35091E-02_JPRB, 1.61039E-02_JPRB, &
+     & 1.91973E-02_JPRB, 2.28848E-02_JPRB, 2.72806E-02_JPRB, 3.25208E-02_JPRB/)
+      KAO_MCO2( 2, :,15) = (/ &
+     & 1.67843E-04_JPRB, 1.93707E-04_JPRB, 2.23557E-04_JPRB, 2.58007E-04_JPRB, 2.97765E-04_JPRB, &
+     & 3.43650E-04_JPRB, 3.96606E-04_JPRB, 4.57722E-04_JPRB, 5.28256E-04_JPRB, 6.09659E-04_JPRB, &
+     & 7.03606E-04_JPRB, 8.12031E-04_JPRB, 9.37163E-04_JPRB, 1.08158E-03_JPRB, 1.24825E-03_JPRB, &
+     & 1.44060E-03_JPRB, 1.66259E-03_JPRB, 1.91880E-03_JPRB, 2.21448E-03_JPRB/)
+      KAO_MCO2( 3, :,15) = (/ &
+     & 1.67595E-04_JPRB, 1.93410E-04_JPRB, 2.23200E-04_JPRB, 2.57579E-04_JPRB, 2.97253E-04_JPRB, &
+     & 3.43039E-04_JPRB, 3.95876E-04_JPRB, 4.56852E-04_JPRB, 5.27220E-04_JPRB, 6.08426E-04_JPRB, &
+     & 7.02141E-04_JPRB, 8.10291E-04_JPRB, 9.35098E-04_JPRB, 1.07913E-03_JPRB, 1.24534E-03_JPRB, &
+     & 1.43716E-03_JPRB, 1.65853E-03_JPRB, 1.91398E-03_JPRB, 2.20879E-03_JPRB/)
+      KAO_MCO2( 4, :,15) = (/ &
+     & 1.67354E-04_JPRB, 1.93130E-04_JPRB, 2.22877E-04_JPRB, 2.57206E-04_JPRB, 2.96823E-04_JPRB, &
+     & 3.42541E-04_JPRB, 3.95301E-04_JPRB, 4.56187E-04_JPRB, 5.26452E-04_JPRB, 6.07539E-04_JPRB, &
+     & 7.01116E-04_JPRB, 8.09106E-04_JPRB, 9.33728E-04_JPRB, 1.07755E-03_JPRB, 1.24352E-03_JPRB, &
+     & 1.43505E-03_JPRB, 1.65608E-03_JPRB, 1.91116E-03_JPRB, 2.20553E-03_JPRB/)
+      KAO_MCO2( 5, :,15) = (/ &
+     & 1.67437E-04_JPRB, 1.93232E-04_JPRB, 2.23002E-04_JPRB, 2.57358E-04_JPRB, 2.97006E-04_JPRB, &
+     & 3.42763E-04_JPRB, 3.95570E-04_JPRB, 4.56511E-04_JPRB, 5.26842E-04_JPRB, 6.08007E-04_JPRB, &
+     & 7.01677E-04_JPRB, 8.09778E-04_JPRB, 9.34533E-04_JPRB, 1.07851E-03_JPRB, 1.24466E-03_JPRB, &
+     & 1.43642E-03_JPRB, 1.65771E-03_JPRB, 1.91310E-03_JPRB, 2.20783E-03_JPRB/)
+      KAO_MCO2( 6, :,15) = (/ &
+     & 1.67267E-04_JPRB, 1.93027E-04_JPRB, 2.22753E-04_JPRB, 2.57057E-04_JPRB, 2.96645E-04_JPRB, &
+     & 3.42328E-04_JPRB, 3.95047E-04_JPRB, 4.55885E-04_JPRB, 5.26092E-04_JPRB, 6.07110E-04_JPRB, &
+     & 7.00606E-04_JPRB, 8.08500E-04_JPRB, 9.33010E-04_JPRB, 1.07669E-03_JPRB, 1.24251E-03_JPRB, &
+     & 1.43385E-03_JPRB, 1.65467E-03_JPRB, 1.90949E-03_JPRB, 2.20355E-03_JPRB/)
+      KAO_MCO2( 7, :,15) = (/ &
+     & 1.67354E-04_JPRB, 1.93130E-04_JPRB, 2.22877E-04_JPRB, 2.57206E-04_JPRB, 2.96823E-04_JPRB, &
+     & 3.42541E-04_JPRB, 3.95301E-04_JPRB, 4.56187E-04_JPRB, 5.26452E-04_JPRB, 6.07539E-04_JPRB, &
+     & 7.01116E-04_JPRB, 8.09106E-04_JPRB, 9.33728E-04_JPRB, 1.07755E-03_JPRB, 1.24352E-03_JPRB, &
+     & 1.43505E-03_JPRB, 1.65608E-03_JPRB, 1.91116E-03_JPRB, 2.20553E-03_JPRB/)
+      KAO_MCO2( 8, :,15) = (/ &
+     & 1.67276E-04_JPRB, 1.93038E-04_JPRB, 2.22769E-04_JPRB, 2.57079E-04_JPRB, 2.96673E-04_JPRB, &
+     & 3.42365E-04_JPRB, 3.95094E-04_JPRB, 4.55944E-04_JPRB, 5.26166E-04_JPRB, 6.07203E-04_JPRB, &
+     & 7.00722E-04_JPRB, 8.08643E-04_JPRB, 9.33186E-04_JPRB, 1.07691E-03_JPRB, 1.24277E-03_JPRB, &
+     & 1.43417E-03_JPRB, 1.65506E-03_JPRB, 1.90996E-03_JPRB, 2.20412E-03_JPRB/)
+      KAO_MCO2( 9, :,15) = (/ &
+     & 1.67437E-04_JPRB, 1.93232E-04_JPRB, 2.23002E-04_JPRB, 2.57358E-04_JPRB, 2.97006E-04_JPRB, &
+     & 3.42763E-04_JPRB, 3.95570E-04_JPRB, 4.56511E-04_JPRB, 5.26842E-04_JPRB, 6.08007E-04_JPRB, &
+     & 7.01677E-04_JPRB, 8.09778E-04_JPRB, 9.34533E-04_JPRB, 1.07851E-03_JPRB, 1.24466E-03_JPRB, &
+     & 1.43642E-03_JPRB, 1.65771E-03_JPRB, 1.91310E-03_JPRB, 2.20783E-03_JPRB/)
+      KAO_MCO2( 1, :,16) = (/ &
+     & 1.42104E-03_JPRB, 1.69791E-03_JPRB, 2.02872E-03_JPRB, 2.42399E-03_JPRB, 2.89626E-03_JPRB, &
+     & 3.46055E-03_JPRB, 4.13478E-03_JPRB, 4.94038E-03_JPRB, 5.90294E-03_JPRB, 7.05303E-03_JPRB, &
+     & 8.42720E-03_JPRB, 1.00691E-02_JPRB, 1.20309E-02_JPRB, 1.43749E-02_JPRB, 1.71757E-02_JPRB, &
+     & 2.05221E-02_JPRB, 2.45205E-02_JPRB, 2.92979E-02_JPRB, 3.50061E-02_JPRB/)
+      KAO_MCO2( 2, :,16) = (/ &
+     & 1.63777E-04_JPRB, 1.88736E-04_JPRB, 2.17498E-04_JPRB, 2.50643E-04_JPRB, 2.88839E-04_JPRB, &
+     & 3.32857E-04_JPRB, 3.83582E-04_JPRB, 4.42037E-04_JPRB, 5.09401E-04_JPRB, 5.87030E-04_JPRB, &
+     & 6.76490E-04_JPRB, 7.79583E-04_JPRB, 8.98386E-04_JPRB, 1.03530E-03_JPRB, 1.19307E-03_JPRB, &
+     & 1.37488E-03_JPRB, 1.58441E-03_JPRB, 1.82586E-03_JPRB, 2.10411E-03_JPRB/)
+      KAO_MCO2( 3, :,16) = (/ &
+     & 1.63679E-04_JPRB, 1.88621E-04_JPRB, 2.17365E-04_JPRB, 2.50489E-04_JPRB, 2.88661E-04_JPRB, &
+     & 3.32650E-04_JPRB, 3.83342E-04_JPRB, 4.41759E-04_JPRB, 5.09079E-04_JPRB, 5.86657E-04_JPRB, &
+     & 6.76057E-04_JPRB, 7.79080E-04_JPRB, 8.97804E-04_JPRB, 1.03462E-03_JPRB, 1.19228E-03_JPRB, &
+     & 1.37397E-03_JPRB, 1.58335E-03_JPRB, 1.82464E-03_JPRB, 2.10269E-03_JPRB/)
+      KAO_MCO2( 4, :,16) = (/ &
+     & 1.63679E-04_JPRB, 1.88621E-04_JPRB, 2.17365E-04_JPRB, 2.50489E-04_JPRB, 2.88661E-04_JPRB, &
+     & 3.32650E-04_JPRB, 3.83342E-04_JPRB, 4.41759E-04_JPRB, 5.09079E-04_JPRB, 5.86657E-04_JPRB, &
+     & 6.76057E-04_JPRB, 7.79080E-04_JPRB, 8.97804E-04_JPRB, 1.03462E-03_JPRB, 1.19228E-03_JPRB, &
+     & 1.37397E-03_JPRB, 1.58335E-03_JPRB, 1.82464E-03_JPRB, 2.10269E-03_JPRB/)
+      KAO_MCO2( 5, :,16) = (/ &
+     & 1.63586E-04_JPRB, 1.88513E-04_JPRB, 2.17239E-04_JPRB, 2.50343E-04_JPRB, 2.88490E-04_JPRB, &
+     & 3.32451E-04_JPRB, 3.83111E-04_JPRB, 4.41490E-04_JPRB, 5.08766E-04_JPRB, 5.86292E-04_JPRB, &
+     & 6.75633E-04_JPRB, 7.78588E-04_JPRB, 8.97231E-04_JPRB, 1.03395E-03_JPRB, 1.19151E-03_JPRB, &
+     & 1.37307E-03_JPRB, 1.58231E-03_JPRB, 1.82342E-03_JPRB, 2.10128E-03_JPRB/)
+      KAO_MCO2( 6, :,16) = (/ &
+     & 1.63679E-04_JPRB, 1.88621E-04_JPRB, 2.17365E-04_JPRB, 2.50489E-04_JPRB, 2.88661E-04_JPRB, &
+     & 3.32650E-04_JPRB, 3.83342E-04_JPRB, 4.41759E-04_JPRB, 5.09079E-04_JPRB, 5.86657E-04_JPRB, &
+     & 6.76057E-04_JPRB, 7.79080E-04_JPRB, 8.97804E-04_JPRB, 1.03462E-03_JPRB, 1.19228E-03_JPRB, &
+     & 1.37397E-03_JPRB, 1.58335E-03_JPRB, 1.82464E-03_JPRB, 2.10269E-03_JPRB/)
+      KAO_MCO2( 7, :,16) = (/ &
+     & 1.63679E-04_JPRB, 1.88621E-04_JPRB, 2.17365E-04_JPRB, 2.50489E-04_JPRB, 2.88661E-04_JPRB, &
+     & 3.32650E-04_JPRB, 3.83342E-04_JPRB, 4.41759E-04_JPRB, 5.09079E-04_JPRB, 5.86657E-04_JPRB, &
+     & 6.76057E-04_JPRB, 7.79080E-04_JPRB, 8.97804E-04_JPRB, 1.03462E-03_JPRB, 1.19228E-03_JPRB, &
+     & 1.37397E-03_JPRB, 1.58335E-03_JPRB, 1.82464E-03_JPRB, 2.10269E-03_JPRB/)
+      KAO_MCO2( 8, :,16) = (/ &
+     & 1.63479E-04_JPRB, 1.88391E-04_JPRB, 2.17098E-04_JPRB, 2.50180E-04_JPRB, 2.88303E-04_JPRB, &
+     & 3.32236E-04_JPRB, 3.82863E-04_JPRB, 4.41205E-04_JPRB, 5.08437E-04_JPRB, 5.85914E-04_JPRB, &
+     & 6.75198E-04_JPRB, 7.78087E-04_JPRB, 8.96654E-04_JPRB, 1.03329E-03_JPRB, 1.19074E-03_JPRB, &
+     & 1.37219E-03_JPRB, 1.58129E-03_JPRB, 1.82226E-03_JPRB, 2.09994E-03_JPRB/)
+      KAO_MCO2( 9, :,16) = (/ &
+     & 1.63586E-04_JPRB, 1.88513E-04_JPRB, 2.17239E-04_JPRB, 2.50343E-04_JPRB, 2.88490E-04_JPRB, &
+     & 3.32451E-04_JPRB, 3.83111E-04_JPRB, 4.41490E-04_JPRB, 5.08766E-04_JPRB, 5.86292E-04_JPRB, &
+     & 6.75633E-04_JPRB, 7.78588E-04_JPRB, 8.97231E-04_JPRB, 1.03395E-03_JPRB, 1.19151E-03_JPRB, &
+     & 1.37307E-03_JPRB, 1.58231E-03_JPRB, 1.82342E-03_JPRB, 2.10128E-03_JPRB/)
+
+!     The array KBO_Mxx contains the absorption coefficient for 
+!     a minor species at the 16 chosen g-values for a reference pressure
+!     level above 100~ mb.   The first index refers to temperature 
+!     in 7.2 degree increments.  For instance, JT = 1 refers to a 
+!     temperature of 188.0, JT = 2 refers to 195.2, etc. The second index 
+!     runs over the g-channel (1 to 16).
+
+      KBO_MCO2(:, 1) = (/ &
+     & 3.72069E-06_JPRB, 4.81866E-06_JPRB, 6.24064E-06_JPRB, 8.08226E-06_JPRB, 1.04673E-05_JPRB, &
+     & 1.35562E-05_JPRB, 1.75567E-05_JPRB, 2.27376E-05_JPRB, 2.94475E-05_JPRB, 3.81375E-05_JPRB, &
+     & 4.93918E-05_JPRB, 6.39674E-05_JPRB, 8.28441E-05_JPRB, 1.07291E-04_JPRB, 1.38953E-04_JPRB, &
+     & 1.79958E-04_JPRB, 2.33064E-04_JPRB, 3.01840E-04_JPRB, 3.90913E-04_JPRB/)
+      KBO_MCO2(:, 2) = (/ &
+     & 8.14357E-06_JPRB, 1.06031E-05_JPRB, 1.38056E-05_JPRB, 1.79752E-05_JPRB, 2.34041E-05_JPRB, &
+     & 3.04728E-05_JPRB, 3.96763E-05_JPRB, 5.16596E-05_JPRB, 6.72622E-05_JPRB, 8.75770E-05_JPRB, &
+     & 1.14027E-04_JPRB, 1.48467E-04_JPRB, 1.93307E-04_JPRB, 2.51691E-04_JPRB, 3.27708E-04_JPRB, &
+     & 4.26685E-04_JPRB, 5.55555E-04_JPRB, 7.23346E-04_JPRB, 9.41814E-04_JPRB/)
+      KBO_MCO2(:, 3) = (/ &
+     & 1.09367E-05_JPRB, 1.42063E-05_JPRB, 1.84533E-05_JPRB, 2.39701E-05_JPRB, 3.11362E-05_JPRB, &
+     & 4.04446E-05_JPRB, 5.25358E-05_JPRB, 6.82417E-05_JPRB, 8.86432E-05_JPRB, 1.15144E-04_JPRB, &
+     & 1.49567E-04_JPRB, 1.94281E-04_JPRB, 2.52363E-04_JPRB, 3.27809E-04_JPRB, 4.25810E-04_JPRB, &
+     & 5.53109E-04_JPRB, 7.18466E-04_JPRB, 9.33256E-04_JPRB, 1.21226E-03_JPRB/)
+      KBO_MCO2(:, 4) = (/ &
+     & 1.76192E-05_JPRB, 2.27752E-05_JPRB, 2.94401E-05_JPRB, 3.80553E-05_JPRB, 4.91916E-05_JPRB, &
+     & 6.35867E-05_JPRB, 8.21944E-05_JPRB, 1.06247E-04_JPRB, 1.37339E-04_JPRB, 1.77529E-04_JPRB, &
+     & 2.29480E-04_JPRB, 2.96635E-04_JPRB, 3.83440E-04_JPRB, 4.95648E-04_JPRB, 6.40691E-04_JPRB, &
+     & 8.28180E-04_JPRB, 1.07054E-03_JPRB, 1.38381E-03_JPRB, 1.78876E-03_JPRB/)
+      KBO_MCO2(:, 5) = (/ &
+     & 3.72142E-05_JPRB, 4.78603E-05_JPRB, 6.15520E-05_JPRB, 7.91605E-05_JPRB, 1.01806E-04_JPRB, &
+     & 1.30931E-04_JPRB, 1.68387E-04_JPRB, 2.16558E-04_JPRB, 2.78510E-04_JPRB, 3.58185E-04_JPRB, &
+     & 4.60653E-04_JPRB, 5.92435E-04_JPRB, 7.61915E-04_JPRB, 9.79881E-04_JPRB, 1.26020E-03_JPRB, &
+     & 1.62071E-03_JPRB, 2.08436E-03_JPRB, 2.68064E-03_JPRB, 3.44751E-03_JPRB/)
+      KBO_MCO2(:, 6) = (/ &
+     & 7.74131E-05_JPRB, 9.98876E-05_JPRB, 1.28887E-04_JPRB, 1.66305E-04_JPRB, 2.14587E-04_JPRB, &
+     & 2.76886E-04_JPRB, 3.57272E-04_JPRB, 4.60994E-04_JPRB, 5.94831E-04_JPRB, 7.67521E-04_JPRB, &
+     & 9.90348E-04_JPRB, 1.27787E-03_JPRB, 1.64886E-03_JPRB, 2.12755E-03_JPRB, 2.74522E-03_JPRB, &
+     & 3.54221E-03_JPRB, 4.57059E-03_JPRB, 5.89752E-03_JPRB, 7.60968E-03_JPRB/)
+      KBO_MCO2(:, 7) = (/ &
+     & 1.32294E-04_JPRB, 1.70977E-04_JPRB, 2.20973E-04_JPRB, 2.85587E-04_JPRB, 3.69095E-04_JPRB, &
+     & 4.77022E-04_JPRB, 6.16507E-04_JPRB, 7.96779E-04_JPRB, 1.02976E-03_JPRB, 1.33088E-03_JPRB, &
+     & 1.72004E-03_JPRB, 2.22299E-03_JPRB, 2.87301E-03_JPRB, 3.71310E-03_JPRB, 4.79884E-03_JPRB, &
+     & 6.20207E-03_JPRB, 8.01561E-03_JPRB, 1.03594E-02_JPRB, 1.33886E-02_JPRB/)
+      KBO_MCO2(:, 8) = (/ &
+     & 3.59868E-05_JPRB, 4.63611E-05_JPRB, 5.97261E-05_JPRB, 7.69439E-05_JPRB, 9.91253E-05_JPRB, &
+     & 1.27701E-04_JPRB, 1.64515E-04_JPRB, 2.11941E-04_JPRB, 2.73040E-04_JPRB, 3.51752E-04_JPRB, &
+     & 4.53155E-04_JPRB, 5.83790E-04_JPRB, 7.52085E-04_JPRB, 9.68897E-04_JPRB, 1.24821E-03_JPRB, &
+     & 1.60804E-03_JPRB, 2.07161E-03_JPRB, 2.66882E-03_JPRB, 3.43818E-03_JPRB/)
+      KBO_MCO2(:, 9) = (/ &
+     & 5.09543E-05_JPRB, 6.60510E-05_JPRB, 8.56205E-05_JPRB, 1.10988E-04_JPRB, 1.43872E-04_JPRB, &
+     & 1.86498E-04_JPRB, 2.41753E-04_JPRB, 3.13380E-04_JPRB, 4.06228E-04_JPRB, 5.26585E-04_JPRB, &
+     & 6.82601E-04_JPRB, 8.84842E-04_JPRB, 1.14700E-03_JPRB, 1.48684E-03_JPRB, 1.92735E-03_JPRB, &
+     & 2.49839E-03_JPRB, 3.23861E-03_JPRB, 4.19814E-03_JPRB, 5.44196E-03_JPRB/)
+      KBO_MCO2(:,10) = (/ &
+     & 2.08253E-05_JPRB, 2.64900E-05_JPRB, 3.36954E-05_JPRB, 4.28609E-05_JPRB, 5.45194E-05_JPRB, &
+     & 6.93491E-05_JPRB, 8.82125E-05_JPRB, 1.12207E-04_JPRB, 1.42728E-04_JPRB, 1.81551E-04_JPRB, &
+     & 2.30935E-04_JPRB, 2.93751E-04_JPRB, 3.73653E-04_JPRB, 4.75290E-04_JPRB, 6.04572E-04_JPRB, &
+     & 7.69021E-04_JPRB, 9.78201E-04_JPRB, 1.24428E-03_JPRB, 1.58273E-03_JPRB/)
+      KBO_MCO2(:,11) = (/ &
+     & 2.08953E-05_JPRB, 2.65543E-05_JPRB, 3.37459E-05_JPRB, 4.28852E-05_JPRB, 5.44996E-05_JPRB, &
+     & 6.92595E-05_JPRB, 8.80169E-05_JPRB, 1.11854E-04_JPRB, 1.42147E-04_JPRB, 1.80644E-04_JPRB, &
+     & 2.29568E-04_JPRB, 2.91741E-04_JPRB, 3.70752E-04_JPRB, 4.71161E-04_JPRB, 5.98764E-04_JPRB, &
+     & 7.60925E-04_JPRB, 9.67005E-04_JPRB, 1.22889E-03_JPRB, 1.56171E-03_JPRB/)
+      KBO_MCO2(:,12) = (/ &
+     & 2.65295E-05_JPRB, 3.36318E-05_JPRB, 4.26356E-05_JPRB, 5.40498E-05_JPRB, 6.85198E-05_JPRB, &
+     & 8.68636E-05_JPRB, 1.10118E-04_JPRB, 1.39599E-04_JPRB, 1.76972E-04_JPRB, 2.24350E-04_JPRB, &
+     & 2.84412E-04_JPRB, 3.60553E-04_JPRB, 4.57079E-04_JPRB, 5.79446E-04_JPRB, 7.34572E-04_JPRB, &
+     & 9.31230E-04_JPRB, 1.18053E-03_JPRB, 1.49658E-03_JPRB, 1.89724E-03_JPRB/)
+      KBO_MCO2(:,13) = (/ &
+     & 3.45358E-05_JPRB, 4.36743E-05_JPRB, 5.52309E-05_JPRB, 6.98455E-05_JPRB, 8.83273E-05_JPRB, &
+     & 1.11700E-04_JPRB, 1.41256E-04_JPRB, 1.78634E-04_JPRB, 2.25902E-04_JPRB, 2.85678E-04_JPRB, &
+     & 3.61271E-04_JPRB, 4.56867E-04_JPRB, 5.77758E-04_JPRB, 7.30639E-04_JPRB, 9.23973E-04_JPRB, &
+     & 1.16847E-03_JPRB, 1.47765E-03_JPRB, 1.86865E-03_JPRB, 2.36311E-03_JPRB/)
+      KBO_MCO2(:,14) = (/ &
+     & 3.99721E-05_JPRB, 5.12343E-05_JPRB, 6.56698E-05_JPRB, 8.41725E-05_JPRB, 1.07888E-04_JPRB, &
+     & 1.38286E-04_JPRB, 1.77249E-04_JPRB, 2.27190E-04_JPRB, 2.91201E-04_JPRB, 3.73248E-04_JPRB, &
+     & 4.78412E-04_JPRB, 6.13207E-04_JPRB, 7.85980E-04_JPRB, 1.00743E-03_JPRB, 1.29128E-03_JPRB, &
+     & 1.65510E-03_JPRB, 2.12144E-03_JPRB, 2.71916E-03_JPRB, 3.48529E-03_JPRB/)
+      KBO_MCO2(:,15) = (/ &
+     & 8.51533E-06_JPRB, 1.23021E-05_JPRB, 1.77730E-05_JPRB, 2.56767E-05_JPRB, 3.70953E-05_JPRB, &
+     & 5.35918E-05_JPRB, 7.74243E-05_JPRB, 1.11855E-04_JPRB, 1.61598E-04_JPRB, 2.33461E-04_JPRB, &
+     & 3.37283E-04_JPRB, 4.87275E-04_JPRB, 7.03968E-04_JPRB, 1.01703E-03_JPRB, 1.46930E-03_JPRB, &
+     & 2.12271E-03_JPRB, 3.06670E-03_JPRB, 4.43047E-03_JPRB, 6.40072E-03_JPRB/)
+      KBO_MCO2(:,16) = (/ &
+     & 2.93050E-06_JPRB, 3.65298E-06_JPRB, 4.55358E-06_JPRB, 5.67622E-06_JPRB, 7.07564E-06_JPRB, &
+     & 8.82006E-06_JPRB, 1.09945E-05_JPRB, 1.37051E-05_JPRB, 1.70840E-05_JPRB, 2.12959E-05_JPRB, &
+     & 2.65461E-05_JPRB, 3.30908E-05_JPRB, 4.12490E-05_JPRB, 5.14185E-05_JPRB, 6.40952E-05_JPRB, &
+     & 7.98972E-05_JPRB, 9.95951E-05_JPRB, 1.24149E-04_JPRB, 1.54757E-04_JPRB/)
+
+!     The array FORREFO contains the coefficient of the water vapor
+!     foreign-continuum (including the energy term).  The first 
+!     index refers to reference temperature (296_rb,260_rb,224,260) and 
+!     pressure (970,475,219,3 mbar) levels.  The second index 
+!     runs over the g-channel (1 to 16).
+
+      FORREFO(1,:) = (/ &
+     &2.0677E-07_JPRB,2.0363E-07_JPRB,2.0583E-07_JPRB,2.0547E-07_JPRB,2.0267E-07_JPRB,2.0154E-07_JPRB, &
+     &2.0190E-07_JPRB,2.0103E-07_JPRB,1.9869E-07_JPRB,1.9663E-07_JPRB,1.9701E-07_JPRB,2.0103E-07_JPRB, &
+     &2.0527E-07_JPRB,2.0206E-07_JPRB,2.0364E-07_JPRB,2.0364E-07_JPRB/)
+      FORREFO(2,:) = (/ &
+     &2.2427E-07_JPRB,2.1489E-07_JPRB,2.0453E-07_JPRB,1.9710E-07_JPRB,1.9650E-07_JPRB,1.9738E-07_JPRB, &
+     &1.9767E-07_JPRB,1.9769E-07_JPRB,1.9940E-07_JPRB,1.9846E-07_JPRB,1.9898E-07_JPRB,1.9853E-07_JPRB, &
+     &2.0000E-07_JPRB,2.0517E-07_JPRB,2.0482E-07_JPRB,2.0482E-07_JPRB/)
+      FORREFO(3,:) = (/ &
+     &2.2672E-07_JPRB,2.1706E-07_JPRB,2.0571E-07_JPRB,1.9747E-07_JPRB,1.9706E-07_JPRB,1.9698E-07_JPRB, &
+     &1.9781E-07_JPRB,1.9774E-07_JPRB,1.9724E-07_JPRB,1.9714E-07_JPRB,1.9751E-07_JPRB,1.9758E-07_JPRB, &
+     &1.9840E-07_JPRB,1.9968E-07_JPRB,1.9931E-07_JPRB,1.9880E-07_JPRB/)
+      FORREFO(4,:) = (/ &
+     &2.2191E-07_JPRB,2.0899E-07_JPRB,2.0265E-07_JPRB,2.0101E-07_JPRB,2.0034E-07_JPRB,2.0021E-07_JPRB, &
+     &1.9987E-07_JPRB,1.9978E-07_JPRB,1.9902E-07_JPRB,1.9742E-07_JPRB,1.9672E-07_JPRB,1.9615E-07_JPRB, &
+     &1.9576E-07_JPRB,1.9540E-07_JPRB,1.9588E-07_JPRB,1.9590E-07_JPRB/)
+
+
+!     The array SELFREFO contains the coefficient of the water vapor
+!     self-continuum (including the energy term).  The first index
+!     refers to temperature in 7.2 degree increments.  For instance,
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+!     etc.  The second index runs over the g-channel (1 to 16).
+
+      SELFREFO(:, 1) = (/ &
+     & 5.18832E-02_JPRB, 4.28690E-02_JPRB, 3.54210E-02_JPRB, 2.92670E-02_JPRB, 2.41822E-02_JPRB, &
+     & 1.99808E-02_JPRB, 1.65093E-02_JPRB, 1.36410E-02_JPRB, 1.12710E-02_JPRB, 9.31280E-03_JPRB/)
+      SELFREFO(:, 2) = (/ &
+     & 4.36030E-02_JPRB, 3.78379E-02_JPRB, 3.28350E-02_JPRB, 2.84936E-02_JPRB, 2.47262E-02_JPRB, &
+     & 2.14569E-02_JPRB, 1.86199E-02_JPRB, 1.61580E-02_JPRB, 1.40216E-02_JPRB, 1.21677E-02_JPRB/)
+      SELFREFO(:, 3) = (/ &
+     & 4.26492E-02_JPRB, 3.71443E-02_JPRB, 3.23500E-02_JPRB, 2.81745E-02_JPRB, 2.45379E-02_JPRB, &
+     & 2.13707E-02_JPRB, 1.86124E-02_JPRB, 1.62100E-02_JPRB, 1.41177E-02_JPRB, 1.22955E-02_JPRB/)
+      SELFREFO(:, 4) = (/ &
+     & 4.03591E-02_JPRB, 3.54614E-02_JPRB, 3.11580E-02_JPRB, 2.73769E-02_JPRB, 2.40546E-02_JPRB, &
+     & 2.11355E-02_JPRB, 1.85706E-02_JPRB, 1.63170E-02_JPRB, 1.43369E-02_JPRB, 1.25970E-02_JPRB/)
+      SELFREFO(:, 5) = (/ &
+     & 3.94512E-02_JPRB, 3.46232E-02_JPRB, 3.03860E-02_JPRB, 2.66674E-02_JPRB, 2.34038E-02_JPRB, &
+     & 2.05397E-02_JPRB, 1.80260E-02_JPRB, 1.58200E-02_JPRB, 1.38839E-02_JPRB, 1.21848E-02_JPRB/)
+      SELFREFO(:, 6) = (/ &
+     & 3.90567E-02_JPRB, 3.40694E-02_JPRB, 2.97190E-02_JPRB, 2.59241E-02_JPRB, 2.26138E-02_JPRB, &
+     & 1.97261E-02_JPRB, 1.72072E-02_JPRB, 1.50100E-02_JPRB, 1.30933E-02_JPRB, 1.14214E-02_JPRB/)
+      SELFREFO(:, 7) = (/ &
+     & 3.85397E-02_JPRB, 3.36462E-02_JPRB, 2.93740E-02_JPRB, 2.56443E-02_JPRB, 2.23881E-02_JPRB, &
+     & 1.95454E-02_JPRB, 1.70636E-02_JPRB, 1.48970E-02_JPRB, 1.30055E-02_JPRB, 1.13541E-02_JPRB/)
+      SELFREFO(:, 8) = (/ &
+     & 3.79692E-02_JPRB, 3.31360E-02_JPRB, 2.89180E-02_JPRB, 2.52369E-02_JPRB, 2.20245E-02_JPRB, &
+     & 1.92209E-02_JPRB, 1.67742E-02_JPRB, 1.46390E-02_JPRB, 1.27756E-02_JPRB, 1.11493E-02_JPRB/)
+      SELFREFO(:, 9) = (/ &
+     & 3.68819E-02_JPRB, 3.22827E-02_JPRB, 2.82570E-02_JPRB, 2.47333E-02_JPRB, 2.16490E-02_JPRB, &
+     & 1.89494E-02_JPRB, 1.65863E-02_JPRB, 1.45180E-02_JPRB, 1.27076E-02_JPRB, 1.11229E-02_JPRB/)
+      SELFREFO(:,10) = (/ &
+     & 3.65157E-02_JPRB, 3.20121E-02_JPRB, 2.80640E-02_JPRB, 2.46028E-02_JPRB, 2.15685E-02_JPRB, &
+     & 1.89084E-02_JPRB, 1.65764E-02_JPRB, 1.45320E-02_JPRB, 1.27397E-02_JPRB, 1.11685E-02_JPRB/)
+      SELFREFO(:,11) = (/ &
+     & 3.59917E-02_JPRB, 3.16727E-02_JPRB, 2.78720E-02_JPRB, 2.45274E-02_JPRB, 2.15841E-02_JPRB, &
+     & 1.89940E-02_JPRB, 1.67148E-02_JPRB, 1.47090E-02_JPRB, 1.29439E-02_JPRB, 1.13907E-02_JPRB/)
+      SELFREFO(:,12) = (/ &
+     & 3.66963E-02_JPRB, 3.20483E-02_JPRB, 2.79890E-02_JPRB, 2.44439E-02_JPRB, 2.13478E-02_JPRB, &
+     & 1.86438E-02_JPRB, 1.62824E-02_JPRB, 1.42200E-02_JPRB, 1.24189E-02_JPRB, 1.08459E-02_JPRB/)
+      SELFREFO(:,13) = (/ &
+     & 3.66422E-02_JPRB, 3.19026E-02_JPRB, 2.77760E-02_JPRB, 2.41832E-02_JPRB, 2.10551E-02_JPRB, &
+     & 1.83317E-02_JPRB, 1.59605E-02_JPRB, 1.38960E-02_JPRB, 1.20986E-02_JPRB, 1.05336E-02_JPRB/)
+      SELFREFO(:,14) = (/ &
+     & 3.81260E-02_JPRB, 3.29322E-02_JPRB, 2.84460E-02_JPRB, 2.45709E-02_JPRB, 2.12237E-02_JPRB, &
+     & 1.83325E-02_JPRB, 1.58352E-02_JPRB, 1.36780E-02_JPRB, 1.18147E-02_JPRB, 1.02052E-02_JPRB/)
+      SELFREFO(:,15) = (/ &
+     & 3.51264E-02_JPRB, 3.05081E-02_JPRB, 2.64970E-02_JPRB, 2.30133E-02_JPRB, 1.99876E-02_JPRB, &
+     & 1.73597E-02_JPRB, 1.50773E-02_JPRB, 1.30950E-02_JPRB, 1.13733E-02_JPRB, 9.87800E-03_JPRB/)
+      SELFREFO(:,16) = (/ &
+     & 3.51264E-02_JPRB, 3.05081E-02_JPRB, 2.64970E-02_JPRB, 2.30133E-02_JPRB, 1.99876E-02_JPRB, &
+     & 1.73597E-02_JPRB, 1.50773E-02_JPRB, 1.30950E-02_JPRB, 1.13733E-02_JPRB, 9.87800E-03_JPRB/)
+
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB7',1,ZHOOK_HANDLE)
+RETURN
+
+1001 CONTINUE
+
+CALL ABOR1("RRTM_KGB7:ERROR READING FILE RADRRTM")
+
+END SUBROUTINE RRTM_KGB7
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb7.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb7.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb7.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_KGB7
+END SUBROUTINE RRTM_KGB7
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb8.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb8.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb8.F90	(revision 3908)
@@ -0,0 +1,625 @@
+SUBROUTINE RRTM_KGB8
+
+!     Originally by Eli J. Mlawer, Atmospheric & Environmental Research.
+!     BAND 8:  1080-1180 cm-1 (low (i.e.>~300mb) - H2O; high - O3)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+!     G.Mozdzynski March 2011 read constants from files
+!     ABozzo updated to rrtmg v4.85
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+USE YOMLUN    ,ONLY : NULRAD
+USE MPL_MODULE,ONLY : MPL_BROADCAST
+USE YOMTAG    ,ONLY : MTAGRAD
+USE YOMMP0    , ONLY : NPROC, MYPROC
+
+USE YOERRTO8 , ONLY : KAO     ,KBO       ,KAO_D,KBO_D,SELFREFO ,FORREFO,FRACREFAO ,&
+ & FRACREFBO, CFC12O  ,CFC22ADJO ,KAO_MCO2,KBO_MCO2,&
+ & KAO_MN2O,KBO_MN2O,KAO_MO3  
+
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB8',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+  READ(NULRAD,ERR=1001) KAO_D,KBO_D
+ ! Convert the data into model actual precision.
+  KAO = REAL(KAO_D,JPRB)
+  KBO = REAL(KBO_D,JPRB)
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KAO,MTAGRAD,1,CDSTRING='RRTM_KGB8:')
+  CALL MPL_BROADCAST (KBO,MTAGRAD,1,CDSTRING='RRTM_KGB8:')
+ENDIF
+
+
+! Planck fraction mapping level : P=473.4280 mb, T = 259.83 K
+      FRACREFAO(:) = (/ &
+      &  1.6004E-01_JPRB,1.5437E-01_JPRB,1.4502E-01_JPRB,1.3084E-01_JPRB,1.1523E-01_JPRB,9.7743E-02_JPRB, &
+      &  8.0376E-02_JPRB,6.0261E-02_JPRB,4.1111E-02_JPRB,4.4772E-03_JPRB,3.6511E-03_JPRB,2.9154E-03_JPRB, &
+      &  2.1184E-03_JPRB,1.3048E-03_JPRB,4.6637E-04_JPRB,6.5624E-05_JPRB/)
+
+! Planck fraction mapping level : P=95.5835 mb, T= 215.7 K
+      FRACREFBO(:) = (/ &
+      &  1.4987E-01_JPRB,1.4665E-01_JPRB,1.4154E-01_JPRB,1.3200E-01_JPRB,1.1902E-01_JPRB,1.0352E-01_JPRB, &
+      &  8.4939E-02_JPRB,6.4105E-02_JPRB,4.3190E-02_JPRB,4.5129E-03_JPRB,3.7656E-03_JPRB,2.8733E-03_JPRB, &
+      &  2.0947E-03_JPRB,1.3201E-03_JPRB,5.1832E-04_JPRB,7.7473E-05_JPRB/)
+
+! 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
+
+CFC12O( :) = (/&
+ & 85.4027_JPRB, 89.4696_JPRB, 74.0959_JPRB, 67.7480_JPRB,&
+ & 61.2444_JPRB, 59.9073_JPRB, 60.8296_JPRB, 63.0998_JPRB,&
+ & 59.6110_JPRB, 64.0735_JPRB, 57.2622_JPRB, 58.9721_JPRB,&
+ & 43.5505_JPRB, 26.1192_JPRB, 32.7023_JPRB, 32.8667_JPRB/)  
+
+!     Original CFC22 is multiplied by 1.485 to account for the 780-850 cm-1 
+!     and 1290-1335 cm-1 bands.
+CFC22ADJO( :) = (/&
+ & 135.335_JPRB, 89.6642_JPRB, 76.2375_JPRB, 65.9748_JPRB,&
+ & 63.1164_JPRB, 60.2935_JPRB, 64.0299_JPRB, 75.4264_JPRB,&
+ & 51.3018_JPRB, 7.07911_JPRB, 5.86928_JPRB, 0.398693_JPRB,&
+ & 2.82885_JPRB, 9.12751_JPRB, 6.28271_JPRB, 0.0_JPRB/)  
+
+!     ------------------------------------------------------------------
+
+!     The array KAO contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels > ~100mb and temperatures.  The first
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the corresponding TREF for this  pressure level, 
+!     JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, 
+!     JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  The second 
+!     index, JP, runs from 1 to 13 and refers to the corresponding 
+!     pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).  
+!     The third index, IG, goes from 1 to 16, and tells us which 
+!     g-interval the absorption coefficients are for.
+!     The array KA contains absorption coef5s at the 16 chosen g-values 
+!     for a range of pressure levels > ~100mb and temperatures.  The first
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the cooresponding TREF for this  pressure level, 
+!     JT = 2 refers to the temperature
+!     TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
+!     is for TREF+30.  The second index, JP, runs from 1 to 13 and refers
+!     to the corresponding pressure level in PREF (e.g. JP = 1 is for a
+!     pressure of 1053.63 mb).  The third index, IG, goes from 1 to 16,
+!     and tells us which "g-channel" the absorption coefficients are for.
+
+
+
+!     The array KBO contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels < ~100mb and temperatures. The first 
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the reference temperature TREF for this pressure 
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
+!     The second index, JP, runs from 13 to 59 and refers to the JPth
+!     reference pressure level (see taumol.f for the value of these
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
+!     and tells us which g-interval the absorption coefficients are for.
+
+
+
+!     The array KAO_Mxx contains the absorption coefficient for 
+!     a minor species at the 16 chosen g-values for a reference pressure
+!     level below 100~ mb.   The first index refers to temperature 
+!     in 7.2 degree increments.  For instance, JT = 1 refers to a 
+!     temperature of 188.0, JT = 2 refers to 195.2, etc. The second index 
+!     runs over the g-channel (1 to 16).
+
+      KAO_MCO2(:, 1) = (/ &
+     & 8.88964E-07_JPRB, 1.13087E-06_JPRB, 1.43861E-06_JPRB, 1.83010E-06_JPRB, 2.32811E-06_JPRB, &
+     & 2.96165E-06_JPRB, 3.76760E-06_JPRB, 4.79286E-06_JPRB, 6.09712E-06_JPRB, 7.75630E-06_JPRB, &
+     & 9.86699E-06_JPRB, 1.25521E-05_JPRB, 1.59678E-05_JPRB, 2.03130E-05_JPRB, 2.58407E-05_JPRB, &
+     & 3.28727E-05_JPRB, 4.18182E-05_JPRB, 5.31980E-05_JPRB, 6.76745E-05_JPRB/)
+      KAO_MCO2(:, 2) = (/ &
+     & 1.10492E-05_JPRB, 1.35003E-05_JPRB, 1.64952E-05_JPRB, 2.01545E-05_JPRB, 2.46256E-05_JPRB, &
+     & 3.00885E-05_JPRB, 3.67632E-05_JPRB, 4.49188E-05_JPRB, 5.48835E-05_JPRB, 6.70588E-05_JPRB, &
+     & 8.19351E-05_JPRB, 1.00111E-04_JPRB, 1.22320E-04_JPRB, 1.49455E-04_JPRB, 1.82610E-04_JPRB, &
+     & 2.23121E-04_JPRB, 2.72618E-04_JPRB, 3.33095E-04_JPRB, 4.06988E-04_JPRB/)
+      KAO_MCO2(:, 3) = (/ &
+     & 1.51034E-05_JPRB, 1.81249E-05_JPRB, 2.17508E-05_JPRB, 2.61020E-05_JPRB, 3.13238E-05_JPRB, &
+     & 3.75901E-05_JPRB, 4.51101E-05_JPRB, 5.41344E-05_JPRB, 6.49640E-05_JPRB, 7.79601E-05_JPRB, &
+     & 9.35562E-05_JPRB, 1.12272E-04_JPRB, 1.34732E-04_JPRB, 1.61686E-04_JPRB, 1.94031E-04_JPRB, &
+     & 2.32847E-04_JPRB, 2.79429E-04_JPRB, 3.35329E-04_JPRB, 4.02411E-04_JPRB/)
+      KAO_MCO2(:, 4) = (/ &
+     & 1.57088E-05_JPRB, 1.89537E-05_JPRB, 2.28688E-05_JPRB, 2.75928E-05_JPRB, 3.32924E-05_JPRB, &
+     & 4.01695E-05_JPRB, 4.84671E-05_JPRB, 5.84787E-05_JPRB, 7.05584E-05_JPRB, 8.51332E-05_JPRB, &
+     & 1.02719E-04_JPRB, 1.23937E-04_JPRB, 1.49538E-04_JPRB, 1.80427E-04_JPRB, 2.17697E-04_JPRB, &
+     & 2.62666E-04_JPRB, 3.16923E-04_JPRB, 3.82388E-04_JPRB, 4.61376E-04_JPRB/)
+      KAO_MCO2(:, 5) = (/ &
+     & 3.09299E-05_JPRB, 3.73196E-05_JPRB, 4.50294E-05_JPRB, 5.43320E-05_JPRB, 6.55563E-05_JPRB, &
+     & 7.90995E-05_JPRB, 9.54405E-05_JPRB, 1.15157E-04_JPRB, 1.38948E-04_JPRB, 1.67652E-04_JPRB, &
+     & 2.02288E-04_JPRB, 2.44078E-04_JPRB, 2.94501E-04_JPRB, 3.55342E-04_JPRB, 4.28751E-04_JPRB, &
+     & 5.17327E-04_JPRB, 6.24200E-04_JPRB, 7.53153E-04_JPRB, 9.08745E-04_JPRB/)
+      KAO_MCO2(:, 6) = (/ &
+     & 1.98653E-05_JPRB, 2.38878E-05_JPRB, 2.87248E-05_JPRB, 3.45413E-05_JPRB, 4.15355E-05_JPRB, &
+     & 4.99459E-05_JPRB, 6.00593E-05_JPRB, 7.22206E-05_JPRB, 8.68445E-05_JPRB, 1.04429E-04_JPRB, &
+     & 1.25575E-04_JPRB, 1.51003E-04_JPRB, 1.81579E-04_JPRB, 2.18346E-04_JPRB, 2.62559E-04_JPRB, &
+     & 3.15724E-04_JPRB, 3.79654E-04_JPRB, 4.56529E-04_JPRB, 5.48971E-04_JPRB/)
+      KAO_MCO2(:, 7) = (/ &
+     & 1.54276E-06_JPRB, 1.90144E-06_JPRB, 2.34351E-06_JPRB, 2.88836E-06_JPRB, 3.55989E-06_JPRB, &
+     & 4.38754E-06_JPRB, 5.40761E-06_JPRB, 6.66485E-06_JPRB, 8.21439E-06_JPRB, 1.01242E-05_JPRB, &
+     & 1.24780E-05_JPRB, 1.53790E-05_JPRB, 1.89546E-05_JPRB, 2.33614E-05_JPRB, 2.87928E-05_JPRB, &
+     & 3.54869E-05_JPRB, 4.37374E-05_JPRB, 5.39060E-05_JPRB, 6.64388E-05_JPRB/)
+      KAO_MCO2(:, 8) = (/ &
+     & 1.66907E-06_JPRB, 2.11106E-06_JPRB, 2.67008E-06_JPRB, 3.37714E-06_JPRB, 4.27143E-06_JPRB, &
+     & 5.40254E-06_JPRB, 6.83318E-06_JPRB, 8.64266E-06_JPRB, 1.09313E-05_JPRB, 1.38260E-05_JPRB, &
+     & 1.74872E-05_JPRB, 2.21180E-05_JPRB, 2.79750E-05_JPRB, 3.53830E-05_JPRB, 4.47527E-05_JPRB, &
+     & 5.66036E-05_JPRB, 7.15927E-05_JPRB, 9.05509E-05_JPRB, 1.14529E-04_JPRB/)
+      KAO_MCO2(:, 9) = (/ &
+     & 1.22817E-06_JPRB, 1.56416E-06_JPRB, 1.99206E-06_JPRB, 2.53703E-06_JPRB, 3.23108E-06_JPRB, &
+     & 4.11501E-06_JPRB, 5.24074E-06_JPRB, 6.67445E-06_JPRB, 8.50037E-06_JPRB, 1.08258E-05_JPRB, &
+     & 1.37874E-05_JPRB, 1.75592E-05_JPRB, 2.23629E-05_JPRB, 2.84807E-05_JPRB, 3.62721E-05_JPRB, &
+     & 4.61950E-05_JPRB, 5.88325E-05_JPRB, 7.49272E-05_JPRB, 9.54249E-05_JPRB/)
+      KAO_MCO2(:,10) = (/ &
+     & 3.45943E-08_JPRB, 3.84726E-08_JPRB, 4.27856E-08_JPRB, 4.75821E-08_JPRB, 5.29164E-08_JPRB, &
+     & 5.88487E-08_JPRB, 6.54460E-08_JPRB, 7.27829E-08_JPRB, 8.09423E-08_JPRB, 9.00164E-08_JPRB, &
+     & 1.00108E-07_JPRB, 1.11331E-07_JPRB, 1.23811E-07_JPRB, 1.37691E-07_JPRB, 1.53128E-07_JPRB, &
+     & 1.70294E-07_JPRB, 1.89385E-07_JPRB, 2.10616E-07_JPRB, 2.34228E-07_JPRB/)
+      KAO_MCO2(:,11) = (/ &
+     & 2.89971E-08_JPRB, 3.35110E-08_JPRB, 3.87275E-08_JPRB, 4.47561E-08_JPRB, 5.17230E-08_JPRB, &
+     & 5.97745E-08_JPRB, 6.90794E-08_JPRB, 7.98327E-08_JPRB, 9.22599E-08_JPRB, 1.06622E-07_JPRB, &
+     & 1.23219E-07_JPRB, 1.42400E-07_JPRB, 1.64567E-07_JPRB, 1.90184E-07_JPRB, 2.19789E-07_JPRB, &
+     & 2.54003E-07_JPRB, 2.93542E-07_JPRB, 3.39237E-07_JPRB, 3.92044E-07_JPRB/)
+      KAO_MCO2(:,12) = (/ &
+     & 2.51330E-08_JPRB, 2.96783E-08_JPRB, 3.50457E-08_JPRB, 4.13837E-08_JPRB, 4.88679E-08_JPRB, &
+     & 5.77056E-08_JPRB, 6.81416E-08_JPRB, 8.04650E-08_JPRB, 9.50171E-08_JPRB, 1.12201E-07_JPRB, &
+     & 1.32492E-07_JPRB, 1.56454E-07_JPRB, 1.84748E-07_JPRB, 2.18160E-07_JPRB, 2.57614E-07_JPRB, &
+     & 3.04203E-07_JPRB, 3.59218E-07_JPRB, 4.24182E-07_JPRB, 5.00895E-07_JPRB/)
+      KAO_MCO2(:,13) = (/ &
+     & 1.16966E-07_JPRB, 1.13960E-07_JPRB, 1.11032E-07_JPRB, 1.08179E-07_JPRB, 1.05400E-07_JPRB, &
+     & 1.02691E-07_JPRB, 1.00053E-07_JPRB, 9.74820E-08_JPRB, 9.49772E-08_JPRB, 9.25368E-08_JPRB, &
+     & 9.01591E-08_JPRB, 8.78425E-08_JPRB, 8.55854E-08_JPRB, 8.33863E-08_JPRB, 8.12437E-08_JPRB, &
+     & 7.91562E-08_JPRB, 7.71223E-08_JPRB, 7.51407E-08_JPRB, 7.32100E-08_JPRB/)
+      KAO_MCO2(:,14) = (/ &
+     & 9.17853E-08_JPRB, 8.94322E-08_JPRB, 8.71395E-08_JPRB, 8.49055E-08_JPRB, 8.27289E-08_JPRB, &
+     & 8.06080E-08_JPRB, 7.85415E-08_JPRB, 7.65279E-08_JPRB, 7.45660E-08_JPRB, 7.26544E-08_JPRB, &
+     & 7.07918E-08_JPRB, 6.89770E-08_JPRB, 6.72086E-08_JPRB, 6.54856E-08_JPRB, 6.38068E-08_JPRB, &
+     & 6.21710E-08_JPRB, 6.05772E-08_JPRB, 5.90242E-08_JPRB, 5.75110E-08_JPRB/)
+      KAO_MCO2(:,15) = (/ &
+     & 8.34607E-08_JPRB, 8.13236E-08_JPRB, 7.92413E-08_JPRB, 7.72122E-08_JPRB, 7.52351E-08_JPRB, &
+     & 7.33087E-08_JPRB, 7.14315E-08_JPRB, 6.96025E-08_JPRB, 6.78202E-08_JPRB, 6.60837E-08_JPRB, &
+     & 6.43915E-08_JPRB, 6.27427E-08_JPRB, 6.11361E-08_JPRB, 5.95707E-08_JPRB, 5.80453E-08_JPRB, &
+     & 5.65590E-08_JPRB, 5.51108E-08_JPRB, 5.36996E-08_JPRB, 5.23246E-08_JPRB/)
+      KAO_MCO2(:,16) = (/ &
+     & 8.34607E-08_JPRB, 8.13236E-08_JPRB, 7.92413E-08_JPRB, 7.72122E-08_JPRB, 7.52351E-08_JPRB, &
+     & 7.33087E-08_JPRB, 7.14315E-08_JPRB, 6.96025E-08_JPRB, 6.78202E-08_JPRB, 6.60837E-08_JPRB, &
+     & 6.43915E-08_JPRB, 6.27427E-08_JPRB, 6.11361E-08_JPRB, 5.95707E-08_JPRB, 5.80453E-08_JPRB, &
+     & 5.65590E-08_JPRB, 5.51108E-08_JPRB, 5.36996E-08_JPRB, 5.23246E-08_JPRB/)
+
+      KAO_MO3(:, 1) = (/ &
+     & 1.18276E-01_JPRB, 1.18009E-01_JPRB, 1.17742E-01_JPRB, 1.17476E-01_JPRB, 1.17210E-01_JPRB, &
+     & 1.16945E-01_JPRB, 1.16681E-01_JPRB, 1.16417E-01_JPRB, 1.16153E-01_JPRB, 1.15891E-01_JPRB, &
+     & 1.15629E-01_JPRB, 1.15367E-01_JPRB, 1.15106E-01_JPRB, 1.14846E-01_JPRB, 1.14586E-01_JPRB, &
+     & 1.14327E-01_JPRB, 1.14069E-01_JPRB, 1.13811E-01_JPRB, 1.13553E-01_JPRB/)
+      KAO_MO3(:, 2) = (/ &
+     & 1.83777E-01_JPRB, 1.84268E-01_JPRB, 1.84761E-01_JPRB, 1.85255E-01_JPRB, 1.85751E-01_JPRB, &
+     & 1.86248E-01_JPRB, 1.86746E-01_JPRB, 1.87245E-01_JPRB, 1.87746E-01_JPRB, 1.88248E-01_JPRB, &
+     & 1.88752E-01_JPRB, 1.89257E-01_JPRB, 1.89763E-01_JPRB, 1.90270E-01_JPRB, 1.90779E-01_JPRB, &
+     & 1.91290E-01_JPRB, 1.91801E-01_JPRB, 1.92314E-01_JPRB, 1.92829E-01_JPRB/)
+      KAO_MO3(:, 3) = (/ &
+     & 2.33414E-01_JPRB, 2.34511E-01_JPRB, 2.35614E-01_JPRB, 2.36722E-01_JPRB, 2.37836E-01_JPRB, &
+     & 2.38954E-01_JPRB, 2.40078E-01_JPRB, 2.41207E-01_JPRB, 2.42342E-01_JPRB, 2.43481E-01_JPRB, &
+     & 2.44626E-01_JPRB, 2.45777E-01_JPRB, 2.46933E-01_JPRB, 2.48094E-01_JPRB, 2.49261E-01_JPRB, &
+     & 2.50433E-01_JPRB, 2.51611E-01_JPRB, 2.52794E-01_JPRB, 2.53983E-01_JPRB/)
+      KAO_MO3(:, 4) = (/ &
+     & 2.84906E-01_JPRB, 2.87358E-01_JPRB, 2.89832E-01_JPRB, 2.92328E-01_JPRB, 2.94844E-01_JPRB, &
+     & 2.97383E-01_JPRB, 2.99943E-01_JPRB, 3.02525E-01_JPRB, 3.05130E-01_JPRB, 3.07757E-01_JPRB, &
+     & 3.10406E-01_JPRB, 3.13078E-01_JPRB, 3.15774E-01_JPRB, 3.18492E-01_JPRB, 3.21234E-01_JPRB, &
+     & 3.24000E-01_JPRB, 3.26789E-01_JPRB, 3.29603E-01_JPRB, 3.32440E-01_JPRB/)
+      KAO_MO3(:, 5) = (/ &
+     & 3.40508E-01_JPRB, 3.44095E-01_JPRB, 3.47720E-01_JPRB, 3.51383E-01_JPRB, 3.55084E-01_JPRB, &
+     & 3.58824E-01_JPRB, 3.62604E-01_JPRB, 3.66424E-01_JPRB, 3.70284E-01_JPRB, 3.74184E-01_JPRB, &
+     & 3.78126E-01_JPRB, 3.82109E-01_JPRB, 3.86134E-01_JPRB, 3.90202E-01_JPRB, 3.94312E-01_JPRB, &
+     & 3.98466E-01_JPRB, 4.02663E-01_JPRB, 4.06905E-01_JPRB, 4.11191E-01_JPRB/)
+      KAO_MO3(:, 6) = (/ &
+     & 3.78368E-01_JPRB, 3.83690E-01_JPRB, 3.89086E-01_JPRB, 3.94558E-01_JPRB, 4.00107E-01_JPRB, &
+     & 4.05735E-01_JPRB, 4.11441E-01_JPRB, 4.17227E-01_JPRB, 4.23095E-01_JPRB, 4.29046E-01_JPRB, &
+     & 4.35080E-01_JPRB, 4.41199E-01_JPRB, 4.47404E-01_JPRB, 4.53697E-01_JPRB, 4.60078E-01_JPRB, &
+     & 4.66548E-01_JPRB, 4.73110E-01_JPRB, 4.79764E-01_JPRB, 4.86511E-01_JPRB/)
+      KAO_MO3(:, 7) = (/ &
+     & 4.51965E-01_JPRB, 4.58461E-01_JPRB, 4.65051E-01_JPRB, 4.71735E-01_JPRB, 4.78516E-01_JPRB, &
+     & 4.85394E-01_JPRB, 4.92371E-01_JPRB, 4.99448E-01_JPRB, 5.06627E-01_JPRB, 5.13909E-01_JPRB, &
+     & 5.21296E-01_JPRB, 5.28789E-01_JPRB, 5.36390E-01_JPRB, 5.44100E-01_JPRB, 5.51920E-01_JPRB, &
+     & 5.59854E-01_JPRB, 5.67901E-01_JPRB, 5.76064E-01_JPRB, 5.84344E-01_JPRB/)
+      KAO_MO3(:, 8) = (/ &
+     & 3.00557E-01_JPRB, 3.03974E-01_JPRB, 3.07430E-01_JPRB, 3.10925E-01_JPRB, 3.14460E-01_JPRB, &
+     & 3.18035E-01_JPRB, 3.21651E-01_JPRB, 3.25307E-01_JPRB, 3.29006E-01_JPRB, 3.32746E-01_JPRB, &
+     & 3.36529E-01_JPRB, 3.40355E-01_JPRB, 3.44224E-01_JPRB, 3.48137E-01_JPRB, 3.52095E-01_JPRB, &
+     & 3.56098E-01_JPRB, 3.60146E-01_JPRB, 3.64241E-01_JPRB, 3.68381E-01_JPRB/)
+      KAO_MO3(:, 9) = (/ &
+     & 2.10042E-01_JPRB, 2.12905E-01_JPRB, 2.15806E-01_JPRB, 2.18748E-01_JPRB, 2.21729E-01_JPRB, &
+     & 2.24751E-01_JPRB, 2.27814E-01_JPRB, 2.30919E-01_JPRB, 2.34066E-01_JPRB, 2.37256E-01_JPRB, &
+     & 2.40489E-01_JPRB, 2.43767E-01_JPRB, 2.47089E-01_JPRB, 2.50457E-01_JPRB, 2.53870E-01_JPRB, &
+     & 2.57330E-01_JPRB, 2.60837E-01_JPRB, 2.64392E-01_JPRB, 2.67996E-01_JPRB/)
+      KAO_MO3(:,10) = (/ &
+     & 2.09288E-01_JPRB, 2.11759E-01_JPRB, 2.14259E-01_JPRB, 2.16789E-01_JPRB, 2.19349E-01_JPRB, &
+     & 2.21939E-01_JPRB, 2.24559E-01_JPRB, 2.27210E-01_JPRB, 2.29893E-01_JPRB, 2.32607E-01_JPRB, &
+     & 2.35354E-01_JPRB, 2.38133E-01_JPRB, 2.40944E-01_JPRB, 2.43789E-01_JPRB, 2.46667E-01_JPRB, &
+     & 2.49580E-01_JPRB, 2.52527E-01_JPRB, 2.55508E-01_JPRB, 2.58525E-01_JPRB/)
+      KAO_MO3(:,11) = (/ &
+     & 2.28947E-01_JPRB, 2.30609E-01_JPRB, 2.32283E-01_JPRB, 2.33969E-01_JPRB, 2.35667E-01_JPRB, &
+     & 2.37378E-01_JPRB, 2.39101E-01_JPRB, 2.40836E-01_JPRB, 2.42584E-01_JPRB, 2.44345E-01_JPRB, &
+     & 2.46118E-01_JPRB, 2.47905E-01_JPRB, 2.49704E-01_JPRB, 2.51516E-01_JPRB, 2.53342E-01_JPRB, &
+     & 2.55181E-01_JPRB, 2.57033E-01_JPRB, 2.58899E-01_JPRB, 2.60778E-01_JPRB/)
+      KAO_MO3(:,12) = (/ &
+     & 2.57263E-01_JPRB, 2.58272E-01_JPRB, 2.59285E-01_JPRB, 2.60302E-01_JPRB, 2.61323E-01_JPRB, &
+     & 2.62347E-01_JPRB, 2.63376E-01_JPRB, 2.64409E-01_JPRB, 2.65446E-01_JPRB, 2.66487E-01_JPRB, &
+     & 2.67532E-01_JPRB, 2.68581E-01_JPRB, 2.69635E-01_JPRB, 2.70692E-01_JPRB, 2.71753E-01_JPRB, &
+     & 2.72819E-01_JPRB, 2.73889E-01_JPRB, 2.74963E-01_JPRB, 2.76042E-01_JPRB/)
+      KAO_MO3(:,13) = (/ &
+     & 2.43322E-01_JPRB, 2.45918E-01_JPRB, 2.48541E-01_JPRB, 2.51192E-01_JPRB, 2.53872E-01_JPRB, &
+     & 2.56580E-01_JPRB, 2.59317E-01_JPRB, 2.62083E-01_JPRB, 2.64879E-01_JPRB, 2.67704E-01_JPRB, &
+     & 2.70560E-01_JPRB, 2.73446E-01_JPRB, 2.76363E-01_JPRB, 2.79311E-01_JPRB, 2.82290E-01_JPRB, &
+     & 2.85302E-01_JPRB, 2.88345E-01_JPRB, 2.91421E-01_JPRB, 2.94529E-01_JPRB/)
+      KAO_MO3(:,14) = (/ &
+     & 2.10568E-01_JPRB, 2.16529E-01_JPRB, 2.22660E-01_JPRB, 2.28964E-01_JPRB, 2.35446E-01_JPRB, &
+     & 2.42113E-01_JPRB, 2.48967E-01_JPRB, 2.56016E-01_JPRB, 2.63265E-01_JPRB, 2.70719E-01_JPRB, &
+     & 2.78383E-01_JPRB, 2.86265E-01_JPRB, 2.94370E-01_JPRB, 3.02704E-01_JPRB, 3.11275E-01_JPRB, &
+     & 3.20088E-01_JPRB, 3.29150E-01_JPRB, 3.38470E-01_JPRB, 3.48052E-01_JPRB/)
+      KAO_MO3(:,15) = (/ &
+     & 2.60406E-02_JPRB, 2.78779E-02_JPRB, 2.98448E-02_JPRB, 3.19505E-02_JPRB, 3.42048E-02_JPRB, &
+     & 3.66181E-02_JPRB, 3.92017E-02_JPRB, 4.19675E-02_JPRB, 4.49285E-02_JPRB, 4.80985E-02_JPRB, &
+     & 5.14920E-02_JPRB, 5.51250E-02_JPRB, 5.90143E-02_JPRB, 6.31781E-02_JPRB, 6.76356E-02_JPRB, &
+     & 7.24076E-02_JPRB, 7.75163E-02_JPRB, 8.29854E-02_JPRB, 8.88404E-02_JPRB/)
+      KAO_MO3(:,16) = (/ &
+     & 2.31483E-02_JPRB, 2.46840E-02_JPRB, 2.63217E-02_JPRB, 2.80681E-02_JPRB, 2.99302E-02_JPRB, &
+     & 3.19160E-02_JPRB, 3.40335E-02_JPRB, 3.62914E-02_JPRB, 3.86992E-02_JPRB, 4.12668E-02_JPRB, &
+     & 4.40046E-02_JPRB, 4.69242E-02_JPRB, 5.00374E-02_JPRB, 5.33571E-02_JPRB, 5.68971E-02_JPRB, &
+     & 6.06720E-02_JPRB, 6.46974E-02_JPRB, 6.89897E-02_JPRB, 7.35669E-02_JPRB/)
+
+      KAO_MN2O(:, 1) = (/ &
+     & 3.02276E-02_JPRB, 3.10321E-02_JPRB, 3.18580E-02_JPRB, 3.27059E-02_JPRB, 3.35764E-02_JPRB, &
+     & 3.44700E-02_JPRB, 3.53875E-02_JPRB, 3.63293E-02_JPRB, 3.72962E-02_JPRB, 3.82889E-02_JPRB, &
+     & 3.93079E-02_JPRB, 4.03541E-02_JPRB, 4.14281E-02_JPRB, 4.25307E-02_JPRB, 4.36627E-02_JPRB, &
+     & 4.48248E-02_JPRB, 4.60178E-02_JPRB, 4.72425E-02_JPRB, 4.84999E-02_JPRB/)
+      KAO_MN2O(:, 2) = (/ &
+     & 6.10132E-02_JPRB, 6.17435E-02_JPRB, 6.24825E-02_JPRB, 6.32304E-02_JPRB, 6.39872E-02_JPRB, &
+     & 6.47531E-02_JPRB, 6.55281E-02_JPRB, 6.63124E-02_JPRB, 6.71061E-02_JPRB, 6.79093E-02_JPRB, &
+     & 6.87221E-02_JPRB, 6.95446E-02_JPRB, 7.03770E-02_JPRB, 7.12194E-02_JPRB, 7.20718E-02_JPRB, &
+     & 7.29344E-02_JPRB, 7.38074E-02_JPRB, 7.46908E-02_JPRB, 7.55848E-02_JPRB/)
+      KAO_MN2O(:, 3) = (/ &
+     & 1.04479E-01_JPRB, 1.05566E-01_JPRB, 1.06664E-01_JPRB, 1.07774E-01_JPRB, 1.08895E-01_JPRB, &
+     & 1.10028E-01_JPRB, 1.11173E-01_JPRB, 1.12329E-01_JPRB, 1.13498E-01_JPRB, 1.14679E-01_JPRB, &
+     & 1.15872E-01_JPRB, 1.17077E-01_JPRB, 1.18295E-01_JPRB, 1.19526E-01_JPRB, 1.20770E-01_JPRB, &
+     & 1.22026E-01_JPRB, 1.23296E-01_JPRB, 1.24578E-01_JPRB, 1.25875E-01_JPRB/)
+      KAO_MN2O(:, 4) = (/ &
+     & 2.07260E-01_JPRB, 2.08126E-01_JPRB, 2.08996E-01_JPRB, 2.09869E-01_JPRB, 2.10746E-01_JPRB, &
+     & 2.11627E-01_JPRB, 2.12511E-01_JPRB, 2.13399E-01_JPRB, 2.14291E-01_JPRB, 2.15187E-01_JPRB, &
+     & 2.16086E-01_JPRB, 2.16989E-01_JPRB, 2.17896E-01_JPRB, 2.18807E-01_JPRB, 2.19721E-01_JPRB, &
+     & 2.20640E-01_JPRB, 2.21562E-01_JPRB, 2.22488E-01_JPRB, 2.23418E-01_JPRB/)
+      KAO_MN2O(:, 5) = (/ &
+     & 3.71566E-01_JPRB, 3.71353E-01_JPRB, 3.71141E-01_JPRB, 3.70928E-01_JPRB, 3.70716E-01_JPRB, &
+     & 3.70504E-01_JPRB, 3.70292E-01_JPRB, 3.70080E-01_JPRB, 3.69869E-01_JPRB, 3.69657E-01_JPRB, &
+     & 3.69446E-01_JPRB, 3.69234E-01_JPRB, 3.69023E-01_JPRB, 3.68812E-01_JPRB, 3.68601E-01_JPRB, &
+     & 3.68390E-01_JPRB, 3.68179E-01_JPRB, 3.67969E-01_JPRB, 3.67758E-01_JPRB/)
+      KAO_MN2O(:, 6) = (/ &
+     & 5.28092E-01_JPRB, 5.27262E-01_JPRB, 5.26433E-01_JPRB, 5.25605E-01_JPRB, 5.24779E-01_JPRB, &
+     & 5.23954E-01_JPRB, 5.23130E-01_JPRB, 5.22307E-01_JPRB, 5.21486E-01_JPRB, 5.20666E-01_JPRB, &
+     & 5.19847E-01_JPRB, 5.19030E-01_JPRB, 5.18214E-01_JPRB, 5.17399E-01_JPRB, 5.16586E-01_JPRB, &
+     & 5.15773E-01_JPRB, 5.14962E-01_JPRB, 5.14153E-01_JPRB, 5.13344E-01_JPRB/)
+      KAO_MN2O(:, 7) = (/ &
+     & 3.88140E-01_JPRB, 3.87956E-01_JPRB, 3.87773E-01_JPRB, 3.87590E-01_JPRB, 3.87407E-01_JPRB, &
+     & 3.87224E-01_JPRB, 3.87041E-01_JPRB, 3.86858E-01_JPRB, 3.86675E-01_JPRB, 3.86492E-01_JPRB, &
+     & 3.86310E-01_JPRB, 3.86127E-01_JPRB, 3.85945E-01_JPRB, 3.85763E-01_JPRB, 3.85580E-01_JPRB, &
+     & 3.85398E-01_JPRB, 3.85216E-01_JPRB, 3.85034E-01_JPRB, 3.84852E-01_JPRB/)
+      KAO_MN2O(:, 8) = (/ &
+     & 3.12991E-01_JPRB, 3.12246E-01_JPRB, 3.11504E-01_JPRB, 3.10763E-01_JPRB, 3.10024E-01_JPRB, &
+     & 3.09287E-01_JPRB, 3.08552E-01_JPRB, 3.07818E-01_JPRB, 3.07086E-01_JPRB, 3.06356E-01_JPRB, &
+     & 3.05628E-01_JPRB, 3.04901E-01_JPRB, 3.04176E-01_JPRB, 3.03453E-01_JPRB, 3.02732E-01_JPRB, &
+     & 3.02012E-01_JPRB, 3.01294E-01_JPRB, 3.00577E-01_JPRB, 2.99863E-01_JPRB/)
+      KAO_MN2O(:, 9) = (/ &
+     & 4.11761E-01_JPRB, 4.11309E-01_JPRB, 4.10858E-01_JPRB, 4.10407E-01_JPRB, 4.09957E-01_JPRB, &
+     & 4.09507E-01_JPRB, 4.09057E-01_JPRB, 4.08608E-01_JPRB, 4.08160E-01_JPRB, 4.07712E-01_JPRB, &
+     & 4.07265E-01_JPRB, 4.06818E-01_JPRB, 4.06371E-01_JPRB, 4.05925E-01_JPRB, 4.05480E-01_JPRB, &
+     & 4.05035E-01_JPRB, 4.04590E-01_JPRB, 4.04146E-01_JPRB, 4.03703E-01_JPRB/)
+      KAO_MN2O(:,10) = (/ &
+     & 2.84648E-01_JPRB, 2.87025E-01_JPRB, 2.89421E-01_JPRB, 2.91838E-01_JPRB, 2.94275E-01_JPRB, &
+     & 2.96732E-01_JPRB, 2.99210E-01_JPRB, 3.01708E-01_JPRB, 3.04227E-01_JPRB, 3.06768E-01_JPRB, &
+     & 3.09329E-01_JPRB, 3.11912E-01_JPRB, 3.14517E-01_JPRB, 3.17143E-01_JPRB, 3.19791E-01_JPRB, &
+     & 3.22461E-01_JPRB, 3.25154E-01_JPRB, 3.27869E-01_JPRB, 3.30606E-01_JPRB/)
+      KAO_MN2O(:,11) = (/ &
+     & 2.75090E-01_JPRB, 2.79370E-01_JPRB, 2.83716E-01_JPRB, 2.88129E-01_JPRB, 2.92611E-01_JPRB, &
+     & 2.97163E-01_JPRB, 3.01786E-01_JPRB, 3.06480E-01_JPRB, 3.11248E-01_JPRB, 3.16090E-01_JPRB, &
+     & 3.21007E-01_JPRB, 3.26001E-01_JPRB, 3.31072E-01_JPRB, 3.36222E-01_JPRB, 3.41452E-01_JPRB, &
+     & 3.46764E-01_JPRB, 3.52158E-01_JPRB, 3.57636E-01_JPRB, 3.63200E-01_JPRB/)
+      KAO_MN2O(:,12) = (/ &
+     & 1.67753E-01_JPRB, 1.71386E-01_JPRB, 1.75098E-01_JPRB, 1.78890E-01_JPRB, 1.82765E-01_JPRB, &
+     & 1.86723E-01_JPRB, 1.90767E-01_JPRB, 1.94899E-01_JPRB, 1.99120E-01_JPRB, 2.03433E-01_JPRB, &
+     & 2.07839E-01_JPRB, 2.12340E-01_JPRB, 2.16939E-01_JPRB, 2.21638E-01_JPRB, 2.26438E-01_JPRB, &
+     & 2.31342E-01_JPRB, 2.36353E-01_JPRB, 2.41472E-01_JPRB, 2.46701E-01_JPRB/)
+      KAO_MN2O(:,13) = (/ &
+     & 1.40543E-01_JPRB, 1.42049E-01_JPRB, 1.43571E-01_JPRB, 1.45109E-01_JPRB, 1.46663E-01_JPRB, &
+     & 1.48234E-01_JPRB, 1.49822E-01_JPRB, 1.51427E-01_JPRB, 1.53049E-01_JPRB, 1.54689E-01_JPRB, &
+     & 1.56346E-01_JPRB, 1.58021E-01_JPRB, 1.59713E-01_JPRB, 1.61424E-01_JPRB, 1.63153E-01_JPRB, &
+     & 1.64901E-01_JPRB, 1.66668E-01_JPRB, 1.68453E-01_JPRB, 1.70258E-01_JPRB/)
+      KAO_MN2O(:,14) = (/ &
+     & 1.51530E-01_JPRB, 1.50944E-01_JPRB, 1.50360E-01_JPRB, 1.49779E-01_JPRB, 1.49199E-01_JPRB, &
+     & 1.48622E-01_JPRB, 1.48047E-01_JPRB, 1.47474E-01_JPRB, 1.46903E-01_JPRB, 1.46335E-01_JPRB, &
+     & 1.45769E-01_JPRB, 1.45205E-01_JPRB, 1.44643E-01_JPRB, 1.44083E-01_JPRB, 1.43526E-01_JPRB, &
+     & 1.42971E-01_JPRB, 1.42418E-01_JPRB, 1.41867E-01_JPRB, 1.41318E-01_JPRB/)
+      KAO_MN2O(:,15) = (/ &
+     & 2.20492E-01_JPRB, 2.16479E-01_JPRB, 2.12539E-01_JPRB, 2.08671E-01_JPRB, 2.04873E-01_JPRB, &
+     & 2.01145E-01_JPRB, 1.97484E-01_JPRB, 1.93890E-01_JPRB, 1.90361E-01_JPRB, 1.86897E-01_JPRB, &
+     & 1.83495E-01_JPRB, 1.80156E-01_JPRB, 1.76877E-01_JPRB, 1.73658E-01_JPRB, 1.70497E-01_JPRB, &
+     & 1.67394E-01_JPRB, 1.64348E-01_JPRB, 1.61356E-01_JPRB, 1.58420E-01_JPRB/)
+      KAO_MN2O(:,16) = (/ &
+     & 2.19848E-01_JPRB, 2.15847E-01_JPRB, 2.11919E-01_JPRB, 2.08062E-01_JPRB, 2.04275E-01_JPRB, &
+     & 2.00558E-01_JPRB, 1.96908E-01_JPRB, 1.93324E-01_JPRB, 1.89806E-01_JPRB, 1.86351E-01_JPRB, &
+     & 1.82960E-01_JPRB, 1.79630E-01_JPRB, 1.76361E-01_JPRB, 1.73151E-01_JPRB, 1.70000E-01_JPRB, &
+     & 1.66906E-01_JPRB, 1.63868E-01_JPRB, 1.60886E-01_JPRB, 1.57958E-01_JPRB/)
+
+!     The array KBO_Mxx contains the absorption coefficient for 
+!     a minor species at the 16 chosen g-values for a reference pressure
+!     level above 100~ mb.   The first index refers to temperature 
+!     in 7.2 degree increments.  For instance, JT = 1 refers to a 
+!     temperature of 188.0, JT = 2 refers to 195.2, etc. The second index 
+!     runs over the g-channel (1 to 16).
+
+      KBO_MCO2(:, 1) = (/ &
+     & 4.74280E-08_JPRB, 6.62724E-08_JPRB, 9.26042E-08_JPRB, 1.29398E-07_JPRB, 1.80812E-07_JPRB, &
+     & 2.52653E-07_JPRB, 3.53039E-07_JPRB, 4.93310E-07_JPRB, 6.89316E-07_JPRB, 9.63198E-07_JPRB, &
+     & 1.34590E-06_JPRB, 1.88067E-06_JPRB, 2.62790E-06_JPRB, 3.67204E-06_JPRB, 5.13104E-06_JPRB, &
+     & 7.16974E-06_JPRB, 1.00185E-05_JPRB, 1.39991E-05_JPRB, 1.95613E-05_JPRB/)
+      KBO_MCO2(:, 2) = (/ &
+     & 1.14872E-07_JPRB, 1.63356E-07_JPRB, 2.32304E-07_JPRB, 3.30352E-07_JPRB, 4.69783E-07_JPRB, &
+     & 6.68064E-07_JPRB, 9.50033E-07_JPRB, 1.35101E-06_JPRB, 1.92123E-06_JPRB, 2.73213E-06_JPRB, &
+     & 3.88527E-06_JPRB, 5.52513E-06_JPRB, 7.85711E-06_JPRB, 1.11734E-05_JPRB, 1.58893E-05_JPRB, &
+     & 2.25957E-05_JPRB, 3.21326E-05_JPRB, 4.56948E-05_JPRB, 6.49811E-05_JPRB/)
+      KBO_MCO2(:, 3) = (/ &
+     & 3.30676E-07_JPRB, 4.76313E-07_JPRB, 6.86094E-07_JPRB, 9.88267E-07_JPRB, 1.42353E-06_JPRB, &
+     & 2.05048E-06_JPRB, 2.95356E-06_JPRB, 4.25439E-06_JPRB, 6.12813E-06_JPRB, 8.82711E-06_JPRB, &
+     & 1.27148E-05_JPRB, 1.83147E-05_JPRB, 2.63810E-05_JPRB, 3.79998E-05_JPRB, 5.47359E-05_JPRB, &
+     & 7.88430E-05_JPRB, 1.13568E-04_JPRB, 1.63585E-04_JPRB, 2.35632E-04_JPRB/)
+      KBO_MCO2(:, 4) = (/ &
+     & 6.58642E-07_JPRB, 9.52761E-07_JPRB, 1.37822E-06_JPRB, 1.99368E-06_JPRB, 2.88396E-06_JPRB, &
+     & 4.17181E-06_JPRB, 6.03475E-06_JPRB, 8.72960E-06_JPRB, 1.26279E-05_JPRB, 1.82669E-05_JPRB, &
+     & 2.64241E-05_JPRB, 3.82239E-05_JPRB, 5.52929E-05_JPRB, 7.99844E-05_JPRB, 1.15702E-04_JPRB, &
+     & 1.67369E-04_JPRB, 2.42109E-04_JPRB, 3.50223E-04_JPRB, 5.06617E-04_JPRB/)
+      KBO_MCO2(:, 5) = (/ &
+     & 1.26418E-06_JPRB, 1.82095E-06_JPRB, 2.62292E-06_JPRB, 3.77810E-06_JPRB, 5.44204E-06_JPRB, &
+     & 7.83881E-06_JPRB, 1.12911E-05_JPRB, 1.62640E-05_JPRB, 2.34269E-05_JPRB, 3.37445E-05_JPRB, &
+     & 4.86061E-05_JPRB, 7.00131E-05_JPRB, 1.00848E-04_JPRB, 1.45263E-04_JPRB, 2.09239E-04_JPRB, &
+     & 3.01392E-04_JPRB, 4.34131E-04_JPRB, 6.25329E-04_JPRB, 9.00733E-04_JPRB/)
+      KBO_MCO2(:, 6) = (/ &
+     & 2.38529E-06_JPRB, 3.43110E-06_JPRB, 4.93545E-06_JPRB, 7.09937E-06_JPRB, 1.02120E-05_JPRB, &
+     & 1.46895E-05_JPRB, 2.11300E-05_JPRB, 3.03943E-05_JPRB, 4.37205E-05_JPRB, 6.28894E-05_JPRB, &
+     & 9.04630E-05_JPRB, 1.30126E-04_JPRB, 1.87179E-04_JPRB, 2.69247E-04_JPRB, 3.87296E-04_JPRB, &
+     & 5.57104E-04_JPRB, 8.01364E-04_JPRB, 1.15272E-03_JPRB, 1.65812E-03_JPRB/)
+      KBO_MCO2(:, 7) = (/ &
+     & 5.41398E-06_JPRB, 7.54295E-06_JPRB, 1.05091E-05_JPRB, 1.46417E-05_JPRB, 2.03993E-05_JPRB, &
+     & 2.84211E-05_JPRB, 3.95973E-05_JPRB, 5.51683E-05_JPRB, 7.68626E-05_JPRB, 1.07088E-04_JPRB, &
+     & 1.49199E-04_JPRB, 2.07869E-04_JPRB, 2.89610E-04_JPRB, 4.03496E-04_JPRB, 5.62165E-04_JPRB, &
+     & 7.83229E-04_JPRB, 1.09122E-03_JPRB, 1.52033E-03_JPRB, 2.11818E-03_JPRB/)
+      KBO_MCO2(:, 8) = (/ &
+     & 1.09995E-05_JPRB, 1.54018E-05_JPRB, 2.15660E-05_JPRB, 3.01973E-05_JPRB, 4.22831E-05_JPRB, &
+     & 5.92059E-05_JPRB, 8.29017E-05_JPRB, 1.16081E-04_JPRB, 1.62540E-04_JPRB, 2.27592E-04_JPRB, &
+     & 3.18681E-04_JPRB, 4.46226E-04_JPRB, 6.24817E-04_JPRB, 8.74886E-04_JPRB, 1.22504E-03_JPRB, &
+     & 1.71533E-03_JPRB, 2.40185E-03_JPRB, 3.36313E-03_JPRB, 4.70915E-03_JPRB/)
+      KBO_MCO2(:, 9) = (/ &
+     & 3.29051E-05_JPRB, 4.59996E-05_JPRB, 6.43050E-05_JPRB, 8.98950E-05_JPRB, 1.25668E-04_JPRB, &
+     & 1.75678E-04_JPRB, 2.45588E-04_JPRB, 3.43319E-04_JPRB, 4.79942E-04_JPRB, 6.70933E-04_JPRB, &
+     & 9.37930E-04_JPRB, 1.31118E-03_JPRB, 1.83295E-03_JPRB, 2.56237E-03_JPRB, 3.58206E-03_JPRB, &
+     & 5.00753E-03_JPRB, 7.00027E-03_JPRB, 9.78599E-03_JPRB, 1.36803E-02_JPRB/)
+      KBO_MCO2(:,10) = (/ &
+     & 1.95126E-05_JPRB, 2.65944E-05_JPRB, 3.62463E-05_JPRB, 4.94013E-05_JPRB, 6.73305E-05_JPRB, &
+     & 9.17669E-05_JPRB, 1.25072E-04_JPRB, 1.70465E-04_JPRB, 2.32332E-04_JPRB, 3.16652E-04_JPRB, &
+     & 4.31575E-04_JPRB, 5.88208E-04_JPRB, 8.01687E-04_JPRB, 1.09264E-03_JPRB, 1.48920E-03_JPRB, &
+     & 2.02968E-03_JPRB, 2.76631E-03_JPRB, 3.77029E-03_JPRB, 5.13865E-03_JPRB/)
+      KBO_MCO2(:,11) = (/ &
+     & 8.67271E-05_JPRB, 1.19228E-04_JPRB, 1.63908E-04_JPRB, 2.25332E-04_JPRB, 3.09774E-04_JPRB, &
+     & 4.25860E-04_JPRB, 5.85450E-04_JPRB, 8.04845E-04_JPRB, 1.10646E-03_JPRB, 1.52110E-03_JPRB, &
+     & 2.09112E-03_JPRB, 2.87476E-03_JPRB, 3.95207E-03_JPRB, 5.43309E-03_JPRB, 7.46911E-03_JPRB, &
+     & 1.02681E-02_JPRB, 1.41161E-02_JPRB, 1.94060E-02_JPRB, 2.66783E-02_JPRB/)
+      KBO_MCO2(:,12) = (/ &
+     & 3.79194E-07_JPRB, 5.51419E-07_JPRB, 8.01866E-07_JPRB, 1.16606E-06_JPRB, 1.69567E-06_JPRB, &
+     & 2.46582E-06_JPRB, 3.58577E-06_JPRB, 5.21438E-06_JPRB, 7.58268E-06_JPRB, 1.10266E-05_JPRB, &
+     & 1.60348E-05_JPRB, 2.33176E-05_JPRB, 3.39081E-05_JPRB, 4.93087E-05_JPRB, 7.17040E-05_JPRB, &
+     & 1.04271E-04_JPRB, 1.51630E-04_JPRB, 2.20498E-04_JPRB, 3.20644E-04_JPRB/)
+      KBO_MCO2(:,13) = (/ &
+     & 1.72555E-07_JPRB, 2.29952E-07_JPRB, 3.06441E-07_JPRB, 4.08373E-07_JPRB, 5.44209E-07_JPRB, &
+     & 7.25229E-07_JPRB, 9.66461E-07_JPRB, 1.28793E-06_JPRB, 1.71634E-06_JPRB, 2.28724E-06_JPRB, &
+     & 3.04805E-06_JPRB, 4.06192E-06_JPRB, 5.41303E-06_JPRB, 7.21356E-06_JPRB, 9.61299E-06_JPRB, &
+     & 1.28106E-05_JPRB, 1.70717E-05_JPRB, 2.27503E-05_JPRB, 3.03177E-05_JPRB/)
+      KBO_MCO2(:,14) = (/ &
+     & 7.42245E-09_JPRB, 7.17780E-09_JPRB, 6.94122E-09_JPRB, 6.71243E-09_JPRB, 6.49118E-09_JPRB, &
+     & 6.27723E-09_JPRB, 6.07032E-09_JPRB, 5.87024E-09_JPRB, 5.67675E-09_JPRB, 5.48964E-09_JPRB, &
+     & 5.30870E-09_JPRB, 5.13372E-09_JPRB, 4.96451E-09_JPRB, 4.80087E-09_JPRB, 4.64263E-09_JPRB, &
+     & 4.48961E-09_JPRB, 4.34163E-09_JPRB, 4.19852E-09_JPRB, 4.06014E-09_JPRB/)
+      KBO_MCO2(:,15) = (/ &
+     & 7.41847E-09_JPRB, 7.17332E-09_JPRB, 6.93627E-09_JPRB, 6.70705E-09_JPRB, 6.48541E-09_JPRB, &
+     & 6.27109E-09_JPRB, 6.06386E-09_JPRB, 5.86347E-09_JPRB, 5.66970E-09_JPRB, 5.48234E-09_JPRB, &
+     & 5.30117E-09_JPRB, 5.12599E-09_JPRB, 4.95659E-09_JPRB, 4.79280E-09_JPRB, 4.63441E-09_JPRB, &
+     & 4.48126E-09_JPRB, 4.33317E-09_JPRB, 4.18998E-09_JPRB, 4.05152E-09_JPRB/)
+      KBO_MCO2(:,16) = (/ &
+     & 7.42855E-09_JPRB, 7.18278E-09_JPRB, 6.94513E-09_JPRB, 6.71535E-09_JPRB, 6.49317E-09_JPRB, &
+     & 6.27834E-09_JPRB, 6.07062E-09_JPRB, 5.86977E-09_JPRB, 5.67557E-09_JPRB, 5.48779E-09_JPRB, &
+     & 5.30622E-09_JPRB, 5.13066E-09_JPRB, 4.96091E-09_JPRB, 4.79678E-09_JPRB, 4.63808E-09_JPRB, &
+     & 4.48462E-09_JPRB, 4.33625E-09_JPRB, 4.19278E-09_JPRB, 4.05406E-09_JPRB/)
+
+      KBO_MN2O(:, 1) = (/ &
+     & 2.49055E-04_JPRB, 2.53574E-04_JPRB, 2.58175E-04_JPRB, 2.62860E-04_JPRB, 2.67629E-04_JPRB, &
+     & 2.72485E-04_JPRB, 2.77429E-04_JPRB, 2.82463E-04_JPRB, 2.87588E-04_JPRB, 2.92806E-04_JPRB, &
+     & 2.98119E-04_JPRB, 3.03528E-04_JPRB, 3.09036E-04_JPRB, 3.14643E-04_JPRB, 3.20352E-04_JPRB, &
+     & 3.26165E-04_JPRB, 3.32083E-04_JPRB, 3.38109E-04_JPRB, 3.44243E-04_JPRB/)
+      KBO_MN2O(:, 2) = (/ &
+     & 3.79251E-04_JPRB, 4.04353E-04_JPRB, 4.31117E-04_JPRB, 4.59652E-04_JPRB, 4.90075E-04_JPRB, &
+     & 5.22513E-04_JPRB, 5.57097E-04_JPRB, 5.93970E-04_JPRB, 6.33284E-04_JPRB, 6.75200E-04_JPRB, &
+     & 7.19890E-04_JPRB, 7.67539E-04_JPRB, 8.18340E-04_JPRB, 8.72505E-04_JPRB, 9.30255E-04_JPRB, &
+     & 9.91827E-04_JPRB, 1.05747E-03_JPRB, 1.12747E-03_JPRB, 1.20209E-03_JPRB/)
+      KBO_MN2O(:, 3) = (/ &
+     & 7.61140E-04_JPRB, 8.36483E-04_JPRB, 9.19284E-04_JPRB, 1.01028E-03_JPRB, 1.11029E-03_JPRB, &
+     & 1.22019E-03_JPRB, 1.34098E-03_JPRB, 1.47372E-03_JPRB, 1.61959E-03_JPRB, 1.77991E-03_JPRB, &
+     & 1.95610E-03_JPRB, 2.14973E-03_JPRB, 2.36253E-03_JPRB, 2.59639E-03_JPRB, 2.85340E-03_JPRB, &
+     & 3.13585E-03_JPRB, 3.44626E-03_JPRB, 3.78740E-03_JPRB, 4.16230E-03_JPRB/)
+      KBO_MN2O(:, 4) = (/ &
+     & 2.01074E-03_JPRB, 2.26915E-03_JPRB, 2.56077E-03_JPRB, 2.88987E-03_JPRB, 3.26126E-03_JPRB, &
+     & 3.68038E-03_JPRB, 4.15337E-03_JPRB, 4.68714E-03_JPRB, 5.28951E-03_JPRB, 5.96929E-03_JPRB, &
+     & 6.73643E-03_JPRB, 7.60217E-03_JPRB, 8.57916E-03_JPRB, 9.68172E-03_JPRB, 1.09260E-02_JPRB, &
+     & 1.23301E-02_JPRB, 1.39147E-02_JPRB, 1.57030E-02_JPRB, 1.77211E-02_JPRB/)
+      KBO_MN2O(:, 5) = (/ &
+     & 7.43302E-03_JPRB, 8.32582E-03_JPRB, 9.32585E-03_JPRB, 1.04460E-02_JPRB, 1.17007E-02_JPRB, &
+     & 1.31061E-02_JPRB, 1.46803E-02_JPRB, 1.64436E-02_JPRB, 1.84186E-02_JPRB, 2.06309E-02_JPRB, &
+     & 2.31090E-02_JPRB, 2.58846E-02_JPRB, 2.89937E-02_JPRB, 3.24762E-02_JPRB, 3.63769E-02_JPRB, &
+     & 4.07463E-02_JPRB, 4.56404E-02_JPRB, 5.11223E-02_JPRB, 5.72627E-02_JPRB/)
+      KBO_MN2O(:, 6) = (/ &
+     & 2.71911E-02_JPRB, 2.94258E-02_JPRB, 3.18441E-02_JPRB, 3.44612E-02_JPRB, 3.72933E-02_JPRB, &
+     & 4.03582E-02_JPRB, 4.36750E-02_JPRB, 4.72644E-02_JPRB, 5.11487E-02_JPRB, 5.53523E-02_JPRB, &
+     & 5.99014E-02_JPRB, 6.48243E-02_JPRB, 7.01518E-02_JPRB, 7.59172E-02_JPRB, 8.21563E-02_JPRB, &
+     & 8.89082E-02_JPRB, 9.62150E-02_JPRB, 1.04122E-01_JPRB, 1.12679E-01_JPRB/)
+      KBO_MN2O(:, 7) = (/ &
+     & 1.63331E-01_JPRB, 1.80469E-01_JPRB, 1.99406E-01_JPRB, 2.20330E-01_JPRB, 2.43449E-01_JPRB, &
+     & 2.68995E-01_JPRB, 2.97221E-01_JPRB, 3.28408E-01_JPRB, 3.62869E-01_JPRB, 4.00945E-01_JPRB, &
+     & 4.43017E-01_JPRB, 4.89503E-01_JPRB, 5.40867E-01_JPRB, 5.97621E-01_JPRB, 6.60330E-01_JPRB, &
+     & 7.29619E-01_JPRB, 8.06179E-01_JPRB, 8.90772E-01_JPRB, 9.84242E-01_JPRB/)
+      KBO_MN2O(:, 8) = (/ &
+     & 1.32648E+00_JPRB, 1.33515E+00_JPRB, 1.34387E+00_JPRB, 1.35265E+00_JPRB, 1.36149E+00_JPRB, &
+     & 1.37038E+00_JPRB, 1.37933E+00_JPRB, 1.38835E+00_JPRB, 1.39742E+00_JPRB, 1.40655E+00_JPRB, &
+     & 1.41574E+00_JPRB, 1.42499E+00_JPRB, 1.43429E+00_JPRB, 1.44367E+00_JPRB, 1.45310E+00_JPRB, &
+     & 1.46259E+00_JPRB, 1.47215E+00_JPRB, 1.48176E+00_JPRB, 1.49144E+00_JPRB/)
+      KBO_MN2O(:, 9) = (/ &
+     & 3.12620E+00_JPRB, 3.03118E+00_JPRB, 2.93905E+00_JPRB, 2.84972E+00_JPRB, 2.76310E+00_JPRB, &
+     & 2.67911E+00_JPRB, 2.59768E+00_JPRB, 2.51873E+00_JPRB, 2.44217E+00_JPRB, 2.36794E+00_JPRB, &
+     & 2.29596E+00_JPRB, 2.22618E+00_JPRB, 2.15851E+00_JPRB, 2.09290E+00_JPRB, 2.02929E+00_JPRB, &
+     & 1.96761E+00_JPRB, 1.90780E+00_JPRB, 1.84982E+00_JPRB, 1.79359E+00_JPRB/)
+      KBO_MN2O(:,10) = (/ &
+     & 1.60677E-02_JPRB, 1.82485E-02_JPRB, 2.07254E-02_JPRB, 2.35384E-02_JPRB, 2.67332E-02_JPRB, &
+     & 3.03617E-02_JPRB, 3.44827E-02_JPRB, 3.91629E-02_JPRB, 4.44785E-02_JPRB, 5.05154E-02_JPRB, &
+     & 5.73718E-02_JPRB, 6.51589E-02_JPRB, 7.40027E-02_JPRB, 8.40470E-02_JPRB, 9.54546E-02_JPRB, &
+     & 1.08411E-01_JPRB, 1.23125E-01_JPRB, 1.39836E-01_JPRB, 1.58816E-01_JPRB/)
+      KBO_MN2O(:,11) = (/ &
+     & 1.55287E-02_JPRB, 1.78265E-02_JPRB, 2.04642E-02_JPRB, 2.34922E-02_JPRB, 2.69683E-02_JPRB, &
+     & 3.09588E-02_JPRB, 3.55397E-02_JPRB, 4.07984E-02_JPRB, 4.68352E-02_JPRB, 5.37653E-02_JPRB, &
+     & 6.17208E-02_JPRB, 7.08535E-02_JPRB, 8.13375E-02_JPRB, 9.33728E-02_JPRB, 1.07189E-01_JPRB, &
+     & 1.23049E-01_JPRB, 1.41257E-01_JPRB, 1.62158E-01_JPRB, 1.86152E-01_JPRB/)
+      KBO_MN2O(:,12) = (/ &
+     & 7.13719E-03_JPRB, 8.18879E-03_JPRB, 9.39535E-03_JPRB, 1.07797E-02_JPRB, 1.23680E-02_JPRB, &
+     & 1.41903E-02_JPRB, 1.62811E-02_JPRB, 1.86800E-02_JPRB, 2.14324E-02_JPRB, 2.45902E-02_JPRB, &
+     & 2.82134E-02_JPRB, 3.23704E-02_JPRB, 3.71400E-02_JPRB, 4.26122E-02_JPRB, 4.88908E-02_JPRB, &
+     & 5.60945E-02_JPRB, 6.43596E-02_JPRB, 7.38424E-02_JPRB, 8.47224E-02_JPRB/)
+      KBO_MN2O(:,13) = (/ &
+     & 9.28813E-03_JPRB, 1.06108E-02_JPRB, 1.21218E-02_JPRB, 1.38480E-02_JPRB, 1.58199E-02_JPRB, &
+     & 1.80727E-02_JPRB, 2.06463E-02_JPRB, 2.35864E-02_JPRB, 2.69452E-02_JPRB, 3.07822E-02_JPRB, &
+     & 3.51657E-02_JPRB, 4.01734E-02_JPRB, 4.58941E-02_JPRB, 5.24296E-02_JPRB, 5.98956E-02_JPRB, &
+     & 6.84249E-02_JPRB, 7.81688E-02_JPRB, 8.93002E-02_JPRB, 1.02017E-01_JPRB/)
+      KBO_MN2O(:,14) = (/ &
+     & 2.17205E-02_JPRB, 2.51661E-02_JPRB, 2.91581E-02_JPRB, 3.37835E-02_JPRB, 3.91425E-02_JPRB, &
+     & 4.53517E-02_JPRB, 5.25458E-02_JPRB, 6.08811E-02_JPRB, 7.05387E-02_JPRB, 8.17282E-02_JPRB, &
+     & 9.46927E-02_JPRB, 1.09714E-01_JPRB, 1.27118E-01_JPRB, 1.47282E-01_JPRB, 1.70645E-01_JPRB, &
+     & 1.97715E-01_JPRB, 2.29078E-01_JPRB, 2.65417E-01_JPRB, 3.07520E-01_JPRB/)
+      KBO_MN2O(:,15) = (/ &
+     & 4.89156E-02_JPRB, 5.70504E-02_JPRB, 6.65379E-02_JPRB, 7.76033E-02_JPRB, 9.05089E-02_JPRB, &
+     & 1.05561E-01_JPRB, 1.23116E-01_JPRB, 1.43590E-01_JPRB, 1.67469E-01_JPRB, 1.95320E-01_JPRB, &
+     & 2.27802E-01_JPRB, 2.65686E-01_JPRB, 3.09869E-01_JPRB, 3.61401E-01_JPRB, 4.21503E-01_JPRB, &
+     & 4.91600E-01_JPRB, 5.73354E-01_JPRB, 6.68703E-01_JPRB, 7.79910E-01_JPRB/)
+      KBO_MN2O(:,16) = (/ &
+     & 1.13156E-02_JPRB, 1.46199E-02_JPRB, 1.88891E-02_JPRB, 2.44050E-02_JPRB, 3.15316E-02_JPRB, &
+     & 4.07393E-02_JPRB, 5.26358E-02_JPRB, 6.80061E-02_JPRB, 8.78649E-02_JPRB, 1.13523E-01_JPRB, &
+     & 1.46673E-01_JPRB, 1.89504E-01_JPRB, 2.44841E-01_JPRB, 3.16338E-01_JPRB, 4.08713E-01_JPRB, &
+     & 5.28064E-01_JPRB, 6.82266E-01_JPRB, 8.81496E-01_JPRB, 1.13891E+00_JPRB/)
+
+!     The array FORREFO contains the coefficient of the water vapor
+!     foreign-continuum (including the energy term).  The first 
+!     index refers to reference temperature (296,260,224,260) and 
+!     pressure (970,475,219,3 mbar) levels.  The second index 
+!     runs over the g-channel (1 to 16).
+
+      FORREFO(1,:) = (/ &
+     &4.8166E-07_JPRB,3.7500E-07_JPRB,4.8978E-07_JPRB,5.9624E-07_JPRB,6.3742E-07_JPRB,7.5551E-07_JPRB, &
+     &7.7706E-07_JPRB,6.8681E-07_JPRB,7.5212E-07_JPRB,8.0956E-07_JPRB,7.8117E-07_JPRB,7.4835E-07_JPRB, &
+     &9.4118E-07_JPRB,1.2585E-06_JPRB,1.4976E-06_JPRB,1.4976E-06_JPRB/)
+      FORREFO(2,:) = (/ &
+     &3.1320E-07_JPRB,4.0764E-07_JPRB,4.7468E-07_JPRB,5.9976E-07_JPRB,7.3324E-07_JPRB,8.1488E-07_JPRB, &
+     &7.6442E-07_JPRB,8.2007E-07_JPRB,7.7721E-07_JPRB,7.6377E-07_JPRB,8.0327E-07_JPRB,7.1881E-07_JPRB, &
+     &8.2148E-07_JPRB,1.0203E-06_JPRB,1.5033E-06_JPRB,1.5032E-06_JPRB/)
+      FORREFO(3,:) = (/ &
+     &4.1831E-07_JPRB,5.5043E-07_JPRB,5.7783E-07_JPRB,6.1294E-07_JPRB,6.3396E-07_JPRB,6.2292E-07_JPRB, &
+     &6.1719E-07_JPRB,6.4183E-07_JPRB,7.6180E-07_JPRB,9.5477E-07_JPRB,9.5901E-07_JPRB,1.0207E-06_JPRB, &
+     &1.0387E-06_JPRB,1.1305E-06_JPRB,1.3602E-06_JPRB,1.5063E-06_JPRB/)
+      FORREFO(4,:) = (/ &
+     &8.5878E-07_JPRB,6.0921E-07_JPRB,5.5773E-07_JPRB,5.3374E-07_JPRB,5.0495E-07_JPRB,4.9844E-07_JPRB, &
+     &5.1536E-07_JPRB,5.2908E-07_JPRB,4.7977E-07_JPRB,5.3177E-07_JPRB,4.9266E-07_JPRB,4.5403E-07_JPRB, &
+     &3.9695E-07_JPRB,3.4792E-07_JPRB,3.4912E-07_JPRB,3.4102E-07_JPRB/)
+
+!     The array SELFREFO contains the coefficient of the water vapor
+!     self-continuum (including the energy term).  The first index
+!     refers to temperature in 7.2 degree increments.  For instance,
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+!     etc.  The second index runs over the g-channel (1 to 16).
+
+      SELFREFO(:, 1) = (/ &
+     & 3.16029E-02_JPRB, 2.74633E-02_JPRB, 2.38660E-02_JPRB, 2.07399E-02_JPRB, 1.80232E-02_JPRB, &
+     & 1.56624E-02_JPRB, 1.36108E-02_JPRB, 1.18280E-02_JPRB, 1.02787E-02_JPRB, 8.93231E-03_JPRB/)
+      SELFREFO(:, 2) = (/ &
+     & 3.10422E-02_JPRB, 2.71312E-02_JPRB, 2.37130E-02_JPRB, 2.07254E-02_JPRB, 1.81142E-02_JPRB, &
+     & 1.58320E-02_JPRB, 1.38374E-02_JPRB, 1.20940E-02_JPRB, 1.05703E-02_JPRB, 9.23854E-03_JPRB/)
+      SELFREFO(:, 3) = (/ &
+     & 3.08657E-02_JPRB, 2.69431E-02_JPRB, 2.35190E-02_JPRB, 2.05301E-02_JPRB, 1.79210E-02_JPRB, &
+     & 1.56435E-02_JPRB, 1.36554E-02_JPRB, 1.19200E-02_JPRB, 1.04051E-02_JPRB, 9.08279E-03_JPRB/)
+      SELFREFO(:, 4) = (/ &
+     & 3.02668E-02_JPRB, 2.64686E-02_JPRB, 2.31470E-02_JPRB, 2.02422E-02_JPRB, 1.77020E-02_JPRB, &
+     & 1.54806E-02_JPRB, 1.35379E-02_JPRB, 1.18390E-02_JPRB, 1.03533E-02_JPRB, 9.05406E-03_JPRB/)
+      SELFREFO(:, 5) = (/ &
+     & 2.98317E-02_JPRB, 2.61491E-02_JPRB, 2.29210E-02_JPRB, 2.00914E-02_JPRB, 1.76112E-02_JPRB, &
+     & 1.54371E-02_JPRB, 1.35314E-02_JPRB, 1.18610E-02_JPRB, 1.03968E-02_JPRB, 9.11332E-03_JPRB/)
+      SELFREFO(:, 6) = (/ &
+     & 2.95545E-02_JPRB, 2.59083E-02_JPRB, 2.27120E-02_JPRB, 1.99100E-02_JPRB, 1.74537E-02_JPRB, &
+     & 1.53004E-02_JPRB, 1.34128E-02_JPRB, 1.17580E-02_JPRB, 1.03074E-02_JPRB, 9.03576E-03_JPRB/)
+      SELFREFO(:, 7) = (/ &
+     & 2.97352E-02_JPRB, 2.60320E-02_JPRB, 2.27900E-02_JPRB, 1.99517E-02_JPRB, 1.74670E-02_JPRB, &
+     & 1.52916E-02_JPRB, 1.33872E-02_JPRB, 1.17200E-02_JPRB, 1.02604E-02_JPRB, 8.98258E-03_JPRB/)
+      SELFREFO(:, 8) = (/ &
+     & 2.96543E-02_JPRB, 2.59760E-02_JPRB, 2.27540E-02_JPRB, 1.99316E-02_JPRB, 1.74593E-02_JPRB, &
+     & 1.52937E-02_JPRB, 1.33967E-02_JPRB, 1.17350E-02_JPRB, 1.02794E-02_JPRB, 9.00437E-03_JPRB/)
+      SELFREFO(:, 9) = (/ &
+     & 2.97998E-02_JPRB, 2.60786E-02_JPRB, 2.28220E-02_JPRB, 1.99721E-02_JPRB, 1.74781E-02_JPRB, &
+     & 1.52955E-02_JPRB, 1.33855E-02_JPRB, 1.17140E-02_JPRB, 1.02512E-02_JPRB, 8.97110E-03_JPRB/)
+      SELFREFO(:,10) = (/ &
+     & 2.98826E-02_JPRB, 2.61096E-02_JPRB, 2.28130E-02_JPRB, 1.99326E-02_JPRB, 1.74159E-02_JPRB, &
+     & 1.52170E-02_JPRB, 1.32957E-02_JPRB, 1.16170E-02_JPRB, 1.01502E-02_JPRB, 8.86867E-03_JPRB/)
+      SELFREFO(:,11) = (/ &
+     & 2.94710E-02_JPRB, 2.58147E-02_JPRB, 2.26120E-02_JPRB, 1.98066E-02_JPRB, 1.73493E-02_JPRB, &
+     & 1.51969E-02_JPRB, 1.33115E-02_JPRB, 1.16600E-02_JPRB, 1.02134E-02_JPRB, 8.94628E-03_JPRB/)
+      SELFREFO(:,12) = (/ &
+     & 2.96297E-02_JPRB, 2.59544E-02_JPRB, 2.27350E-02_JPRB, 1.99149E-02_JPRB, 1.74446E-02_JPRB, &
+     & 1.52808E-02_JPRB, 1.33853E-02_JPRB, 1.17250E-02_JPRB, 1.02706E-02_JPRB, 8.99663E-03_JPRB/)
+      SELFREFO(:,13) = (/ &
+     & 2.96272E-02_JPRB, 2.59013E-02_JPRB, 2.26440E-02_JPRB, 1.97963E-02_JPRB, 1.73067E-02_JPRB, &
+     & 1.51302E-02_JPRB, 1.32275E-02_JPRB, 1.15640E-02_JPRB, 1.01097E-02_JPRB, 8.83833E-03_JPRB/)
+      SELFREFO(:,14) = (/ &
+     & 2.89906E-02_JPRB, 2.53971E-02_JPRB, 2.22490E-02_JPRB, 1.94911E-02_JPRB, 1.70751E-02_JPRB, &
+     & 1.49585E-02_JPRB, 1.31044E-02_JPRB, 1.14800E-02_JPRB, 1.00570E-02_JPRB, 8.81038E-03_JPRB/)
+      SELFREFO(:,15) = (/ &
+     & 2.80884E-02_JPRB, 2.46987E-02_JPRB, 2.17180E-02_JPRB, 1.90970E-02_JPRB, 1.67924E-02_JPRB, &
+     & 1.47659E-02_JPRB, 1.29839E-02_JPRB, 1.14170E-02_JPRB, 1.00392E-02_JPRB, 8.82765E-03_JPRB/)
+      SELFREFO(:,16) = (/ &
+     & 2.80884E-02_JPRB, 2.46987E-02_JPRB, 2.17180E-02_JPRB, 1.90970E-02_JPRB, 1.67924E-02_JPRB, &
+     & 1.47659E-02_JPRB, 1.29839E-02_JPRB, 1.14170E-02_JPRB, 1.00392E-02_JPRB, 8.82765E-03_JPRB/)
+
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB8',1,ZHOOK_HANDLE)
+RETURN
+
+1001 CONTINUE
+CALL ABOR1("RRTM_KGB8:ERROR READING FILE RADRRTM")
+
+END SUBROUTINE RRTM_KGB8
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb8.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb8.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb8.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_KGB8
+END SUBROUTINE RRTM_KGB8
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb9.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb9.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb9.F90	(revision 3908)
@@ -0,0 +1,1028 @@
+SUBROUTINE RRTM_KGB9
+
+!     Originally by Eli J. Mlawer, Atmospheric & Environmental Research.
+!     BAND 9:  1180-1390 cm-1 (low - H2O,CH4; high - CH4)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+!     G.Mozdzynski March 2011 read constants from files
+!     ABozzo 201306 updated to rrtmg v4.85
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+USE YOMLUN    ,ONLY : NULRAD
+USE MPL_MODULE,ONLY : MPL_BROADCAST
+USE YOMTAG    ,ONLY : MTAGRAD
+USE YOMMP0    , ONLY : NPROC, MYPROC
+
+USE YOERRTO9 , ONLY : KAO     ,KBO     ,KAO_D,KBO_D,SELFREFO   ,FORREFO, FRACREFAO  ,&
+ & FRACREFBO, KAO_MN2O, KBO_MN2O
+
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB9',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+  READ(NULRAD,ERR=1001) KAO_D,KBO_D
+ ! Convert the data into model actual precision.
+  KAO = REAL(KAO_D,JPRB)
+  KBO = REAL(KBO_D,JPRB) 
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KAO,MTAGRAD,1,CDSTRING='RRTM_KGB9:')
+  CALL MPL_BROADCAST (KBO,MTAGRAD,1,CDSTRING='RRTM_KGB9:')
+ENDIF
+
+! Planck fractions mapping level : P=212.7250 mb, T = 223.06 K
+      FRACREFAO(:, 1) = (/ &
+     &  1.8129E-01_JPRB,1.6119E-01_JPRB,1.3308E-01_JPRB,1.2342E-01_JPRB,1.1259E-01_JPRB,9.7580E-02_JPRB, &
+     &  7.9176E-02_JPRB,5.8541E-02_JPRB,3.9084E-02_JPRB,4.2419E-03_JPRB,3.4314E-03_JPRB,2.6935E-03_JPRB, &
+     &  1.9404E-03_JPRB,1.2218E-03_JPRB,4.5263E-04_JPRB,6.0909E-05_JPRB/)
+      FRACREFAO(:, 2) = (/ &
+     &  1.9665E-01_JPRB,1.5640E-01_JPRB,1.3101E-01_JPRB,1.2153E-01_JPRB,1.1037E-01_JPRB,9.6043E-02_JPRB, &
+     &  7.7856E-02_JPRB,5.7547E-02_JPRB,3.8670E-02_JPRB,4.1955E-03_JPRB,3.4104E-03_JPRB,2.6781E-03_JPRB, &
+     &  1.9245E-03_JPRB,1.2093E-03_JPRB,4.4113E-04_JPRB,6.0913E-05_JPRB/)
+      FRACREFAO(:, 3) = (/ &
+     &  2.0273E-01_JPRB,1.5506E-01_JPRB,1.3044E-01_JPRB,1.2043E-01_JPRB,1.0952E-01_JPRB,9.5384E-02_JPRB, &
+     &  7.7157E-02_JPRB,5.7176E-02_JPRB,3.8379E-02_JPRB,4.1584E-03_JPRB,3.3836E-03_JPRB,2.6412E-03_JPRB, &
+     &  1.8865E-03_JPRB,1.1791E-03_JPRB,4.2094E-04_JPRB,4.7410E-05_JPRB/)
+      FRACREFAO(:, 4) = (/ &
+     &  2.0272E-01_JPRB,1.5963E-01_JPRB,1.2913E-01_JPRB,1.2060E-01_JPRB,1.0820E-01_JPRB,9.4685E-02_JPRB, &
+     &  7.6544E-02_JPRB,5.6851E-02_JPRB,3.8155E-02_JPRB,4.0913E-03_JPRB,3.3442E-03_JPRB,2.6054E-03_JPRB, &
+     &  1.8875E-03_JPRB,1.1263E-03_JPRB,3.7743E-04_JPRB,4.7410E-05_JPRB/)
+      FRACREFAO(:, 5) = (/ &
+     &  2.0280E-01_JPRB,1.6353E-01_JPRB,1.2910E-01_JPRB,1.1968E-01_JPRB,1.0725E-01_JPRB,9.4112E-02_JPRB, &
+     &  7.5828E-02_JPRB,5.6526E-02_JPRB,3.7972E-02_JPRB,4.0205E-03_JPRB,3.3063E-03_JPRB,2.5681E-03_JPRB, &
+     &  1.8386E-03_JPRB,1.0757E-03_JPRB,3.5301E-04_JPRB,4.7410E-05_JPRB/)
+      FRACREFAO(:, 6) = (/ &
+     &  2.0294E-01_JPRB,1.6840E-01_JPRB,1.2852E-01_JPRB,1.1813E-01_JPRB,1.0724E-01_JPRB,9.2946E-02_JPRB, &
+     &  7.5029E-02_JPRB,5.6158E-02_JPRB,3.7744E-02_JPRB,3.9632E-03_JPRB,3.2434E-03_JPRB,2.5275E-03_JPRB, &
+     &  1.7558E-03_JPRB,1.0080E-03_JPRB,3.5301E-04_JPRB,4.7410E-05_JPRB/)
+      FRACREFAO(:, 7) = (/ &
+     &  2.0313E-01_JPRB,1.7390E-01_JPRB,1.2864E-01_JPRB,1.1689E-01_JPRB,1.0601E-01_JPRB,9.1791E-02_JPRB, &
+     &  7.4224E-02_JPRB,5.5500E-02_JPRB,3.7374E-02_JPRB,3.9214E-03_JPRB,3.1984E-03_JPRB,2.4162E-03_JPRB, &
+     &  1.6394E-03_JPRB,9.7275E-04_JPRB,3.5299E-04_JPRB,4.7410E-05_JPRB/)
+      FRACREFAO(:, 8) = (/ &
+     &  2.0332E-01_JPRB,1.7800E-01_JPRB,1.3286E-01_JPRB,1.1555E-01_JPRB,1.0407E-01_JPRB,9.0475E-02_JPRB, &
+     &  7.2452E-02_JPRB,5.4566E-02_JPRB,3.6677E-02_JPRB,3.7889E-03_JPRB,3.0351E-03_JPRB,2.2587E-03_JPRB, &
+     &  1.5764E-03_JPRB,9.7270E-04_JPRB,3.5300E-04_JPRB,4.7410E-05_JPRB/)
+      FRACREFAO(:, 9) = (/ &
+     &  1.9624E-01_JPRB,1.6519E-01_JPRB,1.3663E-01_JPRB,1.1535E-01_JPRB,1.0719E-01_JPRB,9.4156E-02_JPRB, &
+     &  7.6745E-02_JPRB,5.6987E-02_JPRB,3.8135E-02_JPRB,4.1626E-03_JPRB,3.4243E-03_JPRB,2.7116E-03_JPRB, &
+     &  1.7095E-03_JPRB,9.7271E-04_JPRB,3.5299E-04_JPRB,4.7410E-05_JPRB/)
+
+! Planck fraction mapping level : p=3.20e-2 mb, t = 197.92 k
+      FRACREFBO(:) = (/ &
+     &  2.0914E-01_JPRB,1.5077E-01_JPRB,1.2878E-01_JPRB,1.1856E-01_JPRB,1.0695E-01_JPRB,9.3048E-02_JPRB, &
+     &  7.7645E-02_JPRB,6.0785E-02_JPRB,4.0642E-02_JPRB,4.0499E-03_JPRB,3.3931E-03_JPRB,2.6363E-03_JPRB, &
+     &  1.9151E-03_JPRB,1.1963E-03_JPRB,4.3471E-04_JPRB,5.1421E-05_JPRB/)
+
+
+!     ------------------------------------------------------------------
+
+!     The array KAO contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels> ~100mb, temperatures, and binary
+!     species parameters (see taumol.f for definition).  The first 
+!     index in the array, JS, runs from 1 to 11, and corresponds to 
+!     different values of the binary species parameter.  For instance, 
+!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
+!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
+!     in the array, JT, which runs from 1 to 5, corresponds to different
+!     temperatures.  More specifically, JT = 3 means that the data are for
+!     the reference temperature TREF for this  pressure level, JT = 2 refers
+!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
+!     to the JPth reference pressure level (see taumol.f for these levels
+!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
+!     which g-interval the absorption coefficients are for.
+
+
+
+!     The array KBO contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels < ~100mb and temperatures. The first 
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the reference temperature TREF for this pressure 
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
+!     The second index, JP, runs from 13 to 59 and refers to the JPth
+!     reference pressure level (see taumol.f for the value of these
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
+!     and tells us which g-interval the absorption coefficients are for.
+
+
+!     The array KAO_Mxx contains the absorption coefficient for 
+!     a minor species at the 16 chosen g-values for a reference pressure
+!     level below 100~ mb.   The first index in the array, JS, runs
+!     from 1 to 10, and corresponds to different gas column amount ratios,
+!     as expressed through the binary species parameter eta, defined as
+!     eta = gas1/(gas1 + (rat) * gas2), where rat is the 
+!     ratio of the reference MLS column amount value of gas 1 
+!     to that of gas2.  The second index refers to temperature 
+!     in 7.2 degree increments.  For instance, JT = 1 refers to a 
+!     temperature of 188.0, JT = 2 refers to 195.2, etc. The third index 
+!     runs over the g-channel (1 to 16).
+
+      KAO_MN2O( 1, :, 1) = (/ &
+     & 5.41078E-02_JPRB, 5.59051E-02_JPRB, 5.77620E-02_JPRB, 5.96805E-02_JPRB, 6.16628E-02_JPRB, &
+     & 6.37110E-02_JPRB, 6.58272E-02_JPRB, 6.80137E-02_JPRB, 7.02728E-02_JPRB, 7.26069E-02_JPRB, &
+     & 7.50185E-02_JPRB, 7.75103E-02_JPRB, 8.00848E-02_JPRB, 8.27449E-02_JPRB, 8.54933E-02_JPRB, &
+     & 8.83330E-02_JPRB, 9.12670E-02_JPRB, 9.42984E-02_JPRB, 9.74306E-02_JPRB/)
+      KAO_MN2O( 2, :, 1) = (/ &
+     & 1.19602E-01_JPRB, 1.22963E-01_JPRB, 1.26417E-01_JPRB, 1.29969E-01_JPRB, 1.33621E-01_JPRB, &
+     & 1.37375E-01_JPRB, 1.41235E-01_JPRB, 1.45203E-01_JPRB, 1.49283E-01_JPRB, 1.53477E-01_JPRB, &
+     & 1.57789E-01_JPRB, 1.62223E-01_JPRB, 1.66780E-01_JPRB, 1.71466E-01_JPRB, 1.76284E-01_JPRB, &
+     & 1.81237E-01_JPRB, 1.86329E-01_JPRB, 1.91564E-01_JPRB, 1.96946E-01_JPRB/)
+      KAO_MN2O( 3, :, 1) = (/ &
+     & 1.49614E-01_JPRB, 1.53427E-01_JPRB, 1.57337E-01_JPRB, 1.61346E-01_JPRB, 1.65457E-01_JPRB, &
+     & 1.69674E-01_JPRB, 1.73997E-01_JPRB, 1.78431E-01_JPRB, 1.82978E-01_JPRB, 1.87641E-01_JPRB, &
+     & 1.92422E-01_JPRB, 1.97325E-01_JPRB, 2.02354E-01_JPRB, 2.07510E-01_JPRB, 2.12798E-01_JPRB, &
+     & 2.18221E-01_JPRB, 2.23781E-01_JPRB, 2.29484E-01_JPRB, 2.35331E-01_JPRB/)
+      KAO_MN2O( 4, :, 1) = (/ &
+     & 1.80029E-01_JPRB, 1.84202E-01_JPRB, 1.88472E-01_JPRB, 1.92841E-01_JPRB, 1.97311E-01_JPRB, &
+     & 2.01884E-01_JPRB, 2.06564E-01_JPRB, 2.11352E-01_JPRB, 2.16252E-01_JPRB, 2.21264E-01_JPRB, &
+     & 2.26393E-01_JPRB, 2.31641E-01_JPRB, 2.37010E-01_JPRB, 2.42504E-01_JPRB, 2.48126E-01_JPRB, &
+     & 2.53877E-01_JPRB, 2.59762E-01_JPRB, 2.65783E-01_JPRB, 2.71944E-01_JPRB/)
+      KAO_MN2O( 5, :, 1) = (/ &
+     & 2.08279E-01_JPRB, 2.13029E-01_JPRB, 2.17888E-01_JPRB, 2.22858E-01_JPRB, 2.27941E-01_JPRB, &
+     & 2.33140E-01_JPRB, 2.38458E-01_JPRB, 2.43897E-01_JPRB, 2.49460E-01_JPRB, 2.55150E-01_JPRB, &
+     & 2.60969E-01_JPRB, 2.66922E-01_JPRB, 2.73010E-01_JPRB, 2.79237E-01_JPRB, 2.85606E-01_JPRB, &
+     & 2.92120E-01_JPRB, 2.98783E-01_JPRB, 3.05598E-01_JPRB, 3.12568E-01_JPRB/)
+      KAO_MN2O( 6, :, 1) = (/ &
+     & 2.17336E-01_JPRB, 2.22571E-01_JPRB, 2.27931E-01_JPRB, 2.33421E-01_JPRB, 2.39043E-01_JPRB, &
+     & 2.44801E-01_JPRB, 2.50697E-01_JPRB, 2.56735E-01_JPRB, 2.62918E-01_JPRB, 2.69251E-01_JPRB, &
+     & 2.75735E-01_JPRB, 2.82377E-01_JPRB, 2.89178E-01_JPRB, 2.96142E-01_JPRB, 3.03275E-01_JPRB, &
+     & 3.10579E-01_JPRB, 3.18060E-01_JPRB, 3.25720E-01_JPRB, 3.33565E-01_JPRB/)
+      KAO_MN2O( 7, :, 1) = (/ &
+     & 2.23903E-01_JPRB, 2.29349E-01_JPRB, 2.34926E-01_JPRB, 2.40640E-01_JPRB, 2.46493E-01_JPRB, &
+     & 2.52488E-01_JPRB, 2.58628E-01_JPRB, 2.64918E-01_JPRB, 2.71361E-01_JPRB, 2.77961E-01_JPRB, &
+     & 2.84721E-01_JPRB, 2.91646E-01_JPRB, 2.98739E-01_JPRB, 3.06005E-01_JPRB, 3.13447E-01_JPRB, &
+     & 3.21070E-01_JPRB, 3.28879E-01_JPRB, 3.36877E-01_JPRB, 3.45071E-01_JPRB/)
+      KAO_MN2O( 8, :, 1) = (/ &
+     & 2.23400E-01_JPRB, 2.28843E-01_JPRB, 2.34418E-01_JPRB, 2.40130E-01_JPRB, 2.45980E-01_JPRB, &
+     & 2.51973E-01_JPRB, 2.58112E-01_JPRB, 2.64401E-01_JPRB, 2.70843E-01_JPRB, 2.77442E-01_JPRB, &
+     & 2.84202E-01_JPRB, 2.91126E-01_JPRB, 2.98219E-01_JPRB, 3.05485E-01_JPRB, 3.12928E-01_JPRB, &
+     & 3.20552E-01_JPRB, 3.28362E-01_JPRB, 3.36362E-01_JPRB, 3.44557E-01_JPRB/)
+      KAO_MN2O( 9, :, 1) = (/ &
+     & 1.89279E-01_JPRB, 1.94423E-01_JPRB, 1.99707E-01_JPRB, 2.05135E-01_JPRB, 2.10710E-01_JPRB, &
+     & 2.16437E-01_JPRB, 2.22319E-01_JPRB, 2.28361E-01_JPRB, 2.34568E-01_JPRB, 2.40943E-01_JPRB, &
+     & 2.47492E-01_JPRB, 2.54218E-01_JPRB, 2.61127E-01_JPRB, 2.68224E-01_JPRB, 2.75514E-01_JPRB, &
+     & 2.83002E-01_JPRB, 2.90694E-01_JPRB, 2.98594E-01_JPRB, 3.06709E-01_JPRB/)
+      KAO_MN2O( 1, :, 2) = (/ &
+     & 9.46669E-02_JPRB, 9.77137E-02_JPRB, 1.00858E-01_JPRB, 1.04104E-01_JPRB, 1.07455E-01_JPRB, &
+     & 1.10913E-01_JPRB, 1.14483E-01_JPRB, 1.18167E-01_JPRB, 1.21971E-01_JPRB, 1.25896E-01_JPRB, &
+     & 1.29948E-01_JPRB, 1.34130E-01_JPRB, 1.38447E-01_JPRB, 1.42903E-01_JPRB, 1.47502E-01_JPRB, &
+     & 1.52249E-01_JPRB, 1.57149E-01_JPRB, 1.62207E-01_JPRB, 1.67427E-01_JPRB/)
+      KAO_MN2O( 2, :, 2) = (/ &
+     & 5.11901E-01_JPRB, 5.24950E-01_JPRB, 5.38331E-01_JPRB, 5.52053E-01_JPRB, 5.66125E-01_JPRB, &
+     & 5.80556E-01_JPRB, 5.95354E-01_JPRB, 6.10530E-01_JPRB, 6.26093E-01_JPRB, 6.42052E-01_JPRB, &
+     & 6.58418E-01_JPRB, 6.75202E-01_JPRB, 6.92413E-01_JPRB, 7.10062E-01_JPRB, 7.28162E-01_JPRB, &
+     & 7.46723E-01_JPRB, 7.65758E-01_JPRB, 7.85277E-01_JPRB, 8.05294E-01_JPRB/)
+      KAO_MN2O( 3, :, 2) = (/ &
+     & 8.32946E-01_JPRB, 8.45780E-01_JPRB, 8.58813E-01_JPRB, 8.72046E-01_JPRB, 8.85482E-01_JPRB, &
+     & 8.99126E-01_JPRB, 9.12980E-01_JPRB, 9.27048E-01_JPRB, 9.41332E-01_JPRB, 9.55837E-01_JPRB, &
+     & 9.70565E-01_JPRB, 9.85520E-01_JPRB, 1.00070E+00_JPRB, 1.01612E+00_JPRB, 1.03178E+00_JPRB, &
+     & 1.04768E+00_JPRB, 1.06382E+00_JPRB, 1.08021E+00_JPRB, 1.09686E+00_JPRB/)
+      KAO_MN2O( 4, :, 2) = (/ &
+     & 1.04032E+00_JPRB, 1.05475E+00_JPRB, 1.06937E+00_JPRB, 1.08419E+00_JPRB, 1.09922E+00_JPRB, &
+     & 1.11446E+00_JPRB, 1.12991E+00_JPRB, 1.14557E+00_JPRB, 1.16145E+00_JPRB, 1.17755E+00_JPRB, &
+     & 1.19387E+00_JPRB, 1.21042E+00_JPRB, 1.22720E+00_JPRB, 1.24421E+00_JPRB, 1.26146E+00_JPRB, &
+     & 1.27895E+00_JPRB, 1.29668E+00_JPRB, 1.31465E+00_JPRB, 1.33287E+00_JPRB/)
+      KAO_MN2O( 5, :, 2) = (/ &
+     & 1.22685E+00_JPRB, 1.24267E+00_JPRB, 1.25870E+00_JPRB, 1.27493E+00_JPRB, 1.29137E+00_JPRB, &
+     & 1.30803E+00_JPRB, 1.32490E+00_JPRB, 1.34199E+00_JPRB, 1.35930E+00_JPRB, 1.37683E+00_JPRB, &
+     & 1.39459E+00_JPRB, 1.41257E+00_JPRB, 1.43079E+00_JPRB, 1.44925E+00_JPRB, 1.46794E+00_JPRB, &
+     & 1.48687E+00_JPRB, 1.50605E+00_JPRB, 1.52547E+00_JPRB, 1.54515E+00_JPRB/)
+      KAO_MN2O( 6, :, 2) = (/ &
+     & 1.53781E+00_JPRB, 1.55206E+00_JPRB, 1.56645E+00_JPRB, 1.58097E+00_JPRB, 1.59563E+00_JPRB, &
+     & 1.61042E+00_JPRB, 1.62535E+00_JPRB, 1.64042E+00_JPRB, 1.65562E+00_JPRB, 1.67097E+00_JPRB, &
+     & 1.68646E+00_JPRB, 1.70210E+00_JPRB, 1.71788E+00_JPRB, 1.73380E+00_JPRB, 1.74987E+00_JPRB, &
+     & 1.76610E+00_JPRB, 1.78247E+00_JPRB, 1.79899E+00_JPRB, 1.81567E+00_JPRB/)
+      KAO_MN2O( 7, :, 2) = (/ &
+     & 1.90476E+00_JPRB, 1.91858E+00_JPRB, 1.93251E+00_JPRB, 1.94653E+00_JPRB, 1.96065E+00_JPRB, &
+     & 1.97488E+00_JPRB, 1.98921E+00_JPRB, 2.00365E+00_JPRB, 2.01819E+00_JPRB, 2.03283E+00_JPRB, &
+     & 2.04758E+00_JPRB, 2.06244E+00_JPRB, 2.07741E+00_JPRB, 2.09248E+00_JPRB, 2.10767E+00_JPRB, &
+     & 2.12296E+00_JPRB, 2.13837E+00_JPRB, 2.15388E+00_JPRB, 2.16951E+00_JPRB/)
+      KAO_MN2O( 8, :, 2) = (/ &
+     & 2.38211E+00_JPRB, 2.39819E+00_JPRB, 2.41438E+00_JPRB, 2.43068E+00_JPRB, 2.44709E+00_JPRB, &
+     & 2.46361E+00_JPRB, 2.48024E+00_JPRB, 2.49699E+00_JPRB, 2.51384E+00_JPRB, 2.53082E+00_JPRB, &
+     & 2.54790E+00_JPRB, 2.56510E+00_JPRB, 2.58242E+00_JPRB, 2.59985E+00_JPRB, 2.61741E+00_JPRB, &
+     & 2.63508E+00_JPRB, 2.65287E+00_JPRB, 2.67078E+00_JPRB, 2.68881E+00_JPRB/)
+      KAO_MN2O( 9, :, 2) = (/ &
+     & 1.26464E+00_JPRB, 1.28107E+00_JPRB, 1.29772E+00_JPRB, 1.31458E+00_JPRB, 1.33166E+00_JPRB, &
+     & 1.34896E+00_JPRB, 1.36649E+00_JPRB, 1.38424E+00_JPRB, 1.40223E+00_JPRB, 1.42044E+00_JPRB, &
+     & 1.43890E+00_JPRB, 1.45759E+00_JPRB, 1.47653E+00_JPRB, 1.49572E+00_JPRB, 1.51515E+00_JPRB, &
+     & 1.53483E+00_JPRB, 1.55478E+00_JPRB, 1.57498E+00_JPRB, 1.59544E+00_JPRB/)
+      KAO_MN2O( 1, :, 3) = (/ &
+     & 1.50082E-01_JPRB, 1.59095E-01_JPRB, 1.68650E-01_JPRB, 1.78779E-01_JPRB, 1.89516E-01_JPRB, &
+     & 2.00898E-01_JPRB, 2.12963E-01_JPRB, 2.25753E-01_JPRB, 2.39311E-01_JPRB, 2.53683E-01_JPRB, &
+     & 2.68919E-01_JPRB, 2.85069E-01_JPRB, 3.02190E-01_JPRB, 3.20339E-01_JPRB, 3.39577E-01_JPRB, &
+     & 3.59971E-01_JPRB, 3.81590E-01_JPRB, 4.04507E-01_JPRB, 4.28801E-01_JPRB/)
+      KAO_MN2O( 2, :, 3) = (/ &
+     & 3.09551E+00_JPRB, 3.09780E+00_JPRB, 3.10008E+00_JPRB, 3.10237E+00_JPRB, 3.10466E+00_JPRB, &
+     & 3.10695E+00_JPRB, 3.10925E+00_JPRB, 3.11154E+00_JPRB, 3.11384E+00_JPRB, 3.11614E+00_JPRB, &
+     & 3.11844E+00_JPRB, 3.12074E+00_JPRB, 3.12305E+00_JPRB, 3.12535E+00_JPRB, 3.12766E+00_JPRB, &
+     & 3.12997E+00_JPRB, 3.13228E+00_JPRB, 3.13459E+00_JPRB, 3.13691E+00_JPRB/)
+      KAO_MN2O( 3, :, 3) = (/ &
+     & 4.42661E+00_JPRB, 4.40858E+00_JPRB, 4.39062E+00_JPRB, 4.37274E+00_JPRB, 4.35493E+00_JPRB, &
+     & 4.33719E+00_JPRB, 4.31953E+00_JPRB, 4.30193E+00_JPRB, 4.28441E+00_JPRB, 4.26696E+00_JPRB, &
+     & 4.24958E+00_JPRB, 4.23227E+00_JPRB, 4.21503E+00_JPRB, 4.19787E+00_JPRB, 4.18077E+00_JPRB, &
+     & 4.16374E+00_JPRB, 4.14678E+00_JPRB, 4.12989E+00_JPRB, 4.11307E+00_JPRB/)
+      KAO_MN2O( 4, :, 3) = (/ &
+     & 5.77864E+00_JPRB, 5.74085E+00_JPRB, 5.70331E+00_JPRB, 5.66602E+00_JPRB, 5.62897E+00_JPRB, &
+     & 5.59216E+00_JPRB, 5.55559E+00_JPRB, 5.51926E+00_JPRB, 5.48317E+00_JPRB, 5.44731E+00_JPRB, &
+     & 5.41169E+00_JPRB, 5.37631E+00_JPRB, 5.34115E+00_JPRB, 5.30622E+00_JPRB, 5.27152E+00_JPRB, &
+     & 5.23705E+00_JPRB, 5.20281E+00_JPRB, 5.16879E+00_JPRB, 5.13499E+00_JPRB/)
+      KAO_MN2O( 5, :, 3) = (/ &
+     & 7.17294E+00_JPRB, 7.10890E+00_JPRB, 7.04542E+00_JPRB, 6.98251E+00_JPRB, 6.92017E+00_JPRB, &
+     & 6.85838E+00_JPRB, 6.79714E+00_JPRB, 6.73645E+00_JPRB, 6.67630E+00_JPRB, 6.61669E+00_JPRB, &
+     & 6.55761E+00_JPRB, 6.49905E+00_JPRB, 6.44102E+00_JPRB, 6.38351E+00_JPRB, 6.32651E+00_JPRB, &
+     & 6.27003E+00_JPRB, 6.21404E+00_JPRB, 6.15856E+00_JPRB, 6.10357E+00_JPRB/)
+      KAO_MN2O( 6, :, 3) = (/ &
+     & 9.05082E+00_JPRB, 8.96132E+00_JPRB, 8.87271E+00_JPRB, 8.78498E+00_JPRB, 8.69811E+00_JPRB, &
+     & 8.61210E+00_JPRB, 8.52694E+00_JPRB, 8.44262E+00_JPRB, 8.35914E+00_JPRB, 8.27648E+00_JPRB, &
+     & 8.19464E+00_JPRB, 8.11361E+00_JPRB, 8.03338E+00_JPRB, 7.95394E+00_JPRB, 7.87529E+00_JPRB, &
+     & 7.79742E+00_JPRB, 7.72032E+00_JPRB, 7.64398E+00_JPRB, 7.56839E+00_JPRB/)
+      KAO_MN2O( 7, :, 3) = (/ &
+     & 1.18749E+01_JPRB, 1.17648E+01_JPRB, 1.16556E+01_JPRB, 1.15475E+01_JPRB, 1.14403E+01_JPRB, &
+     & 1.13342E+01_JPRB, 1.12290E+01_JPRB, 1.11248E+01_JPRB, 1.10216E+01_JPRB, 1.09194E+01_JPRB, &
+     & 1.08180E+01_JPRB, 1.07177E+01_JPRB, 1.06182E+01_JPRB, 1.05197E+01_JPRB, 1.04221E+01_JPRB, &
+     & 1.03254E+01_JPRB, 1.02296E+01_JPRB, 1.01347E+01_JPRB, 1.00407E+01_JPRB/)
+      KAO_MN2O( 8, :, 3) = (/ &
+     & 1.41428E+01_JPRB, 1.40323E+01_JPRB, 1.39227E+01_JPRB, 1.38139E+01_JPRB, 1.37060E+01_JPRB, &
+     & 1.35989E+01_JPRB, 1.34927E+01_JPRB, 1.33873E+01_JPRB, 1.32827E+01_JPRB, 1.31790E+01_JPRB, &
+     & 1.30760E+01_JPRB, 1.29738E+01_JPRB, 1.28725E+01_JPRB, 1.27719E+01_JPRB, 1.26722E+01_JPRB, &
+     & 1.25732E+01_JPRB, 1.24750E+01_JPRB, 1.23775E+01_JPRB, 1.22808E+01_JPRB/)
+      KAO_MN2O( 9, :, 3) = (/ &
+     & 7.34993E+00_JPRB, 7.29335E+00_JPRB, 7.23720E+00_JPRB, 7.18149E+00_JPRB, 7.12620E+00_JPRB, &
+     & 7.07134E+00_JPRB, 7.01690E+00_JPRB, 6.96288E+00_JPRB, 6.90928E+00_JPRB, 6.85609E+00_JPRB, &
+     & 6.80331E+00_JPRB, 6.75094E+00_JPRB, 6.69897E+00_JPRB, 6.64739E+00_JPRB, 6.59622E+00_JPRB, &
+     & 6.54544E+00_JPRB, 6.49505E+00_JPRB, 6.44505E+00_JPRB, 6.39543E+00_JPRB/)
+      KAO_MN2O( 1, :, 4) = (/ &
+     & 6.11248E-01_JPRB, 6.37225E-01_JPRB, 6.64306E-01_JPRB, 6.92538E-01_JPRB, 7.21970E-01_JPRB, &
+     & 7.52653E-01_JPRB, 7.84639E-01_JPRB, 8.17985E-01_JPRB, 8.52749E-01_JPRB, 8.88989E-01_JPRB, &
+     & 9.26770E-01_JPRB, 9.66157E-01_JPRB, 1.00722E+00_JPRB, 1.05002E+00_JPRB, 1.09465E+00_JPRB, &
+     & 1.14117E+00_JPRB, 1.18967E+00_JPRB, 1.24022E+00_JPRB, 1.29293E+00_JPRB/)
+      KAO_MN2O( 2, :, 4) = (/ &
+     & 5.07253E+00_JPRB, 5.05299E+00_JPRB, 5.03353E+00_JPRB, 5.01414E+00_JPRB, 4.99483E+00_JPRB, &
+     & 4.97559E+00_JPRB, 4.95642E+00_JPRB, 4.93733E+00_JPRB, 4.91831E+00_JPRB, 4.89937E+00_JPRB, &
+     & 4.88050E+00_JPRB, 4.86170E+00_JPRB, 4.84297E+00_JPRB, 4.82432E+00_JPRB, 4.80573E+00_JPRB, &
+     & 4.78722E+00_JPRB, 4.76878E+00_JPRB, 4.75042E+00_JPRB, 4.73212E+00_JPRB/)
+      KAO_MN2O( 3, :, 4) = (/ &
+     & 7.45829E+00_JPRB, 7.42266E+00_JPRB, 7.38719E+00_JPRB, 7.35190E+00_JPRB, 7.31677E+00_JPRB, &
+     & 7.28181E+00_JPRB, 7.24702E+00_JPRB, 7.21240E+00_JPRB, 7.17794E+00_JPRB, 7.14364E+00_JPRB, &
+     & 7.10951E+00_JPRB, 7.07554E+00_JPRB, 7.04173E+00_JPRB, 7.00809E+00_JPRB, 6.97461E+00_JPRB, &
+     & 6.94128E+00_JPRB, 6.90812E+00_JPRB, 6.87511E+00_JPRB, 6.84226E+00_JPRB/)
+      KAO_MN2O( 4, :, 4) = (/ &
+     & 9.58893E+00_JPRB, 9.54796E+00_JPRB, 9.50716E+00_JPRB, 9.46654E+00_JPRB, 9.42609E+00_JPRB, &
+     & 9.38581E+00_JPRB, 9.34571E+00_JPRB, 9.30578E+00_JPRB, 9.26602E+00_JPRB, 9.22642E+00_JPRB, &
+     & 9.18700E+00_JPRB, 9.14775E+00_JPRB, 9.10866E+00_JPRB, 9.06974E+00_JPRB, 9.03099E+00_JPRB, &
+     & 8.99240E+00_JPRB, 8.95398E+00_JPRB, 8.91572E+00_JPRB, 8.87762E+00_JPRB/)
+      KAO_MN2O( 5, :, 4) = (/ &
+     & 1.16344E+01_JPRB, 1.16012E+01_JPRB, 1.15681E+01_JPRB, 1.15351E+01_JPRB, 1.15022E+01_JPRB, &
+     & 1.14694E+01_JPRB, 1.14366E+01_JPRB, 1.14040E+01_JPRB, 1.13715E+01_JPRB, 1.13390E+01_JPRB, &
+     & 1.13067E+01_JPRB, 1.12744E+01_JPRB, 1.12422E+01_JPRB, 1.12102E+01_JPRB, 1.11782E+01_JPRB, &
+     & 1.11463E+01_JPRB, 1.11145E+01_JPRB, 1.10828E+01_JPRB, 1.10511E+01_JPRB/)
+      KAO_MN2O( 6, :, 4) = (/ &
+     & 1.12460E+01_JPRB, 1.12402E+01_JPRB, 1.12344E+01_JPRB, 1.12286E+01_JPRB, 1.12228E+01_JPRB, &
+     & 1.12170E+01_JPRB, 1.12112E+01_JPRB, 1.12055E+01_JPRB, 1.11997E+01_JPRB, 1.11939E+01_JPRB, &
+     & 1.11882E+01_JPRB, 1.11824E+01_JPRB, 1.11766E+01_JPRB, 1.11709E+01_JPRB, 1.11651E+01_JPRB, &
+     & 1.11594E+01_JPRB, 1.11536E+01_JPRB, 1.11479E+01_JPRB, 1.11421E+01_JPRB/)
+      KAO_MN2O( 7, :, 4) = (/ &
+     & 8.89265E+00_JPRB, 8.91419E+00_JPRB, 8.93578E+00_JPRB, 8.95743E+00_JPRB, 8.97913E+00_JPRB, &
+     & 9.00088E+00_JPRB, 9.02268E+00_JPRB, 9.04454E+00_JPRB, 9.06645E+00_JPRB, 9.08841E+00_JPRB, &
+     & 9.11043E+00_JPRB, 9.13250E+00_JPRB, 9.15462E+00_JPRB, 9.17680E+00_JPRB, 9.19903E+00_JPRB, &
+     & 9.22131E+00_JPRB, 9.24365E+00_JPRB, 9.26604E+00_JPRB, 9.28849E+00_JPRB/)
+      KAO_MN2O( 8, :, 4) = (/ &
+     & 6.83933E+00_JPRB, 6.86688E+00_JPRB, 6.89453E+00_JPRB, 6.92230E+00_JPRB, 6.95018E+00_JPRB, &
+     & 6.97817E+00_JPRB, 7.00627E+00_JPRB, 7.03449E+00_JPRB, 7.06282E+00_JPRB, 7.09126E+00_JPRB, &
+     & 7.11982E+00_JPRB, 7.14850E+00_JPRB, 7.17729E+00_JPRB, 7.20619E+00_JPRB, 7.23521E+00_JPRB, &
+     & 7.26435E+00_JPRB, 7.29361E+00_JPRB, 7.32298E+00_JPRB, 7.35248E+00_JPRB/)
+      KAO_MN2O( 9, :, 4) = (/ &
+     & 1.10637E+01_JPRB, 1.10232E+01_JPRB, 1.09829E+01_JPRB, 1.09427E+01_JPRB, 1.09026E+01_JPRB, &
+     & 1.08627E+01_JPRB, 1.08230E+01_JPRB, 1.07833E+01_JPRB, 1.07439E+01_JPRB, 1.07046E+01_JPRB, &
+     & 1.06654E+01_JPRB, 1.06263E+01_JPRB, 1.05875E+01_JPRB, 1.05487E+01_JPRB, 1.05101E+01_JPRB, &
+     & 1.04716E+01_JPRB, 1.04333E+01_JPRB, 1.03951E+01_JPRB, 1.03571E+01_JPRB/)
+      KAO_MN2O( 1, :, 5) = (/ &
+     & 2.53460E+00_JPRB, 2.56050E+00_JPRB, 2.58667E+00_JPRB, 2.61310E+00_JPRB, 2.63980E+00_JPRB, &
+     & 2.66678E+00_JPRB, 2.69403E+00_JPRB, 2.72156E+00_JPRB, 2.74937E+00_JPRB, 2.77746E+00_JPRB, &
+     & 2.80585E+00_JPRB, 2.83452E+00_JPRB, 2.86348E+00_JPRB, 2.89275E+00_JPRB, 2.92231E+00_JPRB, &
+     & 2.95217E+00_JPRB, 2.98234E+00_JPRB, 3.01281E+00_JPRB, 3.04360E+00_JPRB/)
+      KAO_MN2O( 2, :, 5) = (/ &
+     & 7.45650E+00_JPRB, 7.44283E+00_JPRB, 7.42919E+00_JPRB, 7.41557E+00_JPRB, 7.40198E+00_JPRB, &
+     & 7.38841E+00_JPRB, 7.37487E+00_JPRB, 7.36135E+00_JPRB, 7.34786E+00_JPRB, 7.33439E+00_JPRB, &
+     & 7.32095E+00_JPRB, 7.30753E+00_JPRB, 7.29413E+00_JPRB, 7.28076E+00_JPRB, 7.26742E+00_JPRB, &
+     & 7.25410E+00_JPRB, 7.24080E+00_JPRB, 7.22753E+00_JPRB, 7.21428E+00_JPRB/)
+      KAO_MN2O( 3, :, 5) = (/ &
+     & 1.06311E+01_JPRB, 1.06110E+01_JPRB, 1.05909E+01_JPRB, 1.05709E+01_JPRB, 1.05509E+01_JPRB, &
+     & 1.05310E+01_JPRB, 1.05111E+01_JPRB, 1.04912E+01_JPRB, 1.04713E+01_JPRB, 1.04516E+01_JPRB, &
+     & 1.04318E+01_JPRB, 1.04121E+01_JPRB, 1.03924E+01_JPRB, 1.03727E+01_JPRB, 1.03531E+01_JPRB, &
+     & 1.03336E+01_JPRB, 1.03140E+01_JPRB, 1.02945E+01_JPRB, 1.02751E+01_JPRB/)
+      KAO_MN2O( 4, :, 5) = (/ &
+     & 1.03924E+01_JPRB, 1.03895E+01_JPRB, 1.03867E+01_JPRB, 1.03838E+01_JPRB, 1.03809E+01_JPRB, &
+     & 1.03780E+01_JPRB, 1.03751E+01_JPRB, 1.03722E+01_JPRB, 1.03693E+01_JPRB, 1.03665E+01_JPRB, &
+     & 1.03636E+01_JPRB, 1.03607E+01_JPRB, 1.03578E+01_JPRB, 1.03549E+01_JPRB, 1.03521E+01_JPRB, &
+     & 1.03492E+01_JPRB, 1.03463E+01_JPRB, 1.03434E+01_JPRB, 1.03406E+01_JPRB/)
+      KAO_MN2O( 5, :, 5) = (/ &
+     & 7.82277E+00_JPRB, 7.83872E+00_JPRB, 7.85471E+00_JPRB, 7.87073E+00_JPRB, 7.88678E+00_JPRB, &
+     & 7.90287E+00_JPRB, 7.91899E+00_JPRB, 7.93514E+00_JPRB, 7.95132E+00_JPRB, 7.96754E+00_JPRB, &
+     & 7.98379E+00_JPRB, 8.00008E+00_JPRB, 8.01639E+00_JPRB, 8.03274E+00_JPRB, 8.04913E+00_JPRB, &
+     & 8.06555E+00_JPRB, 8.08200E+00_JPRB, 8.09848E+00_JPRB, 8.11500E+00_JPRB/)
+      KAO_MN2O( 6, :, 5) = (/ &
+     & 6.05225E+00_JPRB, 6.06883E+00_JPRB, 6.08545E+00_JPRB, 6.10212E+00_JPRB, 6.11883E+00_JPRB, &
+     & 6.13559E+00_JPRB, 6.15240E+00_JPRB, 6.16925E+00_JPRB, 6.18615E+00_JPRB, 6.20309E+00_JPRB, &
+     & 6.22008E+00_JPRB, 6.23712E+00_JPRB, 6.25420E+00_JPRB, 6.27133E+00_JPRB, 6.28851E+00_JPRB, &
+     & 6.30574E+00_JPRB, 6.32301E+00_JPRB, 6.34033E+00_JPRB, 6.35769E+00_JPRB/)
+      KAO_MN2O( 7, :, 5) = (/ &
+     & 5.24135E+00_JPRB, 5.25696E+00_JPRB, 5.27261E+00_JPRB, 5.28831E+00_JPRB, 5.30405E+00_JPRB, &
+     & 5.31984E+00_JPRB, 5.33568E+00_JPRB, 5.35157E+00_JPRB, 5.36750E+00_JPRB, 5.38348E+00_JPRB, &
+     & 5.39951E+00_JPRB, 5.41558E+00_JPRB, 5.43171E+00_JPRB, 5.44788E+00_JPRB, 5.46410E+00_JPRB, &
+     & 5.48037E+00_JPRB, 5.49668E+00_JPRB, 5.51305E+00_JPRB, 5.52946E+00_JPRB/)
+      KAO_MN2O( 8, :, 5) = (/ &
+     & 4.40240E+00_JPRB, 4.40915E+00_JPRB, 4.41591E+00_JPRB, 4.42268E+00_JPRB, 4.42946E+00_JPRB, &
+     & 4.43625E+00_JPRB, 4.44305E+00_JPRB, 4.44986E+00_JPRB, 4.45668E+00_JPRB, 4.46351E+00_JPRB, &
+     & 4.47035E+00_JPRB, 4.47720E+00_JPRB, 4.48407E+00_JPRB, 4.49094E+00_JPRB, 4.49782E+00_JPRB, &
+     & 4.50472E+00_JPRB, 4.51162E+00_JPRB, 4.51854E+00_JPRB, 4.52547E+00_JPRB/)
+      KAO_MN2O( 9, :, 5) = (/ &
+     & 8.56554E+00_JPRB, 8.59185E+00_JPRB, 8.61824E+00_JPRB, 8.64470E+00_JPRB, 8.67125E+00_JPRB, &
+     & 8.69788E+00_JPRB, 8.72460E+00_JPRB, 8.75139E+00_JPRB, 8.77827E+00_JPRB, 8.80523E+00_JPRB, &
+     & 8.83227E+00_JPRB, 8.85939E+00_JPRB, 8.88660E+00_JPRB, 8.91389E+00_JPRB, 8.94127E+00_JPRB, &
+     & 8.96873E+00_JPRB, 8.99627E+00_JPRB, 9.02390E+00_JPRB, 9.05161E+00_JPRB/)
+      KAO_MN2O( 1, :, 6) = (/ &
+     & 5.78695E+00_JPRB, 5.78939E+00_JPRB, 5.79182E+00_JPRB, 5.79426E+00_JPRB, 5.79670E+00_JPRB, &
+     & 5.79914E+00_JPRB, 5.80158E+00_JPRB, 5.80403E+00_JPRB, 5.80647E+00_JPRB, 5.80892E+00_JPRB, &
+     & 5.81136E+00_JPRB, 5.81381E+00_JPRB, 5.81626E+00_JPRB, 5.81870E+00_JPRB, 5.82115E+00_JPRB, &
+     & 5.82361E+00_JPRB, 5.82606E+00_JPRB, 5.82851E+00_JPRB, 5.83096E+00_JPRB/)
+      KAO_MN2O( 2, :, 6) = (/ &
+     & 1.22893E+01_JPRB, 1.22556E+01_JPRB, 1.22221E+01_JPRB, 1.21886E+01_JPRB, 1.21552E+01_JPRB, &
+     & 1.21220E+01_JPRB, 1.20888E+01_JPRB, 1.20557E+01_JPRB, 1.20227E+01_JPRB, 1.19898E+01_JPRB, &
+     & 1.19569E+01_JPRB, 1.19242E+01_JPRB, 1.18915E+01_JPRB, 1.18590E+01_JPRB, 1.18265E+01_JPRB, &
+     & 1.17941E+01_JPRB, 1.17618E+01_JPRB, 1.17296E+01_JPRB, 1.16975E+01_JPRB/)
+      KAO_MN2O( 3, :, 6) = (/ &
+     & 7.93118E+00_JPRB, 7.94590E+00_JPRB, 7.96065E+00_JPRB, 7.97542E+00_JPRB, 7.99022E+00_JPRB, &
+     & 8.00505E+00_JPRB, 8.01990E+00_JPRB, 8.03478E+00_JPRB, 8.04970E+00_JPRB, 8.06463E+00_JPRB, &
+     & 8.07960E+00_JPRB, 8.09459E+00_JPRB, 8.10961E+00_JPRB, 8.12466E+00_JPRB, 8.13974E+00_JPRB, &
+     & 8.15485E+00_JPRB, 8.16998E+00_JPRB, 8.18514E+00_JPRB, 8.20033E+00_JPRB/)
+      KAO_MN2O( 4, :, 6) = (/ &
+     & 4.08899E+00_JPRB, 4.11435E+00_JPRB, 4.13988E+00_JPRB, 4.16556E+00_JPRB, 4.19140E+00_JPRB, &
+     & 4.21740E+00_JPRB, 4.24357E+00_JPRB, 4.26989E+00_JPRB, 4.29638E+00_JPRB, 4.32304E+00_JPRB, &
+     & 4.34985E+00_JPRB, 4.37684E+00_JPRB, 4.40399E+00_JPRB, 4.43131E+00_JPRB, 4.45880E+00_JPRB, &
+     & 4.48646E+00_JPRB, 4.51430E+00_JPRB, 4.54230E+00_JPRB, 4.57048E+00_JPRB/)
+      KAO_MN2O( 5, :, 6) = (/ &
+     & 2.61358E+00_JPRB, 2.64029E+00_JPRB, 2.66728E+00_JPRB, 2.69454E+00_JPRB, 2.72209E+00_JPRB, &
+     & 2.74991E+00_JPRB, 2.77802E+00_JPRB, 2.80641E+00_JPRB, 2.83510E+00_JPRB, 2.86408E+00_JPRB, &
+     & 2.89335E+00_JPRB, 2.92293E+00_JPRB, 2.95280E+00_JPRB, 2.98299E+00_JPRB, 3.01348E+00_JPRB, &
+     & 3.04428E+00_JPRB, 3.07540E+00_JPRB, 3.10683E+00_JPRB, 3.13859E+00_JPRB/)
+      KAO_MN2O( 6, :, 6) = (/ &
+     & 2.40720E+00_JPRB, 2.43430E+00_JPRB, 2.46169E+00_JPRB, 2.48940E+00_JPRB, 2.51741E+00_JPRB, &
+     & 2.54575E+00_JPRB, 2.57440E+00_JPRB, 2.60337E+00_JPRB, 2.63267E+00_JPRB, 2.66230E+00_JPRB, &
+     & 2.69226E+00_JPRB, 2.72256E+00_JPRB, 2.75320E+00_JPRB, 2.78419E+00_JPRB, 2.81552E+00_JPRB, &
+     & 2.84721E+00_JPRB, 2.87925E+00_JPRB, 2.91166E+00_JPRB, 2.94443E+00_JPRB/)
+      KAO_MN2O( 7, :, 6) = (/ &
+     & 1.99607E+00_JPRB, 2.01725E+00_JPRB, 2.03865E+00_JPRB, 2.06028E+00_JPRB, 2.08214E+00_JPRB, &
+     & 2.10423E+00_JPRB, 2.12655E+00_JPRB, 2.14912E+00_JPRB, 2.17192E+00_JPRB, 2.19496E+00_JPRB, &
+     & 2.21825E+00_JPRB, 2.24179E+00_JPRB, 2.26557E+00_JPRB, 2.28961E+00_JPRB, 2.31390E+00_JPRB, &
+     & 2.33845E+00_JPRB, 2.36326E+00_JPRB, 2.38834E+00_JPRB, 2.41368E+00_JPRB/)
+      KAO_MN2O( 8, :, 6) = (/ &
+     & 1.94150E+00_JPRB, 1.96398E+00_JPRB, 1.98671E+00_JPRB, 2.00971E+00_JPRB, 2.03298E+00_JPRB, &
+     & 2.05651E+00_JPRB, 2.08032E+00_JPRB, 2.10440E+00_JPRB, 2.12876E+00_JPRB, 2.15341E+00_JPRB, &
+     & 2.17834E+00_JPRB, 2.20355E+00_JPRB, 2.22906E+00_JPRB, 2.25487E+00_JPRB, 2.28097E+00_JPRB, &
+     & 2.30738E+00_JPRB, 2.33409E+00_JPRB, 2.36111E+00_JPRB, 2.38844E+00_JPRB/)
+      KAO_MN2O( 9, :, 6) = (/ &
+     & 2.47259E+00_JPRB, 2.48950E+00_JPRB, 2.50653E+00_JPRB, 2.52367E+00_JPRB, 2.54093E+00_JPRB, &
+     & 2.55831E+00_JPRB, 2.57581E+00_JPRB, 2.59343E+00_JPRB, 2.61117E+00_JPRB, 2.62903E+00_JPRB, &
+     & 2.64701E+00_JPRB, 2.66511E+00_JPRB, 2.68334E+00_JPRB, 2.70169E+00_JPRB, 2.72017E+00_JPRB, &
+     & 2.73878E+00_JPRB, 2.75751E+00_JPRB, 2.77637E+00_JPRB, 2.79536E+00_JPRB/)
+      KAO_MN2O( 1, :, 7) = (/ &
+     & 1.23417E+01_JPRB, 1.22618E+01_JPRB, 1.21823E+01_JPRB, 1.21034E+01_JPRB, 1.20250E+01_JPRB, &
+     & 1.19471E+01_JPRB, 1.18697E+01_JPRB, 1.17928E+01_JPRB, 1.17164E+01_JPRB, 1.16405E+01_JPRB, &
+     & 1.15651E+01_JPRB, 1.14901E+01_JPRB, 1.14157E+01_JPRB, 1.13417E+01_JPRB, 1.12683E+01_JPRB, &
+     & 1.11952E+01_JPRB, 1.11227E+01_JPRB, 1.10507E+01_JPRB, 1.09791E+01_JPRB/)
+      KAO_MN2O( 2, :, 7) = (/ &
+     & 9.30957E+00_JPRB, 9.32775E+00_JPRB, 9.34597E+00_JPRB, 9.36421E+00_JPRB, 9.38250E+00_JPRB, &
+     & 9.40082E+00_JPRB, 9.41918E+00_JPRB, 9.43757E+00_JPRB, 9.45600E+00_JPRB, 9.47446E+00_JPRB, &
+     & 9.49296E+00_JPRB, 9.51150E+00_JPRB, 9.53007E+00_JPRB, 9.54868E+00_JPRB, 9.56732E+00_JPRB, &
+     & 9.58601E+00_JPRB, 9.60472E+00_JPRB, 9.62348E+00_JPRB, 9.64227E+00_JPRB/)
+      KAO_MN2O( 3, :, 7) = (/ &
+     & 4.15867E+00_JPRB, 4.19254E+00_JPRB, 4.22668E+00_JPRB, 4.26110E+00_JPRB, 4.29581E+00_JPRB, &
+     & 4.33079E+00_JPRB, 4.36606E+00_JPRB, 4.40162E+00_JPRB, 4.43747E+00_JPRB, 4.47360E+00_JPRB, &
+     & 4.51004E+00_JPRB, 4.54677E+00_JPRB, 4.58380E+00_JPRB, 4.62113E+00_JPRB, 4.65876E+00_JPRB, &
+     & 4.69670E+00_JPRB, 4.73495E+00_JPRB, 4.77351E+00_JPRB, 4.81239E+00_JPRB/)
+      KAO_MN2O( 4, :, 7) = (/ &
+     & 3.55634E+00_JPRB, 3.59382E+00_JPRB, 3.63169E+00_JPRB, 3.66996E+00_JPRB, 3.70863E+00_JPRB, &
+     & 3.74771E+00_JPRB, 3.78720E+00_JPRB, 3.82711E+00_JPRB, 3.86744E+00_JPRB, 3.90820E+00_JPRB, &
+     & 3.94938E+00_JPRB, 3.99100E+00_JPRB, 4.03305E+00_JPRB, 4.07555E+00_JPRB, 4.11850E+00_JPRB, &
+     & 4.16190E+00_JPRB, 4.20576E+00_JPRB, 4.25008E+00_JPRB, 4.29486E+00_JPRB/)
+      KAO_MN2O( 5, :, 7) = (/ &
+     & 3.09468E+00_JPRB, 3.12655E+00_JPRB, 3.15876E+00_JPRB, 3.19129E+00_JPRB, 3.22416E+00_JPRB, &
+     & 3.25737E+00_JPRB, 3.29092E+00_JPRB, 3.32482E+00_JPRB, 3.35907E+00_JPRB, 3.39366E+00_JPRB, &
+     & 3.42862E+00_JPRB, 3.46393E+00_JPRB, 3.49961E+00_JPRB, 3.53566E+00_JPRB, 3.57208E+00_JPRB, &
+     & 3.60887E+00_JPRB, 3.64604E+00_JPRB, 3.68360E+00_JPRB, 3.72154E+00_JPRB/)
+      KAO_MN2O( 6, :, 7) = (/ &
+     & 2.75473E+00_JPRB, 2.78356E+00_JPRB, 2.81268E+00_JPRB, 2.84211E+00_JPRB, 2.87185E+00_JPRB, &
+     & 2.90190E+00_JPRB, 2.93227E+00_JPRB, 2.96295E+00_JPRB, 2.99395E+00_JPRB, 3.02528E+00_JPRB, &
+     & 3.05694E+00_JPRB, 3.08892E+00_JPRB, 3.12125E+00_JPRB, 3.15391E+00_JPRB, 3.18691E+00_JPRB, &
+     & 3.22025E+00_JPRB, 3.25395E+00_JPRB, 3.28800E+00_JPRB, 3.32240E+00_JPRB/)
+      KAO_MN2O( 7, :, 7) = (/ &
+     & 2.68587E+00_JPRB, 2.71431E+00_JPRB, 2.74306E+00_JPRB, 2.77211E+00_JPRB, 2.80146E+00_JPRB, &
+     & 2.83113E+00_JPRB, 2.86111E+00_JPRB, 2.89141E+00_JPRB, 2.92203E+00_JPRB, 2.95298E+00_JPRB, &
+     & 2.98425E+00_JPRB, 3.01585E+00_JPRB, 3.04779E+00_JPRB, 3.08006E+00_JPRB, 3.11268E+00_JPRB, &
+     & 3.14564E+00_JPRB, 3.17896E+00_JPRB, 3.21262E+00_JPRB, 3.24664E+00_JPRB/)
+      KAO_MN2O( 8, :, 7) = (/ &
+     & 2.54778E+00_JPRB, 2.57461E+00_JPRB, 2.60173E+00_JPRB, 2.62914E+00_JPRB, 2.65683E+00_JPRB, &
+     & 2.68482E+00_JPRB, 2.71310E+00_JPRB, 2.74168E+00_JPRB, 2.77056E+00_JPRB, 2.79974E+00_JPRB, &
+     & 2.82923E+00_JPRB, 2.85903E+00_JPRB, 2.88915E+00_JPRB, 2.91958E+00_JPRB, 2.95033E+00_JPRB, &
+     & 2.98141E+00_JPRB, 3.01282E+00_JPRB, 3.04455E+00_JPRB, 3.07662E+00_JPRB/)
+      KAO_MN2O( 9, :, 7) = (/ &
+     & 2.78137E+00_JPRB, 2.80957E+00_JPRB, 2.83805E+00_JPRB, 2.86682E+00_JPRB, 2.89589E+00_JPRB, &
+     & 2.92525E+00_JPRB, 2.95491E+00_JPRB, 2.98486E+00_JPRB, 3.01512E+00_JPRB, 3.04569E+00_JPRB, &
+     & 3.07657E+00_JPRB, 3.10776E+00_JPRB, 3.13927E+00_JPRB, 3.17110E+00_JPRB, 3.20324E+00_JPRB, &
+     & 3.23572E+00_JPRB, 3.26852E+00_JPRB, 3.30166E+00_JPRB, 3.33513E+00_JPRB/)
+      KAO_MN2O( 1, :, 8) = (/ &
+     & 2.28384E+01_JPRB, 2.27450E+01_JPRB, 2.26519E+01_JPRB, 2.25593E+01_JPRB, 2.24670E+01_JPRB, &
+     & 2.23751E+01_JPRB, 2.22835E+01_JPRB, 2.21924E+01_JPRB, 2.21016E+01_JPRB, 2.20112E+01_JPRB, &
+     & 2.19211E+01_JPRB, 2.18314E+01_JPRB, 2.17421E+01_JPRB, 2.16532E+01_JPRB, 2.15646E+01_JPRB, &
+     & 2.14764E+01_JPRB, 2.13885E+01_JPRB, 2.13010E+01_JPRB, 2.12139E+01_JPRB/)
+      KAO_MN2O( 2, :, 8) = (/ &
+     & 4.48608E+00_JPRB, 4.52259E+00_JPRB, 4.55939E+00_JPRB, 4.59649E+00_JPRB, 4.63389E+00_JPRB, &
+     & 4.67160E+00_JPRB, 4.70961E+00_JPRB, 4.74793E+00_JPRB, 4.78656E+00_JPRB, 4.82551E+00_JPRB, &
+     & 4.86478E+00_JPRB, 4.90436E+00_JPRB, 4.94427E+00_JPRB, 4.98450E+00_JPRB, 5.02506E+00_JPRB, &
+     & 5.06595E+00_JPRB, 5.10717E+00_JPRB, 5.14873E+00_JPRB, 5.19062E+00_JPRB/)
+      KAO_MN2O( 3, :, 8) = (/ &
+     & 3.69928E+00_JPRB, 3.72584E+00_JPRB, 3.75259E+00_JPRB, 3.77953E+00_JPRB, 3.80666E+00_JPRB, &
+     & 3.83399E+00_JPRB, 3.86152E+00_JPRB, 3.88924E+00_JPRB, 3.91717E+00_JPRB, 3.94529E+00_JPRB, &
+     & 3.97361E+00_JPRB, 4.00214E+00_JPRB, 4.03088E+00_JPRB, 4.05982E+00_JPRB, 4.08896E+00_JPRB, &
+     & 4.11832E+00_JPRB, 4.14789E+00_JPRB, 4.17767E+00_JPRB, 4.20766E+00_JPRB/)
+      KAO_MN2O( 4, :, 8) = (/ &
+     & 3.17856E+00_JPRB, 3.19596E+00_JPRB, 3.21345E+00_JPRB, 3.23104E+00_JPRB, 3.24872E+00_JPRB, &
+     & 3.26650E+00_JPRB, 3.28437E+00_JPRB, 3.30235E+00_JPRB, 3.32042E+00_JPRB, 3.33859E+00_JPRB, &
+     & 3.35686E+00_JPRB, 3.37523E+00_JPRB, 3.39370E+00_JPRB, 3.41227E+00_JPRB, 3.43095E+00_JPRB, &
+     & 3.44972E+00_JPRB, 3.46860E+00_JPRB, 3.48758E+00_JPRB, 3.50667E+00_JPRB/)
+      KAO_MN2O( 5, :, 8) = (/ &
+     & 3.16549E+00_JPRB, 3.18288E+00_JPRB, 3.20037E+00_JPRB, 3.21795E+00_JPRB, 3.23563E+00_JPRB, &
+     & 3.25340E+00_JPRB, 3.27128E+00_JPRB, 3.28925E+00_JPRB, 3.30732E+00_JPRB, 3.32549E+00_JPRB, &
+     & 3.34376E+00_JPRB, 3.36213E+00_JPRB, 3.38060E+00_JPRB, 3.39917E+00_JPRB, 3.41785E+00_JPRB, &
+     & 3.43662E+00_JPRB, 3.45551E+00_JPRB, 3.47449E+00_JPRB, 3.49358E+00_JPRB/)
+      KAO_MN2O( 6, :, 8) = (/ &
+     & 3.16612E+00_JPRB, 3.18355E+00_JPRB, 3.20108E+00_JPRB, 3.21870E+00_JPRB, 3.23643E+00_JPRB, &
+     & 3.25425E+00_JPRB, 3.27217E+00_JPRB, 3.29018E+00_JPRB, 3.30830E+00_JPRB, 3.32652E+00_JPRB, &
+     & 3.34483E+00_JPRB, 3.36325E+00_JPRB, 3.38177E+00_JPRB, 3.40039E+00_JPRB, 3.41911E+00_JPRB, &
+     & 3.43794E+00_JPRB, 3.45687E+00_JPRB, 3.47591E+00_JPRB, 3.49505E+00_JPRB/)
+      KAO_MN2O( 7, :, 8) = (/ &
+     & 3.19644E+00_JPRB, 3.21419E+00_JPRB, 3.23203E+00_JPRB, 3.24996E+00_JPRB, 3.26800E+00_JPRB, &
+     & 3.28614E+00_JPRB, 3.30438E+00_JPRB, 3.32272E+00_JPRB, 3.34116E+00_JPRB, 3.35970E+00_JPRB, &
+     & 3.37835E+00_JPRB, 3.39710E+00_JPRB, 3.41596E+00_JPRB, 3.43492E+00_JPRB, 3.45398E+00_JPRB, &
+     & 3.47315E+00_JPRB, 3.49243E+00_JPRB, 3.51181E+00_JPRB, 3.53130E+00_JPRB/)
+      KAO_MN2O( 8, :, 8) = (/ &
+     & 3.35759E+00_JPRB, 3.37775E+00_JPRB, 3.39804E+00_JPRB, 3.41845E+00_JPRB, 3.43899E+00_JPRB, &
+     & 3.45964E+00_JPRB, 3.48042E+00_JPRB, 3.50133E+00_JPRB, 3.52236E+00_JPRB, 3.54351E+00_JPRB, &
+     & 3.56480E+00_JPRB, 3.58621E+00_JPRB, 3.60775E+00_JPRB, 3.62942E+00_JPRB, 3.65122E+00_JPRB, &
+     & 3.67315E+00_JPRB, 3.69521E+00_JPRB, 3.71741E+00_JPRB, 3.73974E+00_JPRB/)
+      KAO_MN2O( 9, :, 8) = (/ &
+     & 3.17378E+00_JPRB, 3.19135E+00_JPRB, 3.20901E+00_JPRB, 3.22677E+00_JPRB, 3.24462E+00_JPRB, &
+     & 3.26258E+00_JPRB, 3.28063E+00_JPRB, 3.29879E+00_JPRB, 3.31704E+00_JPRB, 3.33540E+00_JPRB, &
+     & 3.35386E+00_JPRB, 3.37242E+00_JPRB, 3.39108E+00_JPRB, 3.40984E+00_JPRB, 3.42871E+00_JPRB, &
+     & 3.44769E+00_JPRB, 3.46677E+00_JPRB, 3.48595E+00_JPRB, 3.50524E+00_JPRB/)
+      KAO_MN2O( 1, :, 9) = (/ &
+     & 2.09106E+01_JPRB, 2.08779E+01_JPRB, 2.08452E+01_JPRB, 2.08126E+01_JPRB, 2.07800E+01_JPRB, &
+     & 2.07475E+01_JPRB, 2.07150E+01_JPRB, 2.06826E+01_JPRB, 2.06502E+01_JPRB, 2.06179E+01_JPRB, &
+     & 2.05856E+01_JPRB, 2.05534E+01_JPRB, 2.05213E+01_JPRB, 2.04891E+01_JPRB, 2.04571E+01_JPRB, &
+     & 2.04251E+01_JPRB, 2.03931E+01_JPRB, 2.03612E+01_JPRB, 2.03293E+01_JPRB/)
+      KAO_MN2O( 2, :, 9) = (/ &
+     & 2.60494E+00_JPRB, 2.62757E+00_JPRB, 2.65040E+00_JPRB, 2.67343E+00_JPRB, 2.69665E+00_JPRB, &
+     & 2.72008E+00_JPRB, 2.74372E+00_JPRB, 2.76756E+00_JPRB, 2.79160E+00_JPRB, 2.81586E+00_JPRB, &
+     & 2.84032E+00_JPRB, 2.86500E+00_JPRB, 2.88989E+00_JPRB, 2.91500E+00_JPRB, 2.94033E+00_JPRB, &
+     & 2.96588E+00_JPRB, 2.99164E+00_JPRB, 3.01764E+00_JPRB, 3.04386E+00_JPRB/)
+      KAO_MN2O( 3, :, 9) = (/ &
+     & 2.42238E+00_JPRB, 2.44514E+00_JPRB, 2.46811E+00_JPRB, 2.49130E+00_JPRB, 2.51471E+00_JPRB, &
+     & 2.53834E+00_JPRB, 2.56219E+00_JPRB, 2.58626E+00_JPRB, 2.61056E+00_JPRB, 2.63509E+00_JPRB, &
+     & 2.65985E+00_JPRB, 2.68484E+00_JPRB, 2.71007E+00_JPRB, 2.73554E+00_JPRB, 2.76124E+00_JPRB, &
+     & 2.78718E+00_JPRB, 2.81337E+00_JPRB, 2.83981E+00_JPRB, 2.86649E+00_JPRB/)
+      KAO_MN2O( 4, :, 9) = (/ &
+     & 2.33681E+00_JPRB, 2.35961E+00_JPRB, 2.38263E+00_JPRB, 2.40588E+00_JPRB, 2.42935E+00_JPRB, &
+     & 2.45305E+00_JPRB, 2.47699E+00_JPRB, 2.50115E+00_JPRB, 2.52556E+00_JPRB, 2.55020E+00_JPRB, &
+     & 2.57508E+00_JPRB, 2.60021E+00_JPRB, 2.62558E+00_JPRB, 2.65119E+00_JPRB, 2.67706E+00_JPRB, &
+     & 2.70318E+00_JPRB, 2.72955E+00_JPRB, 2.75619E+00_JPRB, 2.78308E+00_JPRB/)
+      KAO_MN2O( 5, :, 9) = (/ &
+     & 2.26420E+00_JPRB, 2.28696E+00_JPRB, 2.30996E+00_JPRB, 2.33319E+00_JPRB, 2.35665E+00_JPRB, &
+     & 2.38035E+00_JPRB, 2.40429E+00_JPRB, 2.42846E+00_JPRB, 2.45288E+00_JPRB, 2.47755E+00_JPRB, &
+     & 2.50246E+00_JPRB, 2.52763E+00_JPRB, 2.55304E+00_JPRB, 2.57871E+00_JPRB, 2.60465E+00_JPRB, &
+     & 2.63084E+00_JPRB, 2.65729E+00_JPRB, 2.68401E+00_JPRB, 2.71100E+00_JPRB/)
+      KAO_MN2O( 6, :, 9) = (/ &
+     & 2.19628E+00_JPRB, 2.21902E+00_JPRB, 2.24199E+00_JPRB, 2.26520E+00_JPRB, 2.28865E+00_JPRB, &
+     & 2.31234E+00_JPRB, 2.33628E+00_JPRB, 2.36047E+00_JPRB, 2.38491E+00_JPRB, 2.40959E+00_JPRB, &
+     & 2.43454E+00_JPRB, 2.45974E+00_JPRB, 2.48521E+00_JPRB, 2.51094E+00_JPRB, 2.53693E+00_JPRB, &
+     & 2.56319E+00_JPRB, 2.58973E+00_JPRB, 2.61654E+00_JPRB, 2.64363E+00_JPRB/)
+      KAO_MN2O( 7, :, 9) = (/ &
+     & 2.07829E+00_JPRB, 2.10090E+00_JPRB, 2.12375E+00_JPRB, 2.14685E+00_JPRB, 2.17021E+00_JPRB, &
+     & 2.19381E+00_JPRB, 2.21767E+00_JPRB, 2.24180E+00_JPRB, 2.26618E+00_JPRB, 2.29083E+00_JPRB, &
+     & 2.31575E+00_JPRB, 2.34094E+00_JPRB, 2.36640E+00_JPRB, 2.39214E+00_JPRB, 2.41816E+00_JPRB, &
+     & 2.44446E+00_JPRB, 2.47105E+00_JPRB, 2.49793E+00_JPRB, 2.52510E+00_JPRB/)
+      KAO_MN2O( 8, :, 9) = (/ &
+     & 1.68230E+00_JPRB, 1.70305E+00_JPRB, 1.72404E+00_JPRB, 1.74530E+00_JPRB, 1.76681E+00_JPRB, &
+     & 1.78860E+00_JPRB, 1.81065E+00_JPRB, 1.83297E+00_JPRB, 1.85557E+00_JPRB, 1.87845E+00_JPRB, &
+     & 1.90161E+00_JPRB, 1.92505E+00_JPRB, 1.94878E+00_JPRB, 1.97281E+00_JPRB, 1.99713E+00_JPRB, &
+     & 2.02176E+00_JPRB, 2.04668E+00_JPRB, 2.07191E+00_JPRB, 2.09746E+00_JPRB/)
+      KAO_MN2O( 9, :, 9) = (/ &
+     & 2.23224E+00_JPRB, 2.25486E+00_JPRB, 2.27771E+00_JPRB, 2.30079E+00_JPRB, 2.32411E+00_JPRB, &
+     & 2.34766E+00_JPRB, 2.37145E+00_JPRB, 2.39548E+00_JPRB, 2.41975E+00_JPRB, 2.44427E+00_JPRB, &
+     & 2.46904E+00_JPRB, 2.49406E+00_JPRB, 2.51933E+00_JPRB, 2.54486E+00_JPRB, 2.57065E+00_JPRB, &
+     & 2.59670E+00_JPRB, 2.62301E+00_JPRB, 2.64959E+00_JPRB, 2.67644E+00_JPRB/)
+      KAO_MN2O( 1, :,10) = (/ &
+     & 1.30711E+01_JPRB, 1.31853E+01_JPRB, 1.33004E+01_JPRB, 1.34166E+01_JPRB, 1.35339E+01_JPRB, &
+     & 1.36521E+01_JPRB, 1.37714E+01_JPRB, 1.38917E+01_JPRB, 1.40130E+01_JPRB, 1.41355E+01_JPRB, &
+     & 1.42590E+01_JPRB, 1.43835E+01_JPRB, 1.45092E+01_JPRB, 1.46360E+01_JPRB, 1.47638E+01_JPRB, &
+     & 1.48928E+01_JPRB, 1.50229E+01_JPRB, 1.51542E+01_JPRB, 1.52866E+01_JPRB/)
+      KAO_MN2O( 2, :,10) = (/ &
+     & 2.71206E-01_JPRB, 2.90148E-01_JPRB, 3.10413E-01_JPRB, 3.32093E-01_JPRB, 3.55287E-01_JPRB, &
+     & 3.80102E-01_JPRB, 4.06649E-01_JPRB, 4.35051E-01_JPRB, 4.65436E-01_JPRB, 4.97943E-01_JPRB, &
+     & 5.32721E-01_JPRB, 5.69928E-01_JPRB, 6.09733E-01_JPRB, 6.52319E-01_JPRB, 6.97879E-01_JPRB, &
+     & 7.46621E-01_JPRB, 7.98767E-01_JPRB, 8.54555E-01_JPRB, 9.14239E-01_JPRB/)
+      KAO_MN2O( 3, :,10) = (/ &
+     & 2.65609E-01_JPRB, 2.84236E-01_JPRB, 3.04170E-01_JPRB, 3.25501E-01_JPRB, 3.48329E-01_JPRB, &
+     & 3.72758E-01_JPRB, 3.98900E-01_JPRB, 4.26875E-01_JPRB, 4.56812E-01_JPRB, 4.88849E-01_JPRB, &
+     & 5.23132E-01_JPRB, 5.59820E-01_JPRB, 5.99080E-01_JPRB, 6.41095E-01_JPRB, 6.86055E-01_JPRB, &
+     & 7.34169E-01_JPRB, 7.85657E-01_JPRB, 8.40756E-01_JPRB, 8.99718E-01_JPRB/)
+      KAO_MN2O( 4, :,10) = (/ &
+     & 2.55277E-01_JPRB, 2.73370E-01_JPRB, 2.92745E-01_JPRB, 3.13494E-01_JPRB, 3.35714E-01_JPRB, &
+     & 3.59508E-01_JPRB, 3.84989E-01_JPRB, 4.12275E-01_JPRB, 4.41496E-01_JPRB, 4.72788E-01_JPRB, &
+     & 5.06298E-01_JPRB, 5.42183E-01_JPRB, 5.80611E-01_JPRB, 6.21763E-01_JPRB, 6.65831E-01_JPRB, &
+     & 7.13023E-01_JPRB, 7.63560E-01_JPRB, 8.17678E-01_JPRB, 8.75633E-01_JPRB/)
+      KAO_MN2O( 5, :,10) = (/ &
+     & 2.41481E-01_JPRB, 2.58840E-01_JPRB, 2.77446E-01_JPRB, 2.97390E-01_JPRB, 3.18768E-01_JPRB, &
+     & 3.41682E-01_JPRB, 3.66244E-01_JPRB, 3.92571E-01_JPRB, 4.20791E-01_JPRB, 4.51039E-01_JPRB, &
+     & 4.83461E-01_JPRB, 5.18215E-01_JPRB, 5.55466E-01_JPRB, 5.95396E-01_JPRB, 6.38195E-01_JPRB, &
+     & 6.84071E-01_JPRB, 7.33245E-01_JPRB, 7.85954E-01_JPRB, 8.42452E-01_JPRB/)
+      KAO_MN2O( 6, :,10) = (/ &
+     & 2.37173E-01_JPRB, 2.54360E-01_JPRB, 2.72792E-01_JPRB, 2.92559E-01_JPRB, 3.13759E-01_JPRB, &
+     & 3.36495E-01_JPRB, 3.60878E-01_JPRB, 3.87029E-01_JPRB, 4.15074E-01_JPRB, 4.45152E-01_JPRB, &
+     & 4.77409E-01_JPRB, 5.12004E-01_JPRB, 5.49105E-01_JPRB, 5.88895E-01_JPRB, 6.31569E-01_JPRB, &
+     & 6.77334E-01_JPRB, 7.26416E-01_JPRB, 7.79055E-01_JPRB, 8.35508E-01_JPRB/)
+      KAO_MN2O( 7, :,10) = (/ &
+     & 2.27414E-01_JPRB, 2.44231E-01_JPRB, 2.62292E-01_JPRB, 2.81689E-01_JPRB, 3.02520E-01_JPRB, &
+     & 3.24891E-01_JPRB, 3.48917E-01_JPRB, 3.74720E-01_JPRB, 4.02430E-01_JPRB, 4.32190E-01_JPRB, &
+     & 4.64151E-01_JPRB, 4.98475E-01_JPRB, 5.35337E-01_JPRB, 5.74926E-01_JPRB, 6.17442E-01_JPRB, &
+     & 6.63102E-01_JPRB, 7.12138E-01_JPRB, 7.64801E-01_JPRB, 8.21358E-01_JPRB/)
+      KAO_MN2O( 8, :,10) = (/ &
+     & 1.77234E-01_JPRB, 1.92029E-01_JPRB, 2.08060E-01_JPRB, 2.25429E-01_JPRB, 2.44248E-01_JPRB, &
+     & 2.64638E-01_JPRB, 2.86730E-01_JPRB, 3.10667E-01_JPRB, 3.36601E-01_JPRB, 3.64701E-01_JPRB, &
+     & 3.95147E-01_JPRB, 4.28134E-01_JPRB, 4.63875E-01_JPRB, 5.02600E-01_JPRB, 5.44557E-01_JPRB, &
+     & 5.90017E-01_JPRB, 6.39272E-01_JPRB, 6.92639E-01_JPRB, 7.50461E-01_JPRB/)
+      KAO_MN2O( 9, :,10) = (/ &
+     & 2.41727E-01_JPRB, 2.59094E-01_JPRB, 2.77710E-01_JPRB, 2.97662E-01_JPRB, 3.19049E-01_JPRB, &
+     & 3.41972E-01_JPRB, 3.66541E-01_JPRB, 3.92877E-01_JPRB, 4.21104E-01_JPRB, 4.51359E-01_JPRB, &
+     & 4.83788E-01_JPRB, 5.18547E-01_JPRB, 5.55804E-01_JPRB, 5.95737E-01_JPRB, 6.38539E-01_JPRB, &
+     & 6.84417E-01_JPRB, 7.33590E-01_JPRB, 7.86297E-01_JPRB, 8.42790E-01_JPRB/)
+      KAO_MN2O( 1, :,11) = (/ &
+     & 6.65287E+00_JPRB, 6.69137E+00_JPRB, 6.73008E+00_JPRB, 6.76903E+00_JPRB, 6.80820E+00_JPRB, &
+     & 6.84759E+00_JPRB, 6.88721E+00_JPRB, 6.92707E+00_JPRB, 6.96715E+00_JPRB, 7.00746E+00_JPRB, &
+     & 7.04801E+00_JPRB, 7.08879E+00_JPRB, 7.12981E+00_JPRB, 7.17107E+00_JPRB, 7.21256E+00_JPRB, &
+     & 7.25430E+00_JPRB, 7.29628E+00_JPRB, 7.33850E+00_JPRB, 7.38096E+00_JPRB/)
+      KAO_MN2O( 2, :,11) = (/ &
+     & 2.06252E-01_JPRB, 2.27731E-01_JPRB, 2.51447E-01_JPRB, 2.77633E-01_JPRB, 3.06546E-01_JPRB, &
+     & 3.38470E-01_JPRB, 3.73719E-01_JPRB, 4.12638E-01_JPRB, 4.55611E-01_JPRB, 5.03058E-01_JPRB, &
+     & 5.55447E-01_JPRB, 6.13292E-01_JPRB, 6.77160E-01_JPRB, 7.47680E-01_JPRB, 8.25544E-01_JPRB, &
+     & 9.11517E-01_JPRB, 1.00644E+00_JPRB, 1.11125E+00_JPRB, 1.22698E+00_JPRB/)
+      KAO_MN2O( 3, :,11) = (/ &
+     & 2.05840E-01_JPRB, 2.27279E-01_JPRB, 2.50952E-01_JPRB, 2.77090E-01_JPRB, 3.05950E-01_JPRB, &
+     & 3.37816E-01_JPRB, 3.73002E-01_JPRB, 4.11852E-01_JPRB, 4.54748E-01_JPRB, 5.02113E-01_JPRB, &
+     & 5.54411E-01_JPRB, 6.12155E-01_JPRB, 6.75915E-01_JPRB, 7.46315E-01_JPRB, 8.24047E-01_JPRB, &
+     & 9.09876E-01_JPRB, 1.00465E+00_JPRB, 1.10928E+00_JPRB, 1.22482E+00_JPRB/)
+      KAO_MN2O( 4, :,11) = (/ &
+     & 2.04702E-01_JPRB, 2.26031E-01_JPRB, 2.49582E-01_JPRB, 2.75587E-01_JPRB, 3.04301E-01_JPRB, &
+     & 3.36008E-01_JPRB, 3.71018E-01_JPRB, 4.09675E-01_JPRB, 4.52361E-01_JPRB, 4.99495E-01_JPRB, &
+     & 5.51539E-01_JPRB, 6.09007E-01_JPRB, 6.72461E-01_JPRB, 7.42528E-01_JPRB, 8.19895E-01_JPRB, &
+     & 9.05323E-01_JPRB, 9.99653E-01_JPRB, 1.10381E+00_JPRB, 1.21882E+00_JPRB/)
+      KAO_MN2O( 5, :,11) = (/ &
+     & 2.03481E-01_JPRB, 2.24689E-01_JPRB, 2.48108E-01_JPRB, 2.73967E-01_JPRB, 3.02522E-01_JPRB, &
+     & 3.34053E-01_JPRB, 3.68871E-01_JPRB, 4.07317E-01_JPRB, 4.49771E-01_JPRB, 4.96649E-01_JPRB, &
+     & 5.48414E-01_JPRB, 6.05574E-01_JPRB, 6.68691E-01_JPRB, 7.38387E-01_JPRB, 8.15347E-01_JPRB, &
+     & 9.00329E-01_JPRB, 9.94168E-01_JPRB, 1.09779E+00_JPRB, 1.21221E+00_JPRB/)
+      KAO_MN2O( 6, :,11) = (/ &
+     & 2.01513E-01_JPRB, 2.22529E-01_JPRB, 2.45738E-01_JPRB, 2.71367E-01_JPRB, 2.99670E-01_JPRB, &
+     & 3.30924E-01_JPRB, 3.65437E-01_JPRB, 4.03550E-01_JPRB, 4.45639E-01_JPRB, 4.92117E-01_JPRB, &
+     & 5.43442E-01_JPRB, 6.00120E-01_JPRB, 6.62710E-01_JPRB, 7.31827E-01_JPRB, 8.08153E-01_JPRB, &
+     & 8.92439E-01_JPRB, 9.85516E-01_JPRB, 1.08830E+00_JPRB, 1.20180E+00_JPRB/)
+      KAO_MN2O( 7, :,11) = (/ &
+     & 1.97136E-01_JPRB, 2.17723E-01_JPRB, 2.40459E-01_JPRB, 2.65570E-01_JPRB, 2.93304E-01_JPRB, &
+     & 3.23933E-01_JPRB, 3.57762E-01_JPRB, 3.95122E-01_JPRB, 4.36385E-01_JPRB, 4.81956E-01_JPRB, &
+     & 5.32287E-01_JPRB, 5.87873E-01_JPRB, 6.49264E-01_JPRB, 7.17067E-01_JPRB, 7.91950E-01_JPRB, &
+     & 8.74653E-01_JPRB, 9.65992E-01_JPRB, 1.06687E+00_JPRB, 1.17828E+00_JPRB/)
+      KAO_MN2O( 8, :,11) = (/ &
+     & 1.79518E-01_JPRB, 1.98371E-01_JPRB, 2.19204E-01_JPRB, 2.42224E-01_JPRB, 2.67662E-01_JPRB, &
+     & 2.95772E-01_JPRB, 3.26833E-01_JPRB, 3.61157E-01_JPRB, 3.99085E-01_JPRB, 4.40996E-01_JPRB, &
+     & 4.87309E-01_JPRB, 5.38486E-01_JPRB, 5.95037E-01_JPRB, 6.57526E-01_JPRB, 7.26579E-01_JPRB, &
+     & 8.02883E-01_JPRB, 8.87201E-01_JPRB, 9.80373E-01_JPRB, 1.08333E+00_JPRB/)
+      KAO_MN2O( 9, :,11) = (/ &
+     & 2.03481E-01_JPRB, 2.24689E-01_JPRB, 2.48108E-01_JPRB, 2.73967E-01_JPRB, 3.02522E-01_JPRB, &
+     & 3.34053E-01_JPRB, 3.68871E-01_JPRB, 4.07317E-01_JPRB, 4.49771E-01_JPRB, 4.96649E-01_JPRB, &
+     & 5.48414E-01_JPRB, 6.05574E-01_JPRB, 6.68691E-01_JPRB, 7.38387E-01_JPRB, 8.15347E-01_JPRB, &
+     & 9.00329E-01_JPRB, 9.94168E-01_JPRB, 1.09779E+00_JPRB, 1.21221E+00_JPRB/)
+      KAO_MN2O( 1, :,12) = (/ &
+     & 5.89636E+00_JPRB, 5.95081E+00_JPRB, 6.00576E+00_JPRB, 6.06121E+00_JPRB, 6.11718E+00_JPRB, &
+     & 6.17366E+00_JPRB, 6.23067E+00_JPRB, 6.28820E+00_JPRB, 6.34627E+00_JPRB, 6.40487E+00_JPRB, &
+     & 6.46401E+00_JPRB, 6.52369E+00_JPRB, 6.58393E+00_JPRB, 6.64472E+00_JPRB, 6.70608E+00_JPRB, &
+     & 6.76800E+00_JPRB, 6.83050E+00_JPRB, 6.89357E+00_JPRB, 6.95722E+00_JPRB/)
+      KAO_MN2O( 2, :,12) = (/ &
+     & 7.18699E-05_JPRB, 9.48140E-05_JPRB, 1.25083E-04_JPRB, 1.65015E-04_JPRB, 2.17695E-04_JPRB, &
+     & 2.87193E-04_JPRB, 3.78877E-04_JPRB, 4.99831E-04_JPRB, 6.59400E-04_JPRB, 8.69909E-04_JPRB, &
+     & 1.14762E-03_JPRB, 1.51400E-03_JPRB, 1.99733E-03_JPRB, 2.63497E-03_JPRB, 3.47616E-03_JPRB, &
+     & 4.58591E-03_JPRB, 6.04993E-03_JPRB, 7.98133E-03_JPRB, 1.05293E-02_JPRB/)
+      KAO_MN2O( 3, :,12) = (/ &
+     & 7.20868E-05_JPRB, 9.50993E-05_JPRB, 1.25458E-04_JPRB, 1.65508E-04_JPRB, 2.18344E-04_JPRB, &
+     & 2.88046E-04_JPRB, 3.80000E-04_JPRB, 5.01307E-04_JPRB, 6.61341E-04_JPRB, 8.72462E-04_JPRB, &
+     & 1.15098E-03_JPRB, 1.51841E-03_JPRB, 2.00313E-03_JPRB, 2.64260E-03_JPRB, 3.48620E-03_JPRB, &
+     & 4.59911E-03_JPRB, 6.06729E-03_JPRB, 8.00416E-03_JPRB, 1.05593E-02_JPRB/)
+      KAO_MN2O( 4, :,12) = (/ &
+     & 7.21734E-05_JPRB, 9.52161E-05_JPRB, 1.25616E-04_JPRB, 1.65721E-04_JPRB, 2.18630E-04_JPRB, &
+     & 2.88432E-04_JPRB, 3.80519E-04_JPRB, 5.02007E-04_JPRB, 6.62282E-04_JPRB, 8.73727E-04_JPRB, &
+     & 1.15268E-03_JPRB, 1.52070E-03_JPRB, 2.00621E-03_JPRB, 2.64673E-03_JPRB, 3.49174E-03_JPRB, &
+     & 4.60655E-03_JPRB, 6.07727E-03_JPRB, 8.01755E-03_JPRB, 1.05773E-02_JPRB/)
+      KAO_MN2O( 5, :,12) = (/ &
+     & 7.22599E-05_JPRB, 9.53329E-05_JPRB, 1.25773E-04_JPRB, 1.65933E-04_JPRB, 2.18916E-04_JPRB, &
+     & 2.88818E-04_JPRB, 3.81038E-04_JPRB, 5.02706E-04_JPRB, 6.63223E-04_JPRB, 8.74992E-04_JPRB, &
+     & 1.15438E-03_JPRB, 1.52298E-03_JPRB, 2.00928E-03_JPRB, 2.65085E-03_JPRB, 3.49728E-03_JPRB, &
+     & 4.61398E-03_JPRB, 6.08725E-03_JPRB, 8.03094E-03_JPRB, 1.05952E-02_JPRB/)
+      KAO_MN2O( 6, :,12) = (/ &
+     & 7.29962E-05_JPRB, 9.63091E-05_JPRB, 1.27067E-04_JPRB, 1.67649E-04_JPRB, 2.21191E-04_JPRB, &
+     & 2.91833E-04_JPRB, 3.85036E-04_JPRB, 5.08005E-04_JPRB, 6.70247E-04_JPRB, 8.84304E-04_JPRB, &
+     & 1.16672E-03_JPRB, 1.53934E-03_JPRB, 2.03096E-03_JPRB, 2.67959E-03_JPRB, 3.53537E-03_JPRB, &
+     & 4.66447E-03_JPRB, 6.15417E-03_JPRB, 8.11962E-03_JPRB, 1.07128E-02_JPRB/)
+      KAO_MN2O( 7, :,12) = (/ &
+     & 7.47398E-05_JPRB, 9.86139E-05_JPRB, 1.30114E-04_JPRB, 1.71677E-04_JPRB, 2.26516E-04_JPRB, &
+     & 2.98872E-04_JPRB, 3.94340E-04_JPRB, 5.20305E-04_JPRB, 6.86506E-04_JPRB, 9.05797E-04_JPRB, &
+     & 1.19514E-03_JPRB, 1.57690E-03_JPRB, 2.08061E-03_JPRB, 2.74522E-03_JPRB, 3.62213E-03_JPRB, &
+     & 4.77915E-03_JPRB, 6.30576E-03_JPRB, 8.32001E-03_JPRB, 1.09777E-02_JPRB/)
+      KAO_MN2O( 8, :,12) = (/ &
+     & 7.57487E-05_JPRB, 9.99802E-05_JPRB, 1.31963E-04_JPRB, 1.74177E-04_JPRB, 2.29896E-04_JPRB, &
+     & 3.03438E-04_JPRB, 4.00506E-04_JPRB, 5.28625E-04_JPRB, 6.97729E-04_JPRB, 9.20927E-04_JPRB, &
+     & 1.21553E-03_JPRB, 1.60437E-03_JPRB, 2.11759E-03_JPRB, 2.79499E-03_JPRB, 3.68909E-03_JPRB, &
+     & 4.86921E-03_JPRB, 6.42684E-03_JPRB, 8.48274E-03_JPRB, 1.11963E-02_JPRB/)
+      KAO_MN2O( 9, :,12) = (/ &
+     & 7.22467E-05_JPRB, 9.53177E-05_JPRB, 1.25756E-04_JPRB, 1.65915E-04_JPRB, 2.18898E-04_JPRB, &
+     & 2.88800E-04_JPRB, 3.81024E-04_JPRB, 5.02700E-04_JPRB, 6.63231E-04_JPRB, 8.75024E-04_JPRB, &
+     & 1.15445E-03_JPRB, 1.52311E-03_JPRB, 2.00950E-03_JPRB, 2.65121E-03_JPRB, 3.49784E-03_JPRB, &
+     & 4.61483E-03_JPRB, 6.08852E-03_JPRB, 8.03280E-03_JPRB, 1.05980E-02_JPRB/)
+      KAO_MN2O( 1, :,13) = (/ &
+     & 1.14265E+01_JPRB, 1.16380E+01_JPRB, 1.18534E+01_JPRB, 1.20728E+01_JPRB, 1.22962E+01_JPRB, &
+     & 1.25238E+01_JPRB, 1.27556E+01_JPRB, 1.29917E+01_JPRB, 1.32322E+01_JPRB, 1.34771E+01_JPRB, &
+     & 1.37265E+01_JPRB, 1.39806E+01_JPRB, 1.42394E+01_JPRB, 1.45029E+01_JPRB, 1.47714E+01_JPRB, &
+     & 1.50448E+01_JPRB, 1.53232E+01_JPRB, 1.56068E+01_JPRB, 1.58957E+01_JPRB/)
+      KAO_MN2O( 2, :,13) = (/ &
+     & 7.97796E-05_JPRB, 1.05659E-04_JPRB, 1.39932E-04_JPRB, 1.85324E-04_JPRB, 2.45439E-04_JPRB, &
+     & 3.25054E-04_JPRB, 4.30496E-04_JPRB, 5.70140E-04_JPRB, 7.55082E-04_JPRB, 1.00002E-03_JPRB, &
+     & 1.32440E-03_JPRB, 1.75401E-03_JPRB, 2.32298E-03_JPRB, 3.07651E-03_JPRB, 4.07447E-03_JPRB, &
+     & 5.39614E-03_JPRB, 7.14655E-03_JPRB, 9.46475E-03_JPRB, 1.25349E-02_JPRB/)
+      KAO_MN2O( 3, :,13) = (/ &
+     & 7.95035E-05_JPRB, 1.05293E-04_JPRB, 1.39449E-04_JPRB, 1.84684E-04_JPRB, 2.44592E-04_JPRB, &
+     & 3.23934E-04_JPRB, 4.29013E-04_JPRB, 5.68178E-04_JPRB, 7.52486E-04_JPRB, 9.96580E-04_JPRB, &
+     & 1.31985E-03_JPRB, 1.74800E-03_JPRB, 2.31502E-03_JPRB, 3.06597E-03_JPRB, 4.06052E-03_JPRB, &
+     & 5.37770E-03_JPRB, 7.12214E-03_JPRB, 9.43244E-03_JPRB, 1.24922E-02_JPRB/)
+      KAO_MN2O( 4, :,13) = (/ &
+     & 7.92339E-05_JPRB, 1.04938E-04_JPRB, 1.38980E-04_JPRB, 1.84065E-04_JPRB, 2.43776E-04_JPRB, &
+     & 3.22857E-04_JPRB, 4.27593E-04_JPRB, 5.66305E-04_JPRB, 7.50016E-04_JPRB, 9.93322E-04_JPRB, &
+     & 1.31556E-03_JPRB, 1.74233E-03_JPRB, 2.30754E-03_JPRB, 3.05612E-03_JPRB, 4.04752E-03_JPRB, &
+     & 5.36055E-03_JPRB, 7.09953E-03_JPRB, 9.40262E-03_JPRB, 1.24528E-02_JPRB/)
+      KAO_MN2O( 5, :,13) = (/ &
+     & 7.90000E-05_JPRB, 1.04627E-04_JPRB, 1.38566E-04_JPRB, 1.83516E-04_JPRB, 2.43046E-04_JPRB, &
+     & 3.21887E-04_JPRB, 4.26303E-04_JPRB, 5.64591E-04_JPRB, 7.47738E-04_JPRB, 9.90295E-04_JPRB, &
+     & 1.31154E-03_JPRB, 1.73698E-03_JPRB, 2.30044E-03_JPRB, 3.04667E-03_JPRB, 4.03498E-03_JPRB, &
+     & 5.34388E-03_JPRB, 7.07737E-03_JPRB, 9.37318E-03_JPRB, 1.24137E-02_JPRB/)
+      KAO_MN2O( 6, :,13) = (/ &
+     & 7.76004E-05_JPRB, 1.02776E-04_JPRB, 1.36118E-04_JPRB, 1.80278E-04_JPRB, 2.38764E-04_JPRB, &
+     & 3.16224E-04_JPRB, 4.18814E-04_JPRB, 5.54686E-04_JPRB, 7.34638E-04_JPRB, 9.72970E-04_JPRB, &
+     & 1.28862E-03_JPRB, 1.70668E-03_JPRB, 2.26036E-03_JPRB, 2.99367E-03_JPRB, 3.96488E-03_JPRB, &
+     & 5.25118E-03_JPRB, 6.95477E-03_JPRB, 9.21105E-03_JPRB, 1.21993E-02_JPRB/)
+      KAO_MN2O( 7, :,13) = (/ &
+     & 7.52813E-05_JPRB, 9.97094E-05_JPRB, 1.32064E-04_JPRB, 1.74918E-04_JPRB, 2.31677E-04_JPRB, &
+     & 3.06854E-04_JPRB, 4.06426E-04_JPRB, 5.38308E-04_JPRB, 7.12984E-04_JPRB, 9.44341E-04_JPRB, &
+     & 1.25077E-03_JPRB, 1.65664E-03_JPRB, 2.19420E-03_JPRB, 2.90620E-03_JPRB, 3.84923E-03_JPRB, &
+     & 5.09828E-03_JPRB, 6.75263E-03_JPRB, 8.94379E-03_JPRB, 1.18460E-02_JPRB/)
+      KAO_MN2O( 8, :,13) = (/ &
+     & 6.87436E-05_JPRB, 9.10605E-05_JPRB, 1.20622E-04_JPRB, 1.59781E-04_JPRB, 2.11653E-04_JPRB, &
+     & 2.80364E-04_JPRB, 3.71381E-04_JPRB, 4.91946E-04_JPRB, 6.51651E-04_JPRB, 8.63203E-04_JPRB, &
+     & 1.14343E-03_JPRB, 1.51464E-03_JPRB, 2.00635E-03_JPRB, 2.65769E-03_JPRB, 3.52048E-03_JPRB, &
+     & 4.66337E-03_JPRB, 6.17729E-03_JPRB, 8.18269E-03_JPRB, 1.08391E-02_JPRB/)
+      KAO_MN2O( 9, :,13) = (/ &
+     & 7.90357E-05_JPRB, 1.04671E-04_JPRB, 1.38622E-04_JPRB, 1.83585E-04_JPRB, 2.43132E-04_JPRB, &
+     & 3.21994E-04_JPRB, 4.26434E-04_JPRB, 5.64750E-04_JPRB, 7.47931E-04_JPRB, 9.90526E-04_JPRB, &
+     & 1.31181E-03_JPRB, 1.73730E-03_JPRB, 2.30081E-03_JPRB, 3.04709E-03_JPRB, 4.03543E-03_JPRB, &
+     & 5.34435E-03_JPRB, 7.07782E-03_JPRB, 9.37355E-03_JPRB, 1.24139E-02_JPRB/)
+      KAO_MN2O( 1, :,14) = (/ &
+     & 1.61373E+01_JPRB, 1.64784E+01_JPRB, 1.68266E+01_JPRB, 1.71822E+01_JPRB, 1.75454E+01_JPRB, &
+     & 1.79162E+01_JPRB, 1.82948E+01_JPRB, 1.86814E+01_JPRB, 1.90762E+01_JPRB, 1.94794E+01_JPRB, &
+     & 1.98911E+01_JPRB, 2.03114E+01_JPRB, 2.07407E+01_JPRB, 2.11790E+01_JPRB, 2.16266E+01_JPRB, &
+     & 2.20836E+01_JPRB, 2.25504E+01_JPRB, 2.30269E+01_JPRB, 2.35136E+01_JPRB/)
+      KAO_MN2O( 2, :,14) = (/ &
+     & 6.92866E-10_JPRB, 9.24655E-10_JPRB, 1.23398E-09_JPRB, 1.64680E-09_JPRB, 2.19771E-09_JPRB, &
+     & 2.93292E-09_JPRB, 3.91409E-09_JPRB, 5.22349E-09_JPRB, 6.97093E-09_JPRB, 9.30295E-09_JPRB, &
+     & 1.24151E-08_JPRB, 1.65684E-08_JPRB, 2.21111E-08_JPRB, 2.95081E-08_JPRB, 3.93796E-08_JPRB, &
+     & 5.25535E-08_JPRB, 7.01346E-08_JPRB, 9.35970E-08_JPRB, 1.24908E-07_JPRB/)
+      KAO_MN2O( 3, :,14) = (/ &
+     & 6.94564E-10_JPRB, 9.26928E-10_JPRB, 1.23703E-09_JPRB, 1.65088E-09_JPRB, 2.20317E-09_JPRB, &
+     & 2.94024E-09_JPRB, 3.92389E-09_JPRB, 5.23661E-09_JPRB, 6.98851E-09_JPRB, 9.32650E-09_JPRB, &
+     & 1.24467E-08_JPRB, 1.66107E-08_JPRB, 2.21677E-08_JPRB, 2.95839E-08_JPRB, 3.94811E-08_JPRB, &
+     & 5.26894E-08_JPRB, 7.03165E-08_JPRB, 9.38407E-08_JPRB, 1.25235E-07_JPRB/)
+      KAO_MN2O( 4, :,14) = (/ &
+     & 6.98644E-10_JPRB, 9.32310E-10_JPRB, 1.24413E-09_JPRB, 1.66023E-09_JPRB, 2.21551E-09_JPRB, &
+     & 2.95649E-09_JPRB, 3.94531E-09_JPRB, 5.26484E-09_JPRB, 7.02570E-09_JPRB, 9.37548E-09_JPRB, &
+     & 1.25112E-08_JPRB, 1.66956E-08_JPRB, 2.22795E-08_JPRB, 2.97311E-08_JPRB, 3.96748E-08_JPRB, &
+     & 5.29443E-08_JPRB, 7.06518E-08_JPRB, 9.42817E-08_JPRB, 1.25815E-07_JPRB/)
+      KAO_MN2O( 5, :,14) = (/ &
+     & 7.03261E-10_JPRB, 9.38472E-10_JPRB, 1.25235E-09_JPRB, 1.67121E-09_JPRB, 2.23016E-09_JPRB, &
+     & 2.97605E-09_JPRB, 3.97141E-09_JPRB, 5.29968E-09_JPRB, 7.07220E-09_JPRB, 9.43754E-09_JPRB, &
+     & 1.25940E-08_JPRB, 1.68062E-08_JPRB, 2.24271E-08_JPRB, 2.99280E-08_JPRB, 3.99376E-08_JPRB, &
+     & 5.32951E-08_JPRB, 7.11200E-08_JPRB, 9.49066E-08_JPRB, 1.26649E-07_JPRB/)
+      KAO_MN2O( 6, :,14) = (/ &
+     & 7.12478E-10_JPRB, 9.50674E-10_JPRB, 1.26850E-09_JPRB, 1.69259E-09_JPRB, 2.25845E-09_JPRB, &
+     & 3.01350E-09_JPRB, 4.02096E-09_JPRB, 5.36525E-09_JPRB, 7.15896E-09_JPRB, 9.55233E-09_JPRB, &
+     & 1.27459E-08_JPRB, 1.70071E-08_JPRB, 2.26928E-08_JPRB, 3.02795E-08_JPRB, 4.04025E-08_JPRB, &
+     & 5.39099E-08_JPRB, 7.19330E-08_JPRB, 9.59815E-08_JPRB, 1.28070E-07_JPRB/)
+      KAO_MN2O( 7, :,14) = (/ &
+     & 7.28994E-10_JPRB, 9.72644E-10_JPRB, 1.29773E-09_JPRB, 1.73147E-09_JPRB, 2.31017E-09_JPRB, &
+     & 3.08230E-09_JPRB, 4.11249E-09_JPRB, 5.48700E-09_JPRB, 7.32092E-09_JPRB, 9.76777E-09_JPRB, &
+     & 1.30324E-08_JPRB, 1.73883E-08_JPRB, 2.31999E-08_JPRB, 3.09540E-08_JPRB, 4.12996E-08_JPRB, &
+     & 5.51032E-08_JPRB, 7.35203E-08_JPRB, 9.80928E-08_JPRB, 1.30878E-07_JPRB/)
+      KAO_MN2O( 8, :,14) = (/ &
+     & 7.87604E-10_JPRB, 1.05043E-09_JPRB, 1.40097E-09_JPRB, 1.86848E-09_JPRB, 2.49201E-09_JPRB, &
+     & 3.32360E-09_JPRB, 4.43271E-09_JPRB, 5.91194E-09_JPRB, 7.88479E-09_JPRB, 1.05160E-08_JPRB, &
+     & 1.40253E-08_JPRB, 1.87056E-08_JPRB, 2.49478E-08_JPRB, 3.32730E-08_JPRB, 4.43764E-08_JPRB, &
+     & 5.91851E-08_JPRB, 7.89356E-08_JPRB, 1.05277E-07_JPRB, 1.40408E-07_JPRB/)
+      KAO_MN2O( 9, :,14) = (/ &
+     & 7.03261E-10_JPRB, 9.38472E-10_JPRB, 1.25235E-09_JPRB, 1.67121E-09_JPRB, 2.23016E-09_JPRB, &
+     & 2.97605E-09_JPRB, 3.97141E-09_JPRB, 5.29968E-09_JPRB, 7.07220E-09_JPRB, 9.43754E-09_JPRB, &
+     & 1.25940E-08_JPRB, 1.68062E-08_JPRB, 2.24271E-08_JPRB, 2.99280E-08_JPRB, 3.99376E-08_JPRB, &
+     & 5.32951E-08_JPRB, 7.11200E-08_JPRB, 9.49066E-08_JPRB, 1.26649E-07_JPRB/)
+      KAO_MN2O( 1, :,15) = (/ &
+     & 2.14029E+01_JPRB, 2.16782E+01_JPRB, 2.19571E+01_JPRB, 2.22396E+01_JPRB, 2.25257E+01_JPRB, &
+     & 2.28155E+01_JPRB, 2.31090E+01_JPRB, 2.34063E+01_JPRB, 2.37074E+01_JPRB, 2.40124E+01_JPRB, &
+     & 2.43213E+01_JPRB, 2.46342E+01_JPRB, 2.49511E+01_JPRB, 2.52721E+01_JPRB, 2.55972E+01_JPRB, &
+     & 2.59265E+01_JPRB, 2.62600E+01_JPRB, 2.65979E+01_JPRB, 2.69400E+01_JPRB/)
+      KAO_MN2O( 2, :,15) = (/ &
+     & 5.68659E-10_JPRB, 7.55629E-10_JPRB, 1.00407E-09_JPRB, 1.33421E-09_JPRB, 1.77288E-09_JPRB, &
+     & 2.35579E-09_JPRB, 3.13036E-09_JPRB, 4.15960E-09_JPRB, 5.52724E-09_JPRB, 7.34455E-09_JPRB, &
+     & 9.75939E-09_JPRB, 1.29682E-08_JPRB, 1.72320E-08_JPRB, 2.28978E-08_JPRB, 3.04264E-08_JPRB, &
+     & 4.04304E-08_JPRB, 5.37236E-08_JPRB, 7.13875E-08_JPRB, 9.48591E-08_JPRB/)
+      KAO_MN2O( 3, :,15) = (/ &
+     & 5.59573E-10_JPRB, 7.43558E-10_JPRB, 9.88035E-10_JPRB, 1.31290E-09_JPRB, 1.74457E-09_JPRB, &
+     & 2.31817E-09_JPRB, 3.08037E-09_JPRB, 4.09318E-09_JPRB, 5.43900E-09_JPRB, 7.22730E-09_JPRB, &
+     & 9.60360E-09_JPRB, 1.27612E-08_JPRB, 1.69570E-08_JPRB, 2.25324E-08_JPRB, 2.99409E-08_JPRB, &
+     & 3.97853E-08_JPRB, 5.28665E-08_JPRB, 7.02486E-08_JPRB, 9.33459E-08_JPRB/)
+      KAO_MN2O( 4, :,15) = (/ &
+     & 5.50488E-10_JPRB, 7.31486E-10_JPRB, 9.71996E-10_JPRB, 1.29158E-09_JPRB, 1.71625E-09_JPRB, &
+     & 2.28055E-09_JPRB, 3.03039E-09_JPRB, 4.02676E-09_JPRB, 5.35075E-09_JPRB, 7.11005E-09_JPRB, &
+     & 9.44781E-09_JPRB, 1.25542E-08_JPRB, 1.66820E-08_JPRB, 2.21670E-08_JPRB, 2.94554E-08_JPRB, &
+     & 3.91402E-08_JPRB, 5.20093E-08_JPRB, 6.91098E-08_JPRB, 9.18327E-08_JPRB/)
+      KAO_MN2O( 5, :,15) = (/ &
+     & 5.34010E-10_JPRB, 7.09574E-10_JPRB, 9.42858E-10_JPRB, 1.25284E-09_JPRB, 1.66473E-09_JPRB, &
+     & 2.21203E-09_JPRB, 2.93927E-09_JPRB, 3.90560E-09_JPRB, 5.18963E-09_JPRB, 6.89580E-09_JPRB, &
+     & 9.16290E-09_JPRB, 1.21754E-08_JPRB, 1.61782E-08_JPRB, 2.14970E-08_JPRB, 2.85645E-08_JPRB, &
+     & 3.79555E-08_JPRB, 5.04340E-08_JPRB, 6.70149E-08_JPRB, 8.90470E-08_JPRB/)
+      KAO_MN2O( 6, :,15) = (/ &
+     & 5.08144E-10_JPRB, 6.75221E-10_JPRB, 8.97231E-10_JPRB, 1.19224E-09_JPRB, 1.58424E-09_JPRB, &
+     & 2.10513E-09_JPRB, 2.79729E-09_JPRB, 3.71703E-09_JPRB, 4.93919E-09_JPRB, 6.56317E-09_JPRB, &
+     & 8.72112E-09_JPRB, 1.15886E-08_JPRB, 1.53989E-08_JPRB, 2.04620E-08_JPRB, 2.71898E-08_JPRB, &
+     & 3.61297E-08_JPRB, 4.80091E-08_JPRB, 6.37943E-08_JPRB, 8.47696E-08_JPRB/)
+      KAO_MN2O( 7, :,15) = (/ &
+     & 4.56716E-10_JPRB, 6.06884E-10_JPRB, 8.06427E-10_JPRB, 1.07158E-09_JPRB, 1.42391E-09_JPRB, &
+     & 1.89210E-09_JPRB, 2.51422E-09_JPRB, 3.34089E-09_JPRB, 4.43938E-09_JPRB, 5.89904E-09_JPRB, &
+     & 7.83864E-09_JPRB, 1.04160E-08_JPRB, 1.38408E-08_JPRB, 1.83916E-08_JPRB, 2.44387E-08_JPRB, &
+     & 3.24742E-08_JPRB, 4.31517E-08_JPRB, 5.73399E-08_JPRB, 7.61932E-08_JPRB/)
+      KAO_MN2O( 8, :,15) = (/ &
+     & 2.78366E-10_JPRB, 3.69881E-10_JPRB, 4.91482E-10_JPRB, 6.53061E-10_JPRB, 8.67760E-10_JPRB, &
+     & 1.15304E-09_JPRB, 1.53211E-09_JPRB, 2.03581E-09_JPRB, 2.70510E-09_JPRB, 3.59441E-09_JPRB, &
+     & 4.77611E-09_JPRB, 6.34629E-09_JPRB, 8.43268E-09_JPRB, 1.12050E-08_JPRB, 1.48887E-08_JPRB, &
+     & 1.97835E-08_JPRB, 2.62875E-08_JPRB, 3.49296E-08_JPRB, 4.64130E-08_JPRB/)
+      KAO_MN2O( 9, :,15) = (/ &
+     & 5.34010E-10_JPRB, 7.09574E-10_JPRB, 9.42858E-10_JPRB, 1.25284E-09_JPRB, 1.66473E-09_JPRB, &
+     & 2.21203E-09_JPRB, 2.93927E-09_JPRB, 3.90560E-09_JPRB, 5.18963E-09_JPRB, 6.89580E-09_JPRB, &
+     & 9.16290E-09_JPRB, 1.21754E-08_JPRB, 1.61782E-08_JPRB, 2.14970E-08_JPRB, 2.85645E-08_JPRB, &
+     & 3.79555E-08_JPRB, 5.04340E-08_JPRB, 6.70149E-08_JPRB, 8.90470E-08_JPRB/)
+      KAO_MN2O( 1, :,16) = (/ &
+     & 2.90784E+01_JPRB, 2.93787E+01_JPRB, 2.96820E+01_JPRB, 2.99885E+01_JPRB, 3.02982E+01_JPRB, &
+     & 3.06110E+01_JPRB, 3.09271E+01_JPRB, 3.12464E+01_JPRB, 3.15690E+01_JPRB, 3.18950E+01_JPRB, &
+     & 3.22243E+01_JPRB, 3.25571E+01_JPRB, 3.28932E+01_JPRB, 3.32329E+01_JPRB, 3.35760E+01_JPRB, &
+     & 3.39227E+01_JPRB, 3.42730E+01_JPRB, 3.46269E+01_JPRB, 3.49844E+01_JPRB/)
+      KAO_MN2O( 2, :,16) = (/ &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB/)
+      KAO_MN2O( 3, :,16) = (/ &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB/)
+      KAO_MN2O( 4, :,16) = (/ &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB/)
+      KAO_MN2O( 5, :,16) = (/ &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB/)
+      KAO_MN2O( 6, :,16) = (/ &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB/)
+      KAO_MN2O( 7, :,16) = (/ &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB/)
+      KAO_MN2O( 8, :,16) = (/ &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB/)
+      KAO_MN2O( 9, :,16) = (/ &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, &
+     & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB/)
+
+!     The array KBO_Mxx contains the absorption coefficient for 
+!     a minor species at the 16 chosen g-values for a reference pressure
+!     level above 100~ mb.   The first index refers to temperature 
+!     in 7.2 degree increments.  For instance, JT = 1 refers to a 
+!     temperature of 188.0, JT = 2 refers to 195.2, etc. The second index 
+!     runs over the g-channel (1 to 16).
+
+      KBO_MN2O(:, 1) = (/ &
+     & 8.42688E-03_JPRB, 8.96787E-03_JPRB, 9.54358E-03_JPRB, 1.01563E-02_JPRB, 1.08083E-02_JPRB, &
+     & 1.15021E-02_JPRB, 1.22405E-02_JPRB, 1.30263E-02_JPRB, 1.38626E-02_JPRB, 1.47525E-02_JPRB, &
+     & 1.56996E-02_JPRB, 1.67075E-02_JPRB, 1.77800E-02_JPRB, 1.89215E-02_JPRB, 2.01362E-02_JPRB, &
+     & 2.14289E-02_JPRB, 2.28045E-02_JPRB, 2.42685E-02_JPRB, 2.58265E-02_JPRB/)
+      KBO_MN2O(:, 2) = (/ &
+     & 2.24976E-02_JPRB, 2.38935E-02_JPRB, 2.53762E-02_JPRB, 2.69508E-02_JPRB, 2.86231E-02_JPRB, &
+     & 3.03991E-02_JPRB, 3.22854E-02_JPRB, 3.42887E-02_JPRB, 3.64163E-02_JPRB, 3.86760E-02_JPRB, &
+     & 4.10759E-02_JPRB, 4.36246E-02_JPRB, 4.63315E-02_JPRB, 4.92064E-02_JPRB, 5.22597E-02_JPRB, &
+     & 5.55024E-02_JPRB, 5.89464E-02_JPRB, 6.26040E-02_JPRB, 6.64886E-02_JPRB/)
+      KBO_MN2O(:, 3) = (/ &
+     & 5.93542E-02_JPRB, 6.37312E-02_JPRB, 6.84310E-02_JPRB, 7.34774E-02_JPRB, 7.88960E-02_JPRB, &
+     & 8.47141E-02_JPRB, 9.09613E-02_JPRB, 9.76692E-02_JPRB, 1.04872E-01_JPRB, 1.12605E-01_JPRB, &
+     & 1.20910E-01_JPRB, 1.29826E-01_JPRB, 1.39400E-01_JPRB, 1.49680E-01_JPRB, 1.60718E-01_JPRB, &
+     & 1.72570E-01_JPRB, 1.85296E-01_JPRB, 1.98961E-01_JPRB, 2.13633E-01_JPRB/)
+      KBO_MN2O(:, 4) = (/ &
+     & 1.98022E-01_JPRB, 2.05895E-01_JPRB, 2.14082E-01_JPRB, 2.22594E-01_JPRB, 2.31445E-01_JPRB, &
+     & 2.40647E-01_JPRB, 2.50216E-01_JPRB, 2.60164E-01_JPRB, 2.70509E-01_JPRB, 2.81265E-01_JPRB, &
+     & 2.92448E-01_JPRB, 3.04076E-01_JPRB, 3.16167E-01_JPRB, 3.28738E-01_JPRB, 3.41809E-01_JPRB, &
+     & 3.55400E-01_JPRB, 3.69531E-01_JPRB, 3.84224E-01_JPRB, 3.99501E-01_JPRB/)
+      KBO_MN2O(:, 5) = (/ &
+     & 6.41413E-01_JPRB, 6.46239E-01_JPRB, 6.51101E-01_JPRB, 6.56000E-01_JPRB, 6.60936E-01_JPRB, &
+     & 6.65910E-01_JPRB, 6.70920E-01_JPRB, 6.75968E-01_JPRB, 6.81054E-01_JPRB, 6.86179E-01_JPRB, &
+     & 6.91342E-01_JPRB, 6.96544E-01_JPRB, 7.01785E-01_JPRB, 7.07065E-01_JPRB, 7.12385E-01_JPRB, &
+     & 7.17746E-01_JPRB, 7.23146E-01_JPRB, 7.28587E-01_JPRB, 7.34070E-01_JPRB/)
+      KBO_MN2O(:, 6) = (/ &
+     & 1.47906E+00_JPRB, 1.48768E+00_JPRB, 1.49635E+00_JPRB, 1.50507E+00_JPRB, 1.51384E+00_JPRB, &
+     & 1.52267E+00_JPRB, 1.53154E+00_JPRB, 1.54047E+00_JPRB, 1.54944E+00_JPRB, 1.55847E+00_JPRB, &
+     & 1.56755E+00_JPRB, 1.57669E+00_JPRB, 1.58588E+00_JPRB, 1.59512E+00_JPRB, 1.60442E+00_JPRB, &
+     & 1.61377E+00_JPRB, 1.62317E+00_JPRB, 1.63263E+00_JPRB, 1.64215E+00_JPRB/)
+      KBO_MN2O(:, 7) = (/ &
+     & 3.53152E+00_JPRB, 3.55492E+00_JPRB, 3.57848E+00_JPRB, 3.60219E+00_JPRB, 3.62606E+00_JPRB, &
+     & 3.65008E+00_JPRB, 3.67427E+00_JPRB, 3.69862E+00_JPRB, 3.72313E+00_JPRB, 3.74780E+00_JPRB, &
+     & 3.77263E+00_JPRB, 3.79763E+00_JPRB, 3.82279E+00_JPRB, 3.84812E+00_JPRB, 3.87362E+00_JPRB, &
+     & 3.89929E+00_JPRB, 3.92513E+00_JPRB, 3.95114E+00_JPRB, 3.97732E+00_JPRB/)
+      KBO_MN2O(:, 8) = (/ &
+     & 9.06783E+00_JPRB, 9.04597E+00_JPRB, 9.02415E+00_JPRB, 9.00239E+00_JPRB, 8.98069E+00_JPRB, &
+     & 8.95903E+00_JPRB, 8.93743E+00_JPRB, 8.91588E+00_JPRB, 8.89438E+00_JPRB, 8.87293E+00_JPRB, &
+     & 8.85154E+00_JPRB, 8.83020E+00_JPRB, 8.80890E+00_JPRB, 8.78766E+00_JPRB, 8.76647E+00_JPRB, &
+     & 8.74533E+00_JPRB, 8.72425E+00_JPRB, 8.70321E+00_JPRB, 8.68223E+00_JPRB/)
+      KBO_MN2O(:, 9) = (/ &
+     & 3.88220E+01_JPRB, 3.85805E+01_JPRB, 3.83405E+01_JPRB, 3.81019E+01_JPRB, 3.78649E+01_JPRB, &
+     & 3.76293E+01_JPRB, 3.73952E+01_JPRB, 3.71625E+01_JPRB, 3.69313E+01_JPRB, 3.67016E+01_JPRB, &
+     & 3.64732E+01_JPRB, 3.62463E+01_JPRB, 3.60208E+01_JPRB, 3.57967E+01_JPRB, 3.55740E+01_JPRB, &
+     & 3.53527E+01_JPRB, 3.51327E+01_JPRB, 3.49142E+01_JPRB, 3.46970E+01_JPRB/)
+      KBO_MN2O(:, 10) = (/ &
+     & 1.14211E+02_JPRB, 1.13955E+02_JPRB, 1.13700E+02_JPRB, 1.13445E+02_JPRB, 1.13191E+02_JPRB, &
+     & 1.12938E+02_JPRB, 1.12685E+02_JPRB, 1.12433E+02_JPRB, 1.12181E+02_JPRB, 1.11930E+02_JPRB, &
+     & 1.11679E+02_JPRB, 1.11429E+02_JPRB, 1.11180E+02_JPRB, 1.10931E+02_JPRB, 1.10682E+02_JPRB, &
+     & 1.10434E+02_JPRB, 1.10187E+02_JPRB, 1.09940E+02_JPRB, 1.09694E+02_JPRB/)
+      KBO_MN2O(:, 11) = (/ &
+     & 1.60513E+02_JPRB, 1.60857E+02_JPRB, 1.61201E+02_JPRB, 1.61547E+02_JPRB, 1.61893E+02_JPRB, &
+     & 1.62240E+02_JPRB, 1.62587E+02_JPRB, 1.62936E+02_JPRB, 1.63285E+02_JPRB, 1.63635E+02_JPRB, &
+     & 1.63985E+02_JPRB, 1.64337E+02_JPRB, 1.64689E+02_JPRB, 1.65041E+02_JPRB, 1.65395E+02_JPRB, &
+     & 1.65749E+02_JPRB, 1.66105E+02_JPRB, 1.66460E+02_JPRB, 1.66817E+02_JPRB/)
+      KBO_MN2O(:, 12) = (/ &
+     & 1.71473E+02_JPRB, 1.72766E+02_JPRB, 1.74068E+02_JPRB, 1.75381E+02_JPRB, 1.76703E+02_JPRB, &
+     & 1.78035E+02_JPRB, 1.79377E+02_JPRB, 1.80729E+02_JPRB, 1.82091E+02_JPRB, 1.83464E+02_JPRB, &
+     & 1.84847E+02_JPRB, 1.86240E+02_JPRB, 1.87644E+02_JPRB, 1.89059E+02_JPRB, 1.90484E+02_JPRB, &
+     & 1.91920E+02_JPRB, 1.93367E+02_JPRB, 1.94824E+02_JPRB, 1.96293E+02_JPRB/)
+      KBO_MN2O(:, 13) = (/ &
+     & 2.71287E+01_JPRB, 2.75538E+01_JPRB, 2.79856E+01_JPRB, 2.84241E+01_JPRB, 2.88695E+01_JPRB, &
+     & 2.93219E+01_JPRB, 2.97814E+01_JPRB, 3.02480E+01_JPRB, 3.07220E+01_JPRB, 3.12035E+01_JPRB, &
+     & 3.16924E+01_JPRB, 3.21890E+01_JPRB, 3.26934E+01_JPRB, 3.32058E+01_JPRB, 3.37261E+01_JPRB, &
+     & 3.42546E+01_JPRB, 3.47914E+01_JPRB, 3.53365E+01_JPRB, 3.58903E+01_JPRB/)
+      KBO_MN2O(:, 14) = (/ &
+     & 1.70389E+01_JPRB, 1.70899E+01_JPRB, 1.71411E+01_JPRB, 1.71924E+01_JPRB, 1.72439E+01_JPRB, &
+     & 1.72955E+01_JPRB, 1.73473E+01_JPRB, 1.73992E+01_JPRB, 1.74513E+01_JPRB, 1.75035E+01_JPRB, &
+     & 1.75559E+01_JPRB, 1.76085E+01_JPRB, 1.76612E+01_JPRB, 1.77141E+01_JPRB, 1.77671E+01_JPRB, &
+     & 1.78203E+01_JPRB, 1.78736E+01_JPRB, 1.79271E+01_JPRB, 1.79808E+01_JPRB/)
+      KBO_MN2O(:, 15) = (/ &
+     & 2.49725E+00_JPRB, 2.66861E+00_JPRB, 2.85174E+00_JPRB, 3.04743E+00_JPRB, 3.25655E+00_JPRB, &
+     & 3.48003E+00_JPRB, 3.71883E+00_JPRB, 3.97403E+00_JPRB, 4.24673E+00_JPRB, 4.53815E+00_JPRB, &
+     & 4.84957E+00_JPRB, 5.18236E+00_JPRB, 5.53798E+00_JPRB, 5.91801E+00_JPRB, 6.32412E+00_JPRB, &
+     & 6.75809E+00_JPRB, 7.22185E+00_JPRB, 7.71742E+00_JPRB, 8.24701E+00_JPRB/)
+      KBO_MN2O(:, 16) = (/ &
+     & 1.82935E-03_JPRB, 2.58912E-03_JPRB, 3.66444E-03_JPRB, 5.18637E-03_JPRB, 7.34039E-03_JPRB, &
+     & 1.03890E-02_JPRB, 1.47038E-02_JPRB, 2.08106E-02_JPRB, 2.94538E-02_JPRB, 4.16865E-02_JPRB, &
+     & 5.89999E-02_JPRB, 8.35040E-02_JPRB, 1.18185E-01_JPRB, 1.67270E-01_JPRB, 2.36741E-01_JPRB, &
+     & 3.35065E-01_JPRB, 4.74225E-01_JPRB, 6.71180E-01_JPRB, 9.49936E-01_JPRB/)
+
+!     The array FORREFO contains the coefficient of the water vapor
+!     foreign-continuum (including the energy term).  The first 
+!     index refers to reference temperature (296,260,224,260) and 
+!     pressure (970,475,219,3 mbar) levels.  The second index 
+!     runs over the g-channel (1 to 16).
+
+      FORREFO(1,:) = (/ &
+     &7.5352E-06_JPRB,2.9812E-05_JPRB,1.4497E-04_JPRB,4.4006E-04_JPRB,1.0492E-03_JPRB,1.9676E-03_JPRB, &
+     &1.9989E-03_JPRB,1.9099E-03_JPRB,2.2121E-03_JPRB,2.4491E-03_JPRB,2.9573E-03_JPRB,2.6344E-03_JPRB, &
+     &3.0629E-03_JPRB,3.3547E-03_JPRB,5.0643E-03_JPRB,5.0642E-03_JPRB/)
+      FORREFO(2,:) = (/ &
+     &6.6070E-06_JPRB,4.8618E-05_JPRB,3.1112E-04_JPRB,8.4235E-04_JPRB,1.4179E-03_JPRB,1.4315E-03_JPRB, &
+     &1.4685E-03_JPRB,1.6554E-03_JPRB,2.1171E-03_JPRB,2.3545E-03_JPRB,2.5165E-03_JPRB,2.7680E-03_JPRB, &
+     &2.6985E-03_JPRB,3.5345E-03_JPRB,4.2924E-03_JPRB,5.0712E-03_JPRB/)
+      FORREFO(3,:) = (/ &
+     &6.5962E-06_JPRB,7.2595E-04_JPRB,1.3429E-03_JPRB,1.1675E-03_JPRB,9.8384E-04_JPRB,8.8787E-04_JPRB, &
+     &8.7557E-04_JPRB,8.0589E-04_JPRB,7.7024E-04_JPRB,8.7518E-04_JPRB,9.5213E-04_JPRB,9.0849E-04_JPRB, &
+     &1.2596E-03_JPRB,2.5106E-03_JPRB,3.9471E-03_JPRB,5.0742E-03_JPRB/)
+      FORREFO(4,:) = (/ &
+     &3.6217E-04_JPRB,1.0709E-03_JPRB,1.0628E-03_JPRB,8.5640E-04_JPRB,8.9332E-04_JPRB,8.3372E-04_JPRB, &
+     &7.8539E-04_JPRB,8.2828E-04_JPRB,8.3329E-04_JPRB,8.5118E-04_JPRB,8.2878E-04_JPRB,6.8570E-04_JPRB, &
+     &6.3815E-04_JPRB,8.0648E-04_JPRB,2.3236E-03_JPRB,4.0321E-03_JPRB/)
+
+
+!     The array SELFREFO contains the coefficient of the water vapor
+!     self-continuum (including the energy term).  The first index
+!     refers to temperature in 7.2 degree increments.  For instance,
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+!     etc.  The second index runs over the g-channel (1 to 16).
+
+     SELFREFO(:, 1) = (/ &
+     & 2.83453E-02_JPRB, 2.51439E-02_JPRB, 2.23040E-02_JPRB, 1.97849E-02_JPRB, 1.75503E-02_JPRB, &
+     & 1.55681E-02_JPRB, 1.38097E-02_JPRB, 1.22500E-02_JPRB, 1.08664E-02_JPRB, 9.63912E-03_JPRB/)
+      SELFREFO(:, 2) = (/ &
+     & 3.05185E-02_JPRB, 2.72374E-02_JPRB, 2.43090E-02_JPRB, 2.16955E-02_JPRB, 1.93629E-02_JPRB, &
+     & 1.72811E-02_JPRB, 1.54232E-02_JPRB, 1.37650E-02_JPRB, 1.22851E-02_JPRB, 1.09643E-02_JPRB/)
+      SELFREFO(:, 3) = (/ &
+     & 4.23833E-02_JPRB, 3.76250E-02_JPRB, 3.34010E-02_JPRB, 2.96512E-02_JPRB, 2.63223E-02_JPRB, &
+     & 2.33672E-02_JPRB, 2.07439E-02_JPRB, 1.84150E-02_JPRB, 1.63476E-02_JPRB, 1.45123E-02_JPRB/)
+      SELFREFO(:, 4) = (/ &
+     & 5.76481E-02_JPRB, 5.13686E-02_JPRB, 4.57730E-02_JPRB, 4.07870E-02_JPRB, 3.63441E-02_JPRB, &
+     & 3.23851E-02_JPRB, 2.88574E-02_JPRB, 2.57140E-02_JPRB, 2.29130E-02_JPRB, 2.04171E-02_JPRB/)
+      SELFREFO(:, 5) = (/ &
+     & 6.92255E-02_JPRB, 6.33521E-02_JPRB, 5.79770E-02_JPRB, 5.30580E-02_JPRB, 4.85563E-02_JPRB, &
+     & 4.44365E-02_JPRB, 4.06663E-02_JPRB, 3.72160E-02_JPRB, 3.40584E-02_JPRB, 3.11687E-02_JPRB/)
+      SELFREFO(:, 6) = (/ &
+     & 6.07694E-02_JPRB, 5.94182E-02_JPRB, 5.80970E-02_JPRB, 5.68052E-02_JPRB, 5.55422E-02_JPRB, &
+     & 5.43072E-02_JPRB, 5.30997E-02_JPRB, 5.19190E-02_JPRB, 5.07646E-02_JPRB, 4.96358E-02_JPRB/)
+      SELFREFO(:, 7) = (/ &
+     & 6.23749E-02_JPRB, 6.07744E-02_JPRB, 5.92150E-02_JPRB, 5.76956E-02_JPRB, 5.62152E-02_JPRB, &
+     & 5.47728E-02_JPRB, 5.33674E-02_JPRB, 5.19980E-02_JPRB, 5.06638E-02_JPRB, 4.93638E-02_JPRB/)
+      SELFREFO(:, 8) = (/ &
+     & 6.90744E-02_JPRB, 6.61811E-02_JPRB, 6.34090E-02_JPRB, 6.07530E-02_JPRB, 5.82083E-02_JPRB, &
+     & 5.57702E-02_JPRB, 5.34342E-02_JPRB, 5.11960E-02_JPRB, 4.90516E-02_JPRB, 4.69970E-02_JPRB/)
+      SELFREFO(:, 9) = (/ &
+     & 8.08992E-02_JPRB, 7.68876E-02_JPRB, 7.30750E-02_JPRB, 6.94514E-02_JPRB, 6.60075E-02_JPRB, &
+     & 6.27344E-02_JPRB, 5.96236E-02_JPRB, 5.66670E-02_JPRB, 5.38570E-02_JPRB, 5.11864E-02_JPRB/)
+      SELFREFO(:,10) = (/ &
+     & 8.70197E-02_JPRB, 8.27485E-02_JPRB, 7.86870E-02_JPRB, 7.48248E-02_JPRB, 7.11522E-02_JPRB, &
+     & 6.76599E-02_JPRB, 6.43389E-02_JPRB, 6.11810E-02_JPRB, 5.81781E-02_JPRB, 5.53225E-02_JPRB/)
+      SELFREFO(:,11) = (/ &
+     & 8.84776E-02_JPRB, 8.54262E-02_JPRB, 8.24800E-02_JPRB, 7.96354E-02_JPRB, 7.68890E-02_JPRB, &
+     & 7.42373E-02_JPRB, 7.16770E-02_JPRB, 6.92050E-02_JPRB, 6.68183E-02_JPRB, 6.45139E-02_JPRB/)
+      SELFREFO(:,12) = (/ &
+     & 9.82552E-02_JPRB, 9.25696E-02_JPRB, 8.72130E-02_JPRB, 8.21664E-02_JPRB, 7.74118E-02_JPRB, &
+     & 7.29323E-02_JPRB, 6.87121E-02_JPRB, 6.47360E-02_JPRB, 6.09900E-02_JPRB, 5.74608E-02_JPRB/)
+      SELFREFO(:,13) = (/ &
+     & 9.32447E-02_JPRB, 8.96818E-02_JPRB, 8.62550E-02_JPRB, 8.29592E-02_JPRB, 7.97893E-02_JPRB, &
+     & 7.67405E-02_JPRB, 7.38082E-02_JPRB, 7.09880E-02_JPRB, 6.82755E-02_JPRB, 6.56667E-02_JPRB/)
+      SELFREFO(:,14) = (/ &
+     & 1.15363E-01_JPRB, 1.08593E-01_JPRB, 1.02220E-01_JPRB, 9.62210E-02_JPRB, 9.05741E-02_JPRB, &
+     & 8.52585E-02_JPRB, 8.02549E-02_JPRB, 7.55450E-02_JPRB, 7.11115E-02_JPRB, 6.69382E-02_JPRB/)
+      SELFREFO(:,15) = (/ &
+     & 1.23179E-01_JPRB, 1.19247E-01_JPRB, 1.15440E-01_JPRB, 1.11755E-01_JPRB, 1.08187E-01_JPRB, &
+     & 1.04734E-01_JPRB, 1.01391E-01_JPRB, 9.81540E-02_JPRB, 9.50207E-02_JPRB, 9.19875E-02_JPRB/)
+      SELFREFO(:,16) = (/ &
+     & 1.44104E-01_JPRB, 1.36412E-01_JPRB, 1.29130E-01_JPRB, 1.22237E-01_JPRB, 1.15712E-01_JPRB, &
+     & 1.09535E-01_JPRB, 1.03688E-01_JPRB, 9.81530E-02_JPRB, 9.29135E-02_JPRB, 8.79537E-02_JPRB/)
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB9',1,ZHOOK_HANDLE)
+RETURN
+
+1001 CONTINUE
+CALL ABOR1("RRTM_KGB9:ERROR READING FILE RADRRTM")
+
+END SUBROUTINE RRTM_KGB9
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb9.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb9.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_kgb9.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE RRTM_KGB9
+END SUBROUTINE RRTM_KGB9
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_prepare_gases.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_prepare_gases.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_prepare_gases.F90	(revision 3908)
@@ -0,0 +1,232 @@
+SUBROUTINE RRTM_PREPARE_GASES &
+ &( KIDIA, KFDIA, KLON, KLEV, &
+ &  PAPH , PAP , &
+ &  PTH  , PT  , &
+ &  PQ   , PCO2 , PCH4, PN2O  , PNO2, PC11, PC12, PC22, PCL4, POZN, &
+ &  PCOLDRY, PWBRODL, PWKL, PWX , &
+ &  PAVEL  , PTAVEL , PZ  , PTZ , KREFLECT)  
+
+!----compiled for Cray with -h nopattern----
+
+!     Prepare the units of the gas concentrations for the longwave
+!     RRTM gas absorption model.  This file is adapted from
+!     rrtm_ecrt_140gp_mcica.F90, written mainly by Jean-Jacques
+!     Morcrette.
+
+!- Original
+!     2015-07-15  Robin Hogan
+
+!- Modifications
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
+USE YOMCST   , ONLY : RG
+USE PARRRTM  , ONLY : JPBAND, JPXSEC, JPINPX  
+USE YOMDYNCORE,ONLY : RPLRG
+
+!------------------------------Arguments--------------------------------
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLON! Number of atmospheres (longitudes) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV! Number of atmospheric layers 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA, KFDIA 
+
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPH(KLON,KLEV+1) ! Interface pressures (Pa)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PAP(KLON,KLEV) ! Layer pressures (Pa)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PTH(KLON,KLEV+1) ! Interface temperatures (K)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KLON,KLEV) ! Layer temperature (K)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KLON,KLEV) ! H2O specific humidity (mmr)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCO2(KLON,KLEV) ! CO2 mass mixing ratio
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCH4(KLON,KLEV) ! CH4 mass mixing ratio
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PN2O(KLON,KLEV) ! N2O mass mixing ratio
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PNO2(KLON,KLEV) ! NO2 mass mixing ratio
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PC11(KLON,KLEV) ! CFC11 mass mixing ratio
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PC12(KLON,KLEV) ! CFC12 mass mixing ratio
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PC22(KLON,KLEV) ! CFC22 mass mixing ratio
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCL4(KLON,KLEV) ! CCL4  mass mixing ratio
+REAL(KIND=JPRB)   ,INTENT(IN)    :: POZN(KLON,KLEV) ! O3 mass mixing ratio
+
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCOLDRY(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PWBRODL(KIDIA:KFDIA,KLEV) ! broadening gas column density (mol/cm2)
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PWKL(KIDIA:KFDIA,JPINPX,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PWX(KIDIA:KFDIA,JPXSEC,KLEV) ! Amount of trace gases
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PAVEL(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTAVEL(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PZ(KIDIA:KFDIA,0:KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTZ(KIDIA:KFDIA,0:KLEV) 
+INTEGER(KIND=JPIM),INTENT(OUT)   :: KREFLECT(KIDIA:KFDIA) 
+
+!      real rch4                       ! CH4 mass mixing ratio
+!      real rn2o                       ! N2O mass mixing ratio
+!      real rcfc11                     ! CFC11 mass mixing ratio
+!      real rcfc12                     ! CFC12 mass mixing ratio
+!      real rcfc22                     ! CFC22 mass mixing ratio
+!      real rccl4                      ! CCl4  mass mixing ratio
+!- from PROFILE             
+!- from SURFACE             
+REAL(KIND=JPRB) :: ZAMD                  ! Effective molecular weight of dry air (g/mol)
+REAL(KIND=JPRB) :: ZAMW                  ! Molecular weight of water vapor (g/mol)
+REAL(KIND=JPRB) :: ZAMCO2                ! Molecular weight of carbon dioxide (g/mol)
+REAL(KIND=JPRB) :: ZAMO                  ! Molecular weight of ozone (g/mol)
+REAL(KIND=JPRB) :: ZAMCH4                ! Molecular weight of methane (g/mol)
+REAL(KIND=JPRB) :: ZAMN2O                ! Molecular weight of nitrous oxide (g/mol)
+REAL(KIND=JPRB) :: ZAMC11                ! Molecular weight of CFC11 (g/mol) - CFCL3
+REAL(KIND=JPRB) :: ZAMC12                ! Molecular weight of CFC12 (g/mol) - CF2CL2
+REAL(KIND=JPRB) :: ZAMC22                ! Molecular weight of CFC22 (g/mol) - CHF2CL
+REAL(KIND=JPRB) :: ZAMCL4                ! Molecular weight of CCl4  (g/mol) - CCL4
+REAL(KIND=JPRB) :: ZAVGDRO               ! Avogadro's number (molecules/mole)
+REAL(KIND=JPRB) :: ZGRAVIT               ! Gravitational acceleration (cm/s**2)
+
+REAL(KIND=JPRB) :: ZSUMMOL
+
+! Atomic weights for conversion from mass to volume mixing ratios; these
+!  are the same values used in ECRT to assure accurate conversion to vmr
+data ZAMD   /  28.970_JPRB    /
+data ZAMW   /  18.0154_JPRB   /
+data ZAMCO2 /  44.011_JPRB    /
+data ZAMO   /  47.9982_JPRB   /
+data ZAMCH4 /  16.043_JPRB    /
+data ZAMN2O /  44.013_JPRB    /
+data ZAMC11 / 137.3686_JPRB   /
+data ZAMC12 / 120.9140_JPRB   /
+data ZAMC22 /  86.4690_JPRB   /
+data ZAMCL4 / 153.8230_JPRB   /
+data ZAVGDRO/ 6.02214E23_JPRB /
+
+INTEGER(KIND=JPIM) :: IATM, JMOL, IXMAX, J1, J2, JK, JL
+INTEGER(KIND=JPIM) :: ITMOL, INXMOL
+
+REAL(KIND=JPRB) :: ZAMM
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+! ***
+
+! *** mji
+! Initialize all molecular amounts to zero here, 
+! then pass ECRT amounts into RRTM arrays below.
+
+!      DATA ZWKL /MAXPRDW*0.0/
+!      DATA ZWX  /MAXPROD*0.0/
+!      DATA KREFLECT /0/
+
+! Activate cross section molecules:
+!     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
+!      DATA KXMOL  /2/
+!      DATA KXINDX /0,2,3,0,31*0/
+
+!      IREFLECT=KREFLECT
+!      NXMOL=KXMOL
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('RRTM_PREPARE_GASES',0,ZHOOK_HANDLE)
+
+ZGRAVIT=(RG/RPLRG)*1.E2_JPRB
+
+DO JL = KIDIA, KFDIA
+  KREFLECT(JL)=0
+  INXMOL=2
+ENDDO
+
+!DO J1=1,35
+! IXINDX(J1)=0
+DO J2=1,KLEV
+  DO J1=1,35
+    DO JL = KIDIA, KFDIA
+      PWKL(JL,J1,J2)=0.0_JPRB 
+    ENDDO
+  ENDDO
+ENDDO
+!IXINDX(2)=2
+!IXINDX(3)=3
+
+!     Set parameters needed for RRTM execution:
+IATM    = 0
+!      IXSECT  = 1
+!      NUMANGS = 0
+!      IOUT    = -1
+IXMAX   = 4
+
+DO JL = KIDIA, KFDIA
+!     Install ECRT arrays into RRTM arrays for pressure, temperature,
+!     and molecular amounts.  Pressures are converted from Pascals
+!     (ECRT) to mb (RRTM).  H2O, CO2, O3 and trace gas amounts are 
+!     converted from mass mixing ratio to volume mixing ratio.  CO2
+!     converted with same dry air and CO2 molecular weights used in 
+!     ECRT to assure correct conversion back to the proper CO2 vmr.
+!     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: RRTM levels count from bottom to top, while the ECRT input
+!     variables count from the top down and must be reversed 
+  ITMOL = 7
+  PZ(JL,0) = PAPH(JL,KLEV+1)/100._JPRB
+  PTZ(JL,0) = PTH(JL,KLEV+1)
+ENDDO
+
+  DO JK = 1, KLEV
+    DO JL = KIDIA, KFDIA
+    PAVEL(JL,JK) = PAP(JL,KLEV-JK+1)/100._JPRB
+    PTAVEL(JL,JK) = PT(JL,KLEV-JK+1)
+    PZ(JL,JK) = PAPH(JL,KLEV-JK+1)/100._JPRB
+    PTZ(JL,JK) = PTH(JL,KLEV-JK+1)
+    PWKL(JL,1,JK) = PQ(JL,KLEV-JK+1)*ZAMD/ZAMW
+    PWKL(JL,2,JK) = PCO2(JL,KLEV-JK+1)*ZAMD/ZAMCO2
+    PWKL(JL,3,JK) = POZN(JL,KLEV-JK+1)*ZAMD/ZAMO
+    PWKL(JL,4,JK) = PN2O(JL,KLEV-JK+1)*ZAMD/ZAMN2O
+    PWKL(JL,6,JK) = PCH4(JL,KLEV-JK+1)*ZAMD/ZAMCH4
+    PWKL(JL,7,JK) = 0.209488_JPRB
+    ZAMM = (1.0_JPRB-PWKL(JL,1,JK))*ZAMD + PWKL(JL,1,JK)*ZAMW
+    PCOLDRY(JL,JK) = (PZ(JL,JK-1)-PZ(JL,JK))*1.E3_JPRB*ZAVGDRO/(ZGRAVIT*ZAMM*(1.0_JPRB+PWKL(JL,1,JK)))
+  ENDDO
+  ENDDO
+
+  DO J2=1,KLEV
+    DO J1=1,JPXSEC
+      DO JL = KIDIA, KFDIA
+        PWX(JL,J1,J2)=0.0_JPRB
+      ENDDO
+    ENDDO
+  ENDDO
+
+  DO JK = 1, KLEV
+DO JL = KIDIA, KFDIA
+!- Set cross section molecule amounts from ECRT; convert to vmr
+    PWX(JL,1,JK) = PCL4(JL,KLEV-JK+1) * ZAMD/ZAMCL4
+    PWX(JL,2,JK) = PC11(JL,KLEV-JK+1) * ZAMD/ZAMC11
+    PWX(JL,3,JK) = PC12(JL,KLEV-JK+1) * ZAMD/ZAMC12
+    PWX(JL,4,JK) = PC22(JL,KLEV-JK+1) * ZAMD/ZAMC22
+    PWX(JL,1,JK) = PCOLDRY(JL,JK) * PWX(JL,1,JK) * 1.E-20_JPRB
+    PWX(JL,2,JK) = PCOLDRY(JL,JK) * PWX(JL,2,JK) * 1.E-20_JPRB
+    PWX(JL,3,JK) = PCOLDRY(JL,JK) * PWX(JL,3,JK) * 1.E-20_JPRB
+    PWX(JL,4,JK) = PCOLDRY(JL,JK) * PWX(JL,4,JK) * 1.E-20_JPRB
+
+!- Here, all molecules in WKL and WX are in volume mixing ratio; convert to
+!  molec/cm2 based on COLDRY for use in RRTM
+
+!CDIR UNROLL=6
+ZSUMMOL = 0.0_JPRB
+!AB broadening gases
+    DO JMOL = 2, ITMOL
+      ZSUMMOL = ZSUMMOL + PWKL(JL,JMOL,JK)
+    ENDDO
+    PWBRODL(JL,JK) = PCOLDRY(JL,JK) * (1._JPRB - ZSUMMOL)
+    DO JMOL = 1, ITMOL
+      PWKL(JL,JMOL,JK) = PCOLDRY(JL,JK) * PWKL(JL,JMOL,JK)
+    ENDDO    
+  ENDDO
+ENDDO
+
+!     ------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('RRTM_PREPARE_GASES',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE RRTM_PREPARE_GASES
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_prepare_gases.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_prepare_gases.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_prepare_gases.intfb.h	(revision 3908)
@@ -0,0 +1,38 @@
+INTERFACE
+SUBROUTINE RRTM_PREPARE_GASES&
+ & ( KIDIA, KFDIA, KLON, KLEV,&
+ & PAPH , PAP ,&
+ & PTH , PT ,&
+ & PQ , PCO2 , PCH4, PN2O , PNO2, PC11, PC12, PC22, PCL4, POZN,&
+ & PCOLDRY, PWBRODL, PWKL, PWX ,&
+ & PAVEL , PTAVEL , PZ , PTZ , KREFLECT) 
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE PARRRTM , ONLY : JPBAND, JPXSEC, JPINPX
+INTEGER(KIND=JPIM),INTENT(IN) :: KLON
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA, KFDIA
+REAL(KIND=JPRB) ,INTENT(IN) :: PAPH(KLON,KLEV+1)
+REAL(KIND=JPRB) ,INTENT(IN) :: PAP(KLON,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PTH(KLON,KLEV+1)
+REAL(KIND=JPRB) ,INTENT(IN) :: PT(KLON,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PQ(KLON,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCO2(KLON,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCH4(KLON,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PN2O(KLON,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PNO2(KLON,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PC11(KLON,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PC12(KLON,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PC22(KLON,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCL4(KLON,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: POZN(KLON,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PCOLDRY(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PWBRODL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PWKL(KIDIA:KFDIA,JPINPX,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PWX(KIDIA:KFDIA,JPXSEC,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PAVEL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PTAVEL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PZ(KIDIA:KFDIA,0:KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PTZ(KIDIA:KFDIA,0:KLEV)
+INTEGER(KIND=JPIM),INTENT(OUT) :: KREFLECT(KIDIA:KFDIA)
+END SUBROUTINE RRTM_PREPARE_GASES
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_rrtm_140gp_mcica.F90.or
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_rrtm_140gp_mcica.F90.or	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_rrtm_140gp_mcica.F90.or	(revision 3908)
@@ -0,0 +1,304 @@
+SUBROUTINE RRTM_RRTM_140GP_MCICA &
+ &( KIDIA , KFDIA , KLON , KLEV, KCOLS, KCLDCOL,&
+ &  PAER  , PAPH  , PAP  , PAERTAUL, PAERASYL, PAEROMGL, &
+ &  PTS   , PTH   , PT   , &
+ &  PEMIS , PEMIW ,&
+ &  PQ    , PCO2  , PCH4 , PN2O, PNO2 , PC11, PC12, PC22, PCL4, POZN   ,&
+ &  PCLDF , PTAUCLD, PCLFR,&
+ &  PEMIT , PFLUX , PFLUC, &
+ &  PLwDerivative)  
+
+! *** This program is the driver for the McICA version of RRTM_LW, 
+!     the AER rapid model.  
+
+!     For each atmosphere the user wishes to analyze, this routine
+!     a) calls ECRTATM to read in the atmospheric profile 
+!     b) calls SETCOEF to calculate various quantities needed for 
+!        the radiative transfer algorithm
+!     c) calls RTRN to do the radiative transfer calculation for
+!        clear or cloudy sky
+!     d) writes out the upward, downward, and net flux for each
+!        level and the heating rate for each layer
+
+!     JJMorcrette 20050110 McICA version revisited (changes in RRTM_ECRT, RRTM_RTRN)
+!        NEC           25-Oct-2007 Optimisations
+!     JJMorcrette 20080424 3D fields of CO2, CH4, N2O, NO2, CFC11, 12, 22 and CCL4
+!     JJMorcrette 20110613 flexible number of g-points
+!     P Bechtold 14/05/2012 replace ZHEATF by core constants RG*RDAY/RCPD
+!                           and put arrays to scalars
+!     R Hogan    20/05/2014 pass partial derivatives back to calling function
+!-----------------------------------------------------------------------
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
+USE PARRRTM  , ONLY : JPBAND, JPXSEC, JPINPX 
+USE YOERRTM  , ONLY : JPGPT  
+USE YOMCST   , ONLY : RG  ! , RDAYI, RCPD
+
+IMPLICIT NONE
+
+!------------------------------Arguments--------------------------------
+
+! Input arguments
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLON! Number of atmospheres (longitudes) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV! Number of atmospheric layers 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA ! First atmosphere index
+INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA ! Last atmosphere index
+INTEGER(KIND=JPIM),INTENT(IN)    :: KCOLS ! Number of columns on which to perform RT
+                                          ! should be the same as number of g-points, JPGPT
+INTEGER(KIND=JPIM),INTENT(IN)    :: KCLDCOL(KLON) ! cloudy column index: 1=cloud, 0: clear    
+
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PAER(KLON,6,KLEV) ! Aerosol optical thickness
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PAERTAUL(KLON,KLEV,16), PAERASYL(KLON,KLEV,16), PAEROMGL(KLON,KLEV,16)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPH(KLON,KLEV+1) ! Interface pressures (Pa)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PAP(KLON,KLEV) ! Layer pressures (Pa)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(KLON) ! Surface temperature (JK)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PTH(KLON,KLEV+1) ! Interface temperatures (JK)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KLON,KLEV) ! Layer temperature (JK)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIS(KLON) ! Non-window surface emissivity
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIW(KLON) ! Window surface emissivity
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KLON,KLEV) ! H2O specific humidity (mmr)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCO2(KLON,KLEV) ! CO2 mass mixing ratio
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCH4(KLON,KLEV) ! CH4 mass mixing ratio
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PN2O(KLON,KLEV) ! N2O mass mixing ratio
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PNO2(KLON,KLEV) ! NO2 mass mixing ratio
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PC11(KLON,KLEV) ! CFC11 mass mixing ratio
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PC12(KLON,KLEV) ! CFC12 mass mixing ratio
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PC22(KLON,KLEV) ! CFC22 mass mixing ratio
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCL4(KLON,KLEV) ! CCL4  mass mixing ratio
+REAL(KIND=JPRB)   ,INTENT(IN)    :: POZN(KLON,KLEV) ! O3 mass mixing ratio
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLFR(KLON,KLEV)
+
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PEMIT(KLON) ! Surface LW emissivity
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLUX(KLON,2,KLEV+1) ! LW total sky flux (1=up, 2=down)
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLUC(KLON,2,KLEV+1) ! LW clear sky flux (1=up, 2=down)
+
+! Partial derivative of total upward flux at each level with respect
+! to upward flux at surface, used to correct heating rates at
+! gridpoints/timesteps between calls to the full radiation scheme:
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PLwDerivative(KLON,KLEV+1)
+
+!-- McICA ----------
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLDF(KLON,KCOLS,KLEV)    ! Cloud fraction
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUCLD(KLON,KLEV,KCOLS)  ! Cloud optical depth
+
+REAL(KIND=JPRB) :: ZCLDFRAC(KIDIA:KFDIA,KCOLS,KLEV)   ! Cloud fraction
+REAL(KIND=JPRB) :: ZTAUCLD(KIDIA:KFDIA,KLEV,KCOLS)    ! Spectral optical thickness
+!-- McICA ----------
+
+REAL(KIND=JPRB) :: ZATR1(KIDIA:KFDIA,JPGPT,KLEV)
+
+REAL(KIND=JPRB) :: ZOD(KIDIA:KFDIA,JPGPT,KLEV)
+
+REAL(KIND=JPRB) :: ZTF1(KIDIA:KFDIA,JPGPT,KLEV)
+
+REAL(KIND=JPRB) :: ZCOLDRY(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZWBRODL(KIDIA:KFDIA,KLEV) !BROADENING GASES,column density (mol/cm2)
+REAL(KIND=JPRB) :: ZCOLBRD(KIDIA:KFDIA,KLEV) !BROADENING GASES, column amount
+REAL(KIND=JPRB) :: ZWKL(KIDIA:KFDIA,JPINPX,KLEV)
+
+REAL(KIND=JPRB) :: ZWX(KIDIA:KFDIA,JPXSEC,KLEV)         ! Amount of trace gases
+
+REAL(KIND=JPRB) :: ZTOTDFLUC(KIDIA:KFDIA,0:KLEV)
+REAL(KIND=JPRB) :: ZTOTDFLUX(KIDIA:KFDIA,0:KLEV)
+REAL(KIND=JPRB) :: ZTOTUFLUC(KIDIA:KFDIA,0:KLEV)
+REAL(KIND=JPRB) :: ZTOTUFLUX(KIDIA:KFDIA,0:KLEV)
+
+INTEGER(KIND=JPIM) :: JL, JK
+INTEGER(KIND=JPIM) :: ISTART
+INTEGER(KIND=JPIM) :: IEND
+
+REAL(KIND=JPRB) :: ZFLUXFAC, ZHEATFAC, ZPI
+REAL(KIND=JPRB) :: ZEPSEC
+
+!- from AER
+REAL(KIND=JPRB) :: ZTAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
+
+!- from INTFAC      
+REAL(KIND=JPRB) :: ZFAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZFAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZFAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZFAC11(KIDIA:KFDIA,KLEV)
+
+!- from FOR
+REAL(KIND=JPRB) :: ZFORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZFORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM) :: INDFOR(KIDIA:KFDIA,KLEV) 
+
+!- from MINOR
+INTEGER(KIND=JPIM)  :: INDMINOR(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)     :: ZSCALEMINOR(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)     :: ZSCALEMINORN2(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)     :: ZMINORFRAC(KIDIA:KFDIA,KLEV) 
+
+REAL(KIND=JPRB)     :: &                 
+                    &  ZRAT_H2OCO2(KIDIA:KFDIA,KLEV),ZRAT_H2OCO2_1(KIDIA:KFDIA,KLEV), &
+                    &  ZRAT_H2OO3(KIDIA:KFDIA,KLEV) ,ZRAT_H2OO3_1(KIDIA:KFDIA,KLEV), & 
+                    &  ZRAT_H2ON2O(KIDIA:KFDIA,KLEV),ZRAT_H2ON2O_1(KIDIA:KFDIA,KLEV), &
+                    &  ZRAT_H2OCH4(KIDIA:KFDIA,KLEV),ZRAT_H2OCH4_1(KIDIA:KFDIA,KLEV), &
+                    &  ZRAT_N2OCO2(KIDIA:KFDIA,KLEV),ZRAT_N2OCO2_1(KIDIA:KFDIA,KLEV), &
+                    &  ZRAT_O3CO2(KIDIA:KFDIA,KLEV) ,ZRAT_O3CO2_1(KIDIA:KFDIA,KLEV)
+
+!- from INTIND
+INTEGER(KIND=JPIM) :: JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM) :: JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM) :: JT1(KIDIA:KFDIA,KLEV)
+
+!- from PRECISE             
+REAL(KIND=JPRB) :: ZONEMINUS
+
+!- from PROFDATA             
+REAL(KIND=JPRB) :: ZCOLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZCOLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZCOLO3(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZCOLN2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZCOLCH4(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZCOLO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZCO2MULT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM) :: ILAYTROP(KIDIA:KFDIA)
+INTEGER(KIND=JPIM) :: ILAYSWTCH(KIDIA:KFDIA)
+INTEGER(KIND=JPIM) :: ILAYLOW(KIDIA:KFDIA)
+
+!- from PROFILE             
+REAL(KIND=JPRB) :: ZPAVEL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZTAVEL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZPZ(KIDIA:KFDIA,0:KLEV)
+REAL(KIND=JPRB) :: ZTZ(KIDIA:KFDIA,0:KLEV)
+REAL(KIND=JPRB) :: ZTBOUND(KIDIA:KFDIA)
+
+!- from SELF             
+REAL(KIND=JPRB) :: ZSELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZSELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM) :: INDSELF(KIDIA:KFDIA,KLEV)
+
+!- from SP             
+REAL(KIND=JPRB) :: ZPFRAC(KIDIA:KFDIA,JPGPT,KLEV)
+
+!- from SURFACE             
+REAL(KIND=JPRB) :: ZSEMISS(KIDIA:KFDIA,JPBAND)
+REAL(KIND=JPRB) :: ZSEMISLW(KIDIA:KFDIA)
+INTEGER(KIND=JPIM) :: IREFLECT(KIDIA:KFDIA)
+
+! Local variable required in case KFDIA /= KLON
+REAL(KIND=JPRB) :: ZLwDerivative(KIDIA:KFDIA,KLEV+1)
+
+LOGICAL            :: LLPRINT
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "rrtm_ecrt_140gp_mcica.intfb.h"
+#include "rrtm_gasabs1a_140gp.intfb.h"
+#include "rrtm_rtrn1a_140gp_mcica.intfb.h"
+#include "rrtm_setcoef_140gp.intfb.h"
+
+!     HEATFAC is the factor by which one must multiply delta-flux/ 
+!     delta-pressure, with flux in w/m-2 and pressure in mbar, to get 
+!     the heating rate in units of degrees/day.  It is equal to 
+!           (g)x(#sec/day)x(1e-5)/(specific heat of air at const. p)
+!        =  (9.8066)(86400)(1e-5)/(1.004)
+
+IF (LHOOK) CALL DR_HOOK('RRTM_RRTM_140GP_MCICA',0,ZHOOK_HANDLE)
+
+ASSOCIATE(NFLEVG=>KLEV)
+
+ZEPSEC = 1.E-06_JPRB
+ZONEMINUS = 1.0_JPRB - ZEPSEC
+ZPI = 2.0_JPRB*ASIN(1.0_JPRB)
+ZFLUXFAC = ZPI * 2.E+4
+!ZHEATFAC = 8.4391_JPRB
+!ZHEATFAC = RG*RDAYI/RCPD*1.E-2_JPRB
+
+! *** mji ***
+
+! For use with ECRT, this loop is over atmospheres (or longitudes)
+LLPRINT=.TRUE.
+
+!  do JK=1,KLEV
+!    print 9901,JK,PT(JL,JK),PQ(JL,JK),POZN(JL,JK),PCLDF(JL,JK,1),PTAUCLD(JL,JK,1)
+!  enddo
+
+! *** mji ***
+!- Prepare atmospheric profile from ECRT for use in RRTM, and define
+!  other RRTM input parameters.  Arrays are passed back through the
+!  existing RRTM commons and arrays.
+
+  CALL RRTM_ECRT_140GP_MCICA &
+   &( KIDIA, KFDIA, KLON , KLEV, KCOLS , &
+   &  PAER , PAPH , PAP , PAERTAUL, PAERASYL, PAEROMGL, &
+   &  pts  , PTH  , PT  , &
+   &  PEMIS, PEMIW, &
+   &  PQ   , PCO2 , PCH4, PN2O, PNO2, PC11, PC12, PC22, PCL4, POZN , PCLDF, PTAUCLD, &
+   &  ZCLDFRAC, ZTAUCLD, ZCOLDRY, ZWBRODL,ZWKL, ZWX, &
+   &  ZTAUAERL, ZPAVEL , ZTAVEL , ZPZ , ZTZ, ZTBOUND, ZSEMISS, IREFLECT)  
+
+  ISTART = 1
+  IEND   = 16
+
+!  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 RRTM_SETCOEF_140GP &
+   &( KIDIA  , KFDIA    , KLEV   , ZCOLDRY  , ZWBRODL , ZWKL , &
+   &  ZFAC00 , ZFAC01   , ZFAC10 , ZFAC11 , ZFORFAC,ZFORFRAC,INDFOR, JP, JT, JT1 , &
+   &  ZCOLH2O, ZCOLCO2  , ZCOLO3 , ZCOLN2O, ZCOLCH4, ZCOLO2,ZCO2MULT , ZCOLBRD, & 
+   &  ILAYTROP,ILAYSWTCH, ILAYLOW, ZPAVEL , ZTAVEL , ZSELFFAC, ZSELFFRAC, INDSELF, &
+   &  INDMINOR,ZSCALEMINOR,ZSCALEMINORN2,ZMINORFRAC,&
+   &  ZRAT_H2OCO2, ZRAT_H2OCO2_1, ZRAT_H2OO3, ZRAT_H2OO3_1, &
+   &  ZRAT_H2ON2O, ZRAT_H2ON2O_1, ZRAT_H2OCH4, ZRAT_H2OCH4_1, &
+   &  ZRAT_N2OCO2, ZRAT_N2OCO2_1, ZRAT_O3CO2, ZRAT_O3CO2_1)   
+
+  CALL RRTM_GASABS1A_140GP &
+   &( KIDIA   , KFDIA  , KLEV, ZATR1, ZOD, ZTF1, ZPAVEL, ZCOLDRY, ZCOLBRD, ZWX ,&
+   &  ZTAUAERL, ZFAC00 , ZFAC01, ZFAC10 , ZFAC11 , ZFORFAC,ZFORFRAC,INDFOR, JP, JT, JT1, ZONEMINUS ,&
+   &  ZCOLH2O , ZCOLCO2, ZCOLO3, ZCOLN2O, ZCOLCH4, ZCOLO2,ZCO2MULT ,&
+   &  ILAYTROP, ILAYSWTCH,ILAYLOW, ZSELFFAC, ZSELFFRAC, INDSELF, ZPFRAC, &
+   &  INDMINOR,ZSCALEMINOR,ZSCALEMINORN2,ZMINORFRAC,&
+   &  ZRAT_H2OCO2, ZRAT_H2OCO2_1, ZRAT_H2OO3, ZRAT_H2OO3_1, &
+   &  ZRAT_H2ON2O, ZRAT_H2ON2O_1, ZRAT_H2OCH4, ZRAT_H2OCH4_1, &
+   &  ZRAT_N2OCO2, ZRAT_N2OCO2_1, ZRAT_O3CO2, ZRAT_O3CO2_1)      
+
+!- Call the radiative transfer routine.
+
+!  Clear and cloudy parts of column are treated together in RTRN.
+
+!  print 9901,JL,ZTBOUND
+
+  CALL RRTM_RTRN1A_140GP_MCICA &
+   &( KIDIA, KFDIA, KLEV, ISTART, IEND, KCOLS ,& 
+   &  ZCLDFRAC, ZTAUCLD, ZATR1 ,&
+   &  ZOD , ZTF1 , &
+   &  ZTOTDFLUC, ZTOTDFLUX, ZTOTUFLUC, ZTOTUFLUX ,&
+   &  ZTAVEL, ZTZ, ZTBOUND, ZPFRAC, ZSEMISS, ZSEMISLW ,&
+   &  ZLwDerivative )  
+
+! ***   Pass clear sky and total sky up and down flux profiles to ECRT
+!       output arrays (zflux, zfluc). Array indexing from bottom to top 
+!       is preserved for ECRT.
+!       Invert down flux arrays for consistency with ECRT sign conventions.
+
+DO JL = KIDIA,KFDIA
+
+  PEMIT(JL) = ZSEMISLW(JL)
+  DO JK = 0, KLEV
+    PFLUC(JL,1,JK+1) =  ZTOTUFLUC(JL,JK)*ZFLUXFAC
+    PFLUC(JL,2,JK+1) = -ZTOTDFLUC(JL,JK)*ZFLUXFAC
+    PFLUX(JL,1,JK+1) =  ZTOTUFLUX(JL,JK)*ZFLUXFAC
+    PFLUX(JL,2,JK+1) = -ZTOTDFLUX(JL,JK)*ZFLUXFAC
+  ENDDO
+
+  ! Copy to output array, noting that they may be dimensioned
+  ! differently
+  PLwDerivative(JL,:) = ZLwDerivative(JL,:)
+
+ENDDO
+
+9901 FORMAT(1X,'rrtm:',I4,12E12.5)
+
+!------------------------------------------------------------------------
+END ASSOCIATE
+
+IF (LHOOK) CALL DR_HOOK('RRTM_RRTM_140GP_MCICA',1,ZHOOK_HANDLE)
+END SUBROUTINE RRTM_RRTM_140GP_MCICA
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_setcoef_140gp.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_setcoef_140gp.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_setcoef_140gp.F90	(revision 3908)
@@ -0,0 +1,283 @@
+SUBROUTINE RRTM_SETCOEF_140GP (KIDIA,KFDIA,KLEV,P_COLDRY,P_WBROAD,P_WKL,&
+ & P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,&
+ & P_COLH2O,P_COLCO2,P_COLO3,P_COLN2O,P_COLCH4, P_COLO2,P_CO2MULT, P_COLBRD, &
+ & K_LAYTROP,K_LAYSWTCH,K_LAYLOW,PAVEL,P_TAVEL,P_SELFFAC,P_SELFFRAC,K_INDSELF,&
+ & K_INDMINOR,P_SCALEMINOR,P_SCALEMINORN2,P_MINORFRAC,&
+ & PRAT_H2OCO2, PRAT_H2OCO2_1, PRAT_H2OO3, PRAT_H2OO3_1, &
+ & PRAT_H2ON2O, PRAT_H2ON2O_1, PRAT_H2OCH4, PRAT_H2OCH4_1, &
+ & PRAT_N2OCO2, PRAT_N2OCO2_1, PRAT_O3CO2, PRAT_O3CO2_1)  
+
+!     Reformatted for F90 by JJMorcrette, ECMWF, 980714
+!        NEC           25-Oct-2007 Optimisations
+!     201305 ABozzo updated to rrtmg_lw_v4.85
+
+
+!     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.
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
+USE PARRRTM  , ONLY : JPINPX
+USE YOERRTRF , ONLY : PREFLOG   ,TREF, CHI_MLS
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLDRY(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_WBROAD(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_COLBRD(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_WKL(KIDIA:KFDIA,JPINPX,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_FAC11(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_FORFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(OUT)   :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(OUT)   :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(OUT)   :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_COLH2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_COLCO2(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_COLO3(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_COLN2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_COLCH4(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_COLO2(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_CO2MULT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(OUT)   :: K_LAYTROP(KIDIA:KFDIA) 
+INTEGER(KIND=JPIM),INTENT(OUT)   :: K_LAYSWTCH(KIDIA:KFDIA) 
+INTEGER(KIND=JPIM),INTENT(OUT)   :: K_LAYLOW(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PAVEL(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAVEL(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(OUT)   :: K_INDSELF(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(OUT)   :: K_INDFOR(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(OUT)   :: K_INDMINOR(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SCALEMINOR(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SCALEMINORN2(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_MINORFRAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: &                 !
+                     & PRAT_H2OCO2(KIDIA:KFDIA,KLEV),PRAT_H2OCO2_1(KIDIA:KFDIA,KLEV), &
+                     & PRAT_H2OO3(KIDIA:KFDIA,KLEV) ,PRAT_H2OO3_1(KIDIA:KFDIA,KLEV), & 
+                     & PRAT_H2ON2O(KIDIA:KFDIA,KLEV),PRAT_H2ON2O_1(KIDIA:KFDIA,KLEV), &
+                     & PRAT_H2OCH4(KIDIA:KFDIA,KLEV),PRAT_H2OCH4_1(KIDIA:KFDIA,KLEV), &
+                     & PRAT_N2OCO2(KIDIA:KFDIA,KLEV),PRAT_N2OCO2_1(KIDIA:KFDIA,KLEV), &
+                     & PRAT_O3CO2(KIDIA:KFDIA,KLEV) ,PRAT_O3CO2_1(KIDIA:KFDIA,KLEV)
+!- from INTFAC      
+!- from INTIND
+!- from PROFDATA             
+!- from PROFILE             
+!- from SELF             
+INTEGER(KIND=JPIM) :: JP1, JLAY
+INTEGER(KIND=JPIM) :: JLON
+
+REAL(KIND=JPRB) :: Z_CO2REG, Z_COMPFP, Z_FACTOR, Z_FP, Z_FT, Z_FT1, Z_PLOG, Z_SCALEFAC, Z_STPFAC, Z_WATER
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+!#include "yoeratm.h"    
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('RRTM_SETCOEF_140GP',0,ZHOOK_HANDLE)
+
+DO JLON = KIDIA, KFDIA
+  Z_STPFAC = 296._JPRB/1013._JPRB
+
+  K_LAYTROP(JLON)  = 0
+  K_LAYSWTCH(JLON) = 0
+  K_LAYLOW(JLON)   = 0
+  DO JLAY = 1, KLEV
+!        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.
+    Z_PLOG = LOG(PAVEL(JLON,JLAY))
+    K_JP(JLON,JLAY) = INT(36._JPRB - 5*(Z_PLOG+0.04_JPRB))
+    IF (K_JP(JLON,JLAY)  <  1) THEN
+      K_JP(JLON,JLAY) = 1
+    ELSEIF (K_JP(JLON,JLAY)  >  58) THEN
+      K_JP(JLON,JLAY) = 58
+    ENDIF
+    JP1 = K_JP(JLON,JLAY) + 1
+    Z_FP = 5._JPRB * (PREFLOG(K_JP(JLON,JLAY)) - Z_PLOG)
+! bound Z_FP in case Z_PLOG is outside range of ref. pressure PREFLOG
+! (in LVERTFE, pressure at last full level is known, but not in finite diff (NH)
+    Z_FP = max(-1._JPRB,min(1._JPRB,Z_FP))
+!        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.
+
+    K_JT(JLON,JLAY) = INT(3._JPRB + (P_TAVEL(JLON,JLAY)-TREF(K_JP(JLON,JLAY)))/15._JPRB)
+    IF (K_JT(JLON,JLAY)  <  1) THEN
+      K_JT(JLON,JLAY) = 1
+    ELSEIF (K_JT(JLON,JLAY)  >  4) THEN
+      K_JT(JLON,JLAY) = 4
+    ENDIF
+    Z_FT = ((P_TAVEL(JLON,JLAY)-TREF(K_JP(JLON,JLAY)))/15._JPRB) - REAL(K_JT(JLON,JLAY)-3)
+    K_JT1(JLON,JLAY) = INT(3._JPRB + (P_TAVEL(JLON,JLAY)-TREF(JP1))/15._JPRB)
+    IF (K_JT1(JLON,JLAY)  <  1) THEN
+      K_JT1(JLON,JLAY) = 1
+    ELSEIF (K_JT1(JLON,JLAY)  >  4) THEN
+      K_JT1(JLON,JLAY) = 4
+    ENDIF
+    Z_FT1 = ((P_TAVEL(JLON,JLAY)-TREF(JP1))/15._JPRB) - REAL(K_JT1(JLON,JLAY)-3)
+
+    Z_WATER = P_WKL(JLON,1,JLAY)/P_COLDRY(JLON,JLAY)
+    Z_SCALEFAC = PAVEL(JLON,JLAY) * Z_STPFAC / P_TAVEL(JLON,JLAY)
+
+!        If the pressure is less than ~100mb, perform a different
+!        set of species interpolations.
+!         IF (PLOG .LE. 4.56) GO TO 5300
+!--------------------------------------         
+    IF (Z_PLOG  >  4.56_JPRB) THEN
+      K_LAYTROP(JLON) =  K_LAYTROP(JLON) + 1
+!        For one band, the "switch" occurs at ~300 mb. 
+!      IF (Z_PLOG  >=  5.76_JPRB) K_LAYSWTCH(JLON) = K_LAYSWTCH(JLON) + 1
+!      IF (Z_PLOG  >=  6.62_JPRB) K_LAYLOW(JLON) = K_LAYLOW(JLON) + 1
+
+
+!        water vapor foreign continuum
+      P_FORFAC(JLON,JLAY) = Z_SCALEFAC / (1.0_JPRB+Z_WATER)
+      Z_FACTOR = (332.0_JPRB-P_TAVEL(JLON,JLAY))/36.0_JPRB
+      K_INDFOR(JLON,JLAY) = MIN(2, MAX(1, INT(Z_FACTOR)))
+      P_FORFRAC(JLON,JLAY) = Z_FACTOR - REAL(K_INDFOR(JLON,JLAY))
+
+!        Set up factors needed to separately include the water vapor
+!        self-continuum in the calculation of absorption coefficient.
+!C           SELFFAC(LAY) = WATER * SCALEFAC / (1.+WATER)
+      P_SELFFAC(JLON,JLAY) = Z_WATER * P_FORFAC(JLON,JLAY)
+      Z_FACTOR = (P_TAVEL(JLON,JLAY)-188.0_JPRB)/7.2_JPRB
+      K_INDSELF(JLON,JLAY) = MIN(9, MAX(1, INT(Z_FACTOR)-7))
+      P_SELFFRAC(JLON,JLAY) = Z_FACTOR - REAL(K_INDSELF(JLON,JLAY) + 7)
+
+!  Set up factors needed to separately include the minor gases
+!  in the calculation of absorption coefficient
+         P_SCALEMINOR(JLON,JLAY) = PAVEL(JLON,JLAY)/P_TAVEL(JLON,JLAY)
+         P_SCALEMINORN2(JLON,JLAY) = (PAVEL(JLON,JLAY)/P_TAVEL(JLON,JLAY)) &
+           &  *(P_WBROAD(JLON,JLAY)/(P_COLDRY(JLON,JLAY)+P_WKL(JLON,1,JLAY)))
+         Z_FACTOR = (P_TAVEL(JLON,JLAY)-180.8_JPRB)/7.2_JPRB
+         K_INDMINOR(JLON,JLAY) = MIN(18, MAX(1, INT(Z_FACTOR)))
+         P_MINORFRAC(JLON,JLAY) = Z_FACTOR - REAL(K_INDMINOR(JLON,JLAY))
+
+!  Setup reference ratio to be used in calculation of binary
+!  species parameter in lower atmosphere.
+         PRAT_H2OCO2(JLON,JLAY)=CHI_MLS(1,K_JP(JLON,JLAY))/CHI_MLS(2,K_JP(JLON,JLAY))
+         PRAT_H2OCO2_1(JLON,JLAY)=CHI_MLS(1,K_JP(JLON,JLAY)+1)/CHI_MLS(2,K_JP(JLON,JLAY)+1)
+
+         PRAT_H2OO3(JLON,JLAY)=CHI_MLS(1,K_JP(JLON,JLAY))/CHI_MLS(3,K_JP(JLON,JLAY))
+         PRAT_H2OO3_1(JLON,JLAY)=CHI_MLS(1,K_JP(JLON,JLAY)+1)/CHI_MLS(3,K_JP(JLON,JLAY)+1)
+
+         PRAT_H2ON2O(JLON,JLAY)=CHI_MLS(1,K_JP(JLON,JLAY))/CHI_MLS(4,K_JP(JLON,JLAY))
+         PRAT_H2ON2O_1(JLON,JLAY)=CHI_MLS(1,K_JP(JLON,JLAY)+1)/CHI_MLS(4,K_JP(JLON,JLAY)+1)
+
+         PRAT_H2OCH4(JLON,JLAY)=CHI_MLS(1,K_JP(JLON,JLAY))/CHI_MLS(6,K_JP(JLON,JLAY))
+         PRAT_H2OCH4_1(JLON,JLAY)=CHI_MLS(1,K_JP(JLON,JLAY)+1)/CHI_MLS(6,K_JP(JLON,JLAY)+1)
+
+         PRAT_N2OCO2(JLON,JLAY)=CHI_MLS(4,K_JP(JLON,JLAY))/CHI_MLS(2,K_JP(JLON,JLAY))
+         PRAT_N2OCO2_1(JLON,JLAY)=CHI_MLS(4,K_JP(JLON,JLAY)+1)/CHI_MLS(2,K_JP(JLON,JLAY)+1)
+
+
+
+!        Calculate needed column amounts.
+      P_COLH2O(JLON,JLAY) = 1.E-20_JPRB * P_WKL(JLON,1,JLAY)
+      P_COLCO2(JLON,JLAY) = 1.E-20_JPRB * P_WKL(JLON,2,JLAY)
+      P_COLO3(JLON,JLAY)  = 1.E-20_JPRB * P_WKL(JLON,3,JLAY)
+      P_COLN2O(JLON,JLAY) = 1.E-20_JPRB * P_WKL(JLON,4,JLAY)
+      P_COLCH4(JLON,JLAY) = 1.E-20_JPRB * P_WKL(JLON,6,JLAY)
+      P_COLO2(JLON,JLAY) = 1.E-20_JPRB * P_WKL(JLON,7,JLAY)
+      P_COLBRD(JLON,JLAY) = 1.E-20_JPRB * P_WBROAD(JLON,JLAY)
+      IF (P_COLCO2(JLON,JLAY)  ==  0.0_JPRB) P_COLCO2(JLON,JLAY) = 1.E-32_JPRB * P_COLDRY(JLON,JLAY)
+      IF (P_COLN2O(JLON,JLAY)  ==  0.0_JPRB) P_COLN2O(JLON,JLAY) = 1.E-32_JPRB * P_COLDRY(JLON,JLAY)
+      IF (P_COLCH4(JLON,JLAY)  ==  0.0_JPRB) P_COLCH4(JLON,JLAY) = 1.E-32_JPRB * P_COLDRY(JLON,JLAY)
+!        Using E = 1334.2 cm-1.
+      Z_CO2REG = 3.55E-24_JPRB * P_COLDRY(JLON,JLAY)
+      P_CO2MULT(JLON,JLAY)= (P_COLCO2(JLON,JLAY) - Z_CO2REG) *&
+       & 272.63_JPRB*EXP(-1919.4_JPRB/P_TAVEL(JLON,JLAY))/(8.7604E-4_JPRB*P_TAVEL(JLON,JLAY))  
+!         GO TO 5400
+!------------------
+    ELSE
+!        Above LAYTROP.
+! 5300    CONTINUE
+
+!        Calculate needed column amounts.
+      P_FORFAC(JLON,JLAY) = Z_SCALEFAC / (1.0_JPRB+Z_WATER)
+      Z_FACTOR = (P_TAVEL(JLON,JLAY)-188.0_JPRB)/36.0_JPRB
+      K_INDFOR(JLON,JLAY) = 3
+      P_FORFRAC(JLON,JLAY) = Z_FACTOR - 1.0_JPRB
+
+!  Set up factors needed to separately include the water vapor
+!  self-continuum in the calculation of absorption coefficient.
+      P_SELFFAC(JLON,JLAY) = Z_WATER * P_FORFAC(JLON,JLAY)
+
+!  Set up factors needed to separately include the minor gases
+!  in the calculation of absorption coefficient
+      P_SCALEMINOR(JLON,JLAY) = PAVEL(JLON,JLAY)/P_TAVEL(JLON,JLAY)         
+      P_SCALEMINORN2(JLON,JLAY) = (PAVEL(JLON,JLAY)/P_TAVEL(JLON,JLAY)) &
+        &    * (P_WBROAD(JLON,JLAY)/(P_COLDRY(JLON,JLAY)+P_WKL(JLON,1,JLAY)))
+      Z_FACTOR = (P_TAVEL(JLON,JLAY)-180.8_JPRB)/7.2_JPRB
+      K_INDMINOR(JLON,JLAY) = MIN(18, MAX(1, INT(Z_FACTOR)))
+      P_MINORFRAC(JLON,JLAY) = Z_FACTOR - REAL(K_INDMINOR(JLON,JLAY))
+
+!  Setup reference ratio to be used in calculation of binary
+!  species parameter in upper atmosphere.
+      PRAT_H2OCO2(JLON,JLAY)=CHI_MLS(1,K_JP(JLON,JLAY))/CHI_MLS(2,K_JP(JLON,JLAY))
+      PRAT_H2OCO2_1(JLON,JLAY)=CHI_MLS(1,K_JP(JLON,JLAY)+1)/CHI_MLS(2,K_JP(JLON,JLAY)+1)         
+
+      PRAT_O3CO2(JLON,JLAY)=CHI_MLS(3,K_JP(JLON,JLAY))/CHI_MLS(2,K_JP(JLON,JLAY))
+      PRAT_O3CO2_1(JLON,JLAY)=CHI_MLS(3,K_JP(JLON,JLAY)+1)/CHI_MLS(2,K_JP(JLON,JLAY)+1)         
+
+
+!  Calculate needed column amounts.
+      P_COLH2O(JLON,JLAY) = 1.E-20_JPRB * P_WKL(JLON,1,JLAY)
+      P_COLCO2(JLON,JLAY) = 1.E-20_JPRB * P_WKL(JLON,2,JLAY)
+      P_COLO3(JLON,JLAY)  = 1.E-20_JPRB * P_WKL(JLON,3,JLAY)
+      P_COLN2O(JLON,JLAY) = 1.E-20_JPRB * P_WKL(JLON,4,JLAY)
+      P_COLCH4(JLON,JLAY) = 1.E-20_JPRB * P_WKL(JLON,6,JLAY)
+      P_COLO2(JLON,JLAY) = 1.E-20_JPRB * P_WKL(JLON,7,JLAY)
+      P_COLBRD(JLON,JLAY) = 1.E-20_JPRB * P_WBROAD(JLON,JLAY)
+      IF (P_COLCO2(JLON,JLAY)  ==  0.0_JPRB) P_COLCO2(JLON,JLAY) = 1.E-32_JPRB * P_COLDRY(JLON,JLAY)
+      IF (P_COLN2O(JLON,JLAY)  ==  0.0_JPRB) P_COLN2O(JLON,JLAY) = 1.E-32_JPRB * P_COLDRY(JLON,JLAY)
+      IF (P_COLCH4(JLON,JLAY)  ==  0.0_JPRB) P_COLCH4(JLON,JLAY) = 1.E-32_JPRB * P_COLDRY(JLON,JLAY)
+      Z_CO2REG = 3.55E-24_JPRB * P_COLDRY(JLON,JLAY)
+      P_CO2MULT(JLON,JLAY)= (P_COLCO2(JLON,JLAY) - Z_CO2REG) *&
+       & 272.63_JPRB*EXP(-1919.4_JPRB/P_TAVEL(JLON,JLAY))/(8.7604E-4_JPRB*P_TAVEL(JLON,JLAY))  
+!----------------     
+    ENDIF
+! 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).
+
+    Z_COMPFP = 1.0_JPRB - Z_FP
+    P_FAC10(JLON,JLAY) = Z_COMPFP * Z_FT
+    P_FAC00(JLON,JLAY) = Z_COMPFP * (1.0_JPRB - Z_FT)
+    P_FAC11(JLON,JLAY) = Z_FP * Z_FT1
+    P_FAC01(JLON,JLAY) = Z_FP * (1.0_JPRB - Z_FT1)
+
+!  Rescale selffac and forfac for use in taumol
+    P_SELFFAC(JLON,JLAY) = P_COLH2O(JLON,JLAY)*P_SELFFAC(JLON,JLAY)
+    P_FORFAC(JLON,JLAY) = P_COLH2O(JLON,JLAY)*P_FORFAC(JLON,JLAY)
+
+
+  ENDDO
+
+! MT 981104 
+!-- Set LAYLOW for profiles with surface pressure less than 750 hPa. 
+  IF (K_LAYLOW(JLON) == 0) K_LAYLOW(JLON)=1
+ENDDO
+
+IF (LHOOK) CALL DR_HOOK('RRTM_SETCOEF_140GP',1,ZHOOK_HANDLE)
+
+END ASSOCIATE
+END SUBROUTINE RRTM_SETCOEF_140GP
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_setcoef_140gp.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_setcoef_140gp.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_setcoef_140gp.intfb.h	(revision 3908)
@@ -0,0 +1,56 @@
+INTERFACE
+SUBROUTINE RRTM_SETCOEF_140GP (KIDIA,KFDIA,KLEV,P_COLDRY,P_WBROAD,P_WKL,&
+ & P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,&
+ & P_COLH2O,P_COLCO2,P_COLO3,P_COLN2O,P_COLCH4, P_COLO2,P_CO2MULT, P_COLBRD,&
+ & K_LAYTROP,K_LAYSWTCH,K_LAYLOW,PAVEL,P_TAVEL,P_SELFFAC,P_SELFFRAC,K_INDSELF,&
+ & K_INDMINOR,P_SCALEMINOR,P_SCALEMINORN2,P_MINORFRAC,&
+ & PRAT_H2OCO2, PRAT_H2OCO2_1, PRAT_H2OO3, PRAT_H2OO3_1,&
+ & PRAT_H2ON2O, PRAT_H2ON2O_1, PRAT_H2OCH4, PRAT_H2OCH4_1,&
+ & PRAT_N2OCO2, PRAT_N2OCO2_1, PRAT_O3CO2, PRAT_O3CO2_1) 
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE PARRRTM , ONLY : JPINPX
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLDRY(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_WBROAD(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLBRD(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_WKL(KIDIA:KFDIA,JPINPX,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_FAC11(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_FORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(OUT) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(OUT) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(OUT) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLO3(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLN2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLCH4(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_CO2MULT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(OUT) :: K_LAYTROP(KIDIA:KFDIA)
+INTEGER(KIND=JPIM),INTENT(OUT) :: K_LAYSWTCH(KIDIA:KFDIA)
+INTEGER(KIND=JPIM),INTENT(OUT) :: K_LAYLOW(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: PAVEL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_TAVEL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_SELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(OUT) :: K_INDSELF(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(OUT) :: K_INDFOR(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(OUT) :: K_INDMINOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_SCALEMINOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_SCALEMINORN2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_MINORFRAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) ::&
+ & PRAT_H2OCO2(KIDIA:KFDIA,KLEV),PRAT_H2OCO2_1(KIDIA:KFDIA,KLEV),&
+ & PRAT_H2OO3(KIDIA:KFDIA,KLEV) ,PRAT_H2OO3_1(KIDIA:KFDIA,KLEV),&
+ & PRAT_H2ON2O(KIDIA:KFDIA,KLEV),PRAT_H2ON2O_1(KIDIA:KFDIA,KLEV),&
+ & PRAT_H2OCH4(KIDIA:KFDIA,KLEV),PRAT_H2OCH4_1(KIDIA:KFDIA,KLEV),&
+ & PRAT_N2OCO2(KIDIA:KFDIA,KLEV),PRAT_N2OCO2_1(KIDIA:KFDIA,KLEV),&
+ & PRAT_O3CO2(KIDIA:KFDIA,KLEV) ,PRAT_O3CO2_1(KIDIA:KFDIA,KLEV) 
+END SUBROUTINE RRTM_SETCOEF_140GP
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol1.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol1.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol1.F90	(revision 3908)
@@ -0,0 +1,283 @@
+SUBROUTINE RRTM_TAUMOL1 (KIDIA,KFDIA,KLEV,P_TAU,PAVEL,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,&
+ & P_COLH2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC,P_MINORFRAC,K_INDMINOR,PSCALEMINORN2,PCOLBRD)  
+
+!******************************************************************************
+!                                                                             *
+!                  Optical depths developed for the                           *
+!                                                                             *
+!                RAPID RADIATIVE TRANSFER MODEL (RRTM)                        *
+!                                                                             *
+!            ATMOSPHERIC AND ENVIRONMENTAL RESEARCH, INC.                     *
+!                        840 MEMORIAL DRIVE                                   *
+!                        CAMBRIDGE, MA 02139                                  *
+!                                                                             *
+!                           ELI J. MLAWER                                     *
+!                         STEVEN J. TAUBMAN                                   *
+!                         SHEPARD A. CLOUGH                                   *
+!                                                                             *
+!                       email:  mlawer@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 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),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(KIDIA:KFDIA,MXLAY),JT1(KIDIA:KFDIA,MXLAY)                        *
+!     COMMON /SELF/     SELFFAC(MXLAY), SELFFRAC(MXLAY), INDSELF(KIDIA:KFDIA,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(JLAY) - for layer JLAY, 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)                                         *
+!                                                                             *
+!******************************************************************************
+
+!     BAND 1:  10-250 cm-1 (low - H2O; high - H2O)
+ 
+!     AUTHOR.
+!     -------
+!      JJMorcrette, ECMWF, from
+!      Eli J. Mlawer, Atmospheric & Environmental Research.
+!      (Revised by Michael J. Iacono, Atmospheric & Environmental Research.)
+
+!     MODIFICATIONS.
+!     --------------
+!      D Salmond   2000-05-15 speed-up
+!      JJMorcrette 2000-05-17 speed-up
+!      M.Hamrud      01-Oct-2003 CY28 Cleaning
+!      NEC           25-Oct-2007 Optimisations
+!      JJMorcrette 20110613 flexible number of g-points
+!      ABozzo 200130517 updated to rrtmg_lw_v4.85:
+!*********
+!     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 PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE PARRRTM  , ONLY : JPBAND
+USE YOERRTM  , ONLY : JPGPT  ,NG1
+USE YOERRTWN , ONLY : NSPA   ,NSPB
+USE YOERRTA1 , ONLY : ABSA   ,ABSB   ,FRACREFA, FRACREFB,&
+ & FORREF   ,SELFREF,  KA_MN2, KB_MN2   
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PAVEL(KIDIA:KFDIA,KLEV) ! Layer pressures (hPa)
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_MINORFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV) 
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDFOR(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDMINOR(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PSCALEMINORN2(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLBRD(KIDIA:KFDIA,KLEV)         
+! ---------------------------------------------------------------------------
+
+INTEGER(KIND=JPIM) :: IND0(KLEV),IND1(KLEV),INDS(KLEV)
+INTEGER(KIND=JPIM) :: INDF(KLEV),INDM(KLEV)
+
+INTEGER(KIND=JPIM) :: IG, JLAY
+INTEGER(KIND=JPIM) :: JLON
+REAL(KIND=JPRB) :: ZTAUFOR,ZTAUSELF,ZTAUN2,ZCORRADJ,ZPP,ZSCALEN2
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+! 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.
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL1',0,ZHOOK_HANDLE)
+
+DO JLAY = 1, KLEV
+  DO JLON = KIDIA, KFDIA
+  IF (JLAY <= K_LAYTROP(JLON)) THEN
+    IND0(JLAY) = ((K_JP(JLON,JLAY)-1)*5+(K_JT(JLON,JLAY)-1))*NSPA(1) + 1
+    IND1(JLAY) = (K_JP(JLON,JLAY)*5+(K_JT1(JLON,JLAY)-1))*NSPA(1) + 1
+    INDS(JLAY) = K_INDSELF(JLON,JLAY)
+    INDF(JLAY) = K_INDFOR(JLON,JLAY)
+    INDM(JLAY) = K_INDMINOR(JLON,JLAY)
+    ZPP = PAVEL(JLON,JLAY) !hPa(mb)
+    ZCORRADJ =  1.
+    IF (ZPP < 250._JPRB) THEN
+        ZCORRADJ = 1._JPRB - 0.15_JPRB * (250._JPRB-ZPP) / 154.4_JPRB
+    ENDIF
+
+    ZSCALEN2 = PCOLBRD(JLON,JLAY) * PSCALEMINORN2(JLON,JLAY)
+
+!CDIR UNROLL=NG1
+    DO IG = 1, NG1
+!-- DS_000515  
+           ZTAUSELF = P_SELFFAC(JLON,JLAY) * (SELFREF(INDS(JLAY),IG) + &
+     &           P_SELFFRAC(JLON,JLAY) * &
+     &           (SELFREF(INDS(JLAY)+1,IG) - SELFREF(INDS(JLAY),IG))) 
+
+            ZTAUFOR =  P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + &
+     &           P_FORFRAC(JLON,JLAY) * (FORREF(INDF(JLAY)+1,IG) - &
+     &           FORREF(INDF(JLAY),IG)))  
+
+            ZTAUN2 = ZSCALEN2*(KA_MN2(INDM(JLAY),IG) +   &
+     &           P_MINORFRAC(JLON,JLAY) * &
+     &           (KA_MN2(INDM(JLAY)+1,IG) - KA_MN2(INDM(JLAY),IG))) 
+
+            P_TAU(JLON,IG,JLAY) = ZCORRADJ * (P_COLH2O(JLON,JLAY) *  &
+     &          (P_FAC00(JLON,JLAY) * ABSA(IND0(JLAY),IG) + &
+     &           P_FAC10(JLON,JLAY) * ABSA(IND0(JLAY)+1,IG) + &
+     &           P_FAC01(JLON,JLAY) * ABSA(IND1(JLAY),IG) +  &
+     &           P_FAC11(JLON,JLAY) * ABSA(IND1(JLAY)+1,IG))  &
+     &           + ZTAUSELF + ZTAUFOR &
+     &           + ZTAUN2) + P_TAUAERL(JLON,JLAY,1)
+
+            PFRAC(JLON,IG,JLAY) = FRACREFA(IG)
+
+    ENDDO
+  ENDIF
+
+  IF (JLAY > K_LAYTROP(JLON)) THEN
+    IND0(JLAY) = ((K_JP(JLON,JLAY)-13)*5+(K_JT(JLON,JLAY)-1))*NSPB(1) + 1
+    IND1(JLAY) = ((K_JP(JLON,JLAY)-12)*5+(K_JT1(JLON,JLAY)-1))*NSPB(1) + 1
+    INDF(JLAY) = K_INDFOR(JLON,JLAY)
+    INDM(JLAY) = K_INDMINOR(JLON,JLAY)
+    ZPP = PAVEL(JLON,JLAY)  !hPa(mb)
+    ZCORRADJ =  1._JPRB - 0.15_JPRB * (ZPP / 95.6_JPRB)
+
+    ZSCALEN2 = PCOLBRD(JLON,JLAY) * PSCALEMINORN2(JLON,JLAY)
+
+!-- JJM000517
+!CDIR UNROLL=NG1
+    DO IG = 1, NG1
+!-- JJM000517
+            ZTAUFOR = P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + &
+     &           P_FORFRAC(JLON,JLAY) * &
+     &           (FORREF(INDF(JLAY)+1,IG) - FORREF(INDF(JLAY),IG))) 
+
+            ZTAUN2 = ZSCALEN2*(KB_MN2(INDM(JLAY),IG) +  &
+     &           P_MINORFRAC(JLON,JLAY) * &
+     &           (KB_MN2(INDM(JLAY)+1,IG) - KB_MN2(INDM(JLAY),IG)))
+
+            P_TAU(JLON,IG,JLAY) = ZCORRADJ * (P_COLH2O(JLON,JLAY) * &
+     &          (P_FAC00(JLON,JLAY) * ABSB(IND0(JLAY),IG) + &
+     &           P_FAC10(JLON,JLAY) * ABSB(IND0(JLAY)+1,IG) + &
+     &           P_FAC01(JLON,JLAY) * ABSB(IND1(JLAY),IG) + &
+     &           P_FAC11(JLON,JLAY) * ABSB(IND1(JLAY)+1,IG)) &  
+     &           + ZTAUFOR &
+     &           + ZTAUN2)+ P_TAUAERL(JLON,JLAY,1)
+      PFRAC(JLON,IG,JLAY) = FRACREFB(IG)
+
+
+    ENDDO
+  ENDIF
+  ENDDO
+ENDDO
+
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL1',1,ZHOOK_HANDLE)
+
+END ASSOCIATE
+END SUBROUTINE RRTM_TAUMOL1
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol1.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol1.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol1.intfb.h	(revision 3908)
@@ -0,0 +1,35 @@
+INTERFACE
+SUBROUTINE RRTM_TAUMOL1 (KIDIA,KFDIA,KLEV,P_TAU,PAVEL,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,&
+ & P_COLH2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC,P_MINORFRAC,K_INDMINOR,PSCALEMINORN2,PCOLBRD) 
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+USE PARRRTM , ONLY : JPBAND
+USE YOERRTM , ONLY : JPGPT ,NG1
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(IN) :: PAVEL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_MINORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDMINOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PSCALEMINORN2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLBRD(KIDIA:KFDIA,KLEV)
+END SUBROUTINE RRTM_TAUMOL1
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol10.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol10.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol10.F90	(revision 3908)
@@ -0,0 +1,121 @@
+!*******************************************************************************
+SUBROUTINE RRTM_TAUMOL10 (KIDIA,KFDIA,KLEV,P_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,&
+ & P_COLH2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
+
+!     BAND 10:  1390-1480 cm-1 (low - H2O; high - H2O)
+
+!     AUTHOR.
+!     -------
+!     JJMorcrette, ECMWF
+
+!     MODIFICATIONS.
+!     --------------
+!      M.Hamrud      01-Oct-2003 CY28 Cleaning
+!      NEC           25-Oct-2007 Optimisations
+!      JJMorcrette 20110613 flexible number of g-points
+!      ABozzo 201306 updated to rrtmg v4.85
+! ---------------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE PARRRTM  , ONLY : JPBAND
+USE YOERRTM  , ONLY : JPGPT  ,NG10   ,NGS9
+USE YOERRTWN , ONLY : NSPA   ,NSPB
+USE YOERRTA10, ONLY : ABSA   ,ABSB   ,FRACREFA, FRACREFB, FORREF   ,SELFREF
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV) 
+
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDFOR(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFRAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFAC(KIDIA:KFDIA,KLEV) 
+! ---------------------------------------------------------------------------
+
+INTEGER(KIND=JPIM) :: IND0(KLEV),IND1(KLEV)
+INTEGER(KIND=JPIM) :: INDS(KLEV),INDF(KLEV)
+
+INTEGER(KIND=JPIM) :: IG, JLAY
+INTEGER(KIND=JPIM) :: JLON
+REAL(KIND=JPRB) :: ZTAUFOR,ZTAUSELF
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+!     Compute the optical depth by interpolating in ln(pressure) and 
+!     temperature.  
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL10',0,ZHOOK_HANDLE)
+
+DO JLAY = 1, KLEV
+  DO JLON = KIDIA, KFDIA
+    IF (JLAY <= K_LAYTROP(JLON)) THEN
+      IND0(JLAY) = ((K_JP(JLON,JLAY)-1)*5+(K_JT(JLON,JLAY)-1))*NSPA(10) + 1
+      IND1(JLAY) = (K_JP(JLON,JLAY)*5+(K_JT1(JLON,JLAY)-1))*NSPA(10) + 1
+      INDS(JLAY) = K_INDSELF(JLON,JLAY)
+      INDF(JLAY) = K_INDFOR(JLON,JLAY)
+
+!-- DS_000515
+!CDIR UNROLL=NG10
+      DO IG = 1, NG10
+
+        ZTAUSELF = P_SELFFAC(JLON,JLAY) * (SELFREF(INDS(JLAY),IG) + P_SELFFRAC(JLON,JLAY) * &
+                 & (SELFREF(INDS(JLAY)+1,IG) - SELFREF(INDS(JLAY),IG)))
+        ZTAUFOR =  P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + P_FORFRAC(JLON,JLAY) * &
+                 & (FORREF(INDF(JLAY)+1,IG) - FORREF(INDF(JLAY),IG))) 
+!-- DS_000515
+        P_TAU(JLON,NGS9+IG,JLAY) = P_COLH2O(JLON,JLAY) *&
+         & (P_FAC00(JLON,JLAY) * ABSA(IND0(JLAY)  ,IG) +&
+         & P_FAC10(JLON,JLAY) * ABSA(IND0(JLAY)+1,IG) +&
+         & P_FAC01(JLON,JLAY) * ABSA(IND1(JLAY)  ,IG) +&
+         & P_FAC11(JLON,JLAY) * ABSA(IND1(JLAY)+1,IG)) + &
+         & ZTAUSELF + ZTAUFOR &
+         & + P_TAUAERL(JLON,JLAY,10)  
+        PFRAC(JLON,NGS9+IG,JLAY) = FRACREFA(IG)
+      ENDDO
+    ENDIF
+
+    IF (JLAY > K_LAYTROP(JLON)) THEN
+      IND0(JLAY) = ((K_JP(JLON,JLAY)-13)*5+(K_JT(JLON,JLAY)-1))*NSPB(10) + 1
+      IND1(JLAY) = ((K_JP(JLON,JLAY)-12)*5+(K_JT1(JLON,JLAY)-1))*NSPB(10) + 1
+      INDF(JLAY) = K_INDFOR(JLON,JLAY)
+!-- JJM_000517
+!CDIR UNROLL=NG10
+      DO IG = 1, NG10
+        ZTAUFOR = P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + &
+                &  P_FORFRAC(JLON,JLAY) * (FORREF(INDF(JLAY)+1,IG) - FORREF(INDF(JLAY),IG))) 
+!-- JJM_000517
+        P_TAU(JLON,NGS9+IG,JLAY) = P_COLH2O(JLON,JLAY) *&
+         & (P_FAC00(JLON,JLAY) * ABSB(IND0(JLAY)  ,IG) +&
+         & P_FAC10(JLON,JLAY) * ABSB(IND0(JLAY)+1,IG) +&
+         & P_FAC01(JLON,JLAY) * ABSB(IND1(JLAY)  ,IG) +&
+         & P_FAC11(JLON,JLAY) * ABSB(IND1(JLAY)+1,IG)) &
+         & + ZTAUFOR + P_TAUAERL(JLON,JLAY,10)  
+        PFRAC(JLON,NGS9+IG,JLAY) = FRACREFB(IG)
+      ENDDO
+    ENDIF
+  ENDDO
+ENDDO
+
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL10',1,ZHOOK_HANDLE)
+
+END ASSOCIATE
+END SUBROUTINE RRTM_TAUMOL10
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol10.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol10.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol10.intfb.h	(revision 3908)
@@ -0,0 +1,30 @@
+INTERFACE
+SUBROUTINE RRTM_TAUMOL10 (KIDIA,KFDIA,KLEV,P_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,&
+ & P_COLH2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC) 
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+USE PARRRTM , ONLY : JPBAND
+USE YOERRTM , ONLY : JPGPT ,NG10 ,NGS9
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(KIDIA:KFDIA,KLEV)
+END SUBROUTINE RRTM_TAUMOL10
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol11.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol11.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol11.F90	(revision 3908)
@@ -0,0 +1,149 @@
+!******************************************************************************
+SUBROUTINE RRTM_TAUMOL11 (KIDIA,KFDIA,KLEV,P_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,&
+ & P_COLH2O,P_COLO2,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC,P_MINORFRAC,KINDMINOR,PSCALEMINOR)  
+
+!     BAND 11:  1480-1800 cm-1 (low - H2O; high - H2O)
+
+!     AUTHOR.
+!     -------
+!      JJMorcrette, ECMWF
+
+!     MODIFICATIONS.
+!     --------------
+!      M.Hamrud      01-Oct-2003 CY28 Cleaning
+!      NEC           25-Oct-2007 Optimisations
+!      JJMorcrette 20110613 flexible number of g-points
+!      ABozzo updated to rrtmg v4.85
+!     band 11:  1480-1800 cm-1 (low - h2o; low minor - o2)
+!                              (high key - h2o; high minor - o2)
+! ---------------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE PARRRTM  , ONLY : JPBAND
+USE YOERRTM  , ONLY : JPGPT  ,NG11  ,NGS10
+USE YOERRTWN , ONLY :      NSPA   ,NSPB
+USE YOERRTA11, ONLY : ABSA   ,ABSB   ,FRACREFA, FRACREFB,SELFREF,FORREF, &
+                     & KA_MO2, KB_MO2
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLO2(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV) 
+
+INTEGER(KIND=JPIM),INTENT(IN)   :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFRAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_MINORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)   :: KINDMINOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)   :: PSCALEMINOR(KIDIA:KFDIA,KLEV)
+! ---------------------------------------------------------------------------
+
+INTEGER(KIND=JPIM) :: IND0(KLEV),IND1(KLEV)
+INTEGER(KIND=JPIM) :: INDS(KLEV),INDF(KLEV),INDM(KLEV)
+
+INTEGER(KIND=JPIM) :: IG, JLAY
+INTEGER(KIND=JPIM) :: JLON
+REAL(KIND=JPRB) :: ZTAUFOR,ZTAUSELF,ZSCALEO2, ZTAUO2
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+! 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.
+  
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL11',0,ZHOOK_HANDLE)
+
+DO JLAY = 1, KLEV
+  DO JLON = KIDIA, KFDIA
+    IF (JLAY <= K_LAYTROP(JLON)) THEN
+      IND0(JLAY) = ((K_JP(JLON,JLAY)-1)*5+(K_JT(JLON,JLAY)-1))*NSPA(11) + 1
+      IND1(JLAY) = (K_JP(JLON,JLAY)*5+(K_JT1(JLON,JLAY)-1))*NSPA(11) + 1
+      INDS(JLAY) = K_INDSELF(JLON,JLAY)
+      INDF(JLAY) = K_INDFOR(JLON,JLAY)
+      INDM(JLAY) = KINDMINOR(JLON,JLAY)
+      ZSCALEO2 = P_COLO2(JLON,JLAY)*PSCALEMINOR(JLON,JLAY)
+!-- DS_000515  
+!CDIR UNROLL=NG11
+      DO IG = 1, NG11
+!-- DS_000515  
+        ZTAUSELF = P_SELFFAC(JLON,JLAY) * (SELFREF(INDS(JLAY),IG) + &
+     &           P_SELFFRAC(JLON,JLAY) * &
+     &           (SELFREF(INDS(JLAY)+1,IG) - SELFREF(INDS(JLAY),IG))) 
+
+        ZTAUFOR =  P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + &
+     &           P_FORFRAC(JLON,JLAY) * (FORREF(INDF(JLAY)+1,IG) - &
+     &           FORREF(INDF(JLAY),IG)))  
+        ZTAUO2 = ZSCALEO2*(KA_MO2(INDM(JLAY),IG) +   &
+     &           P_MINORFRAC(JLON,JLAY) * &
+     &           (KA_MO2(INDM(JLAY)+1,IG) - KA_MO2(INDM(JLAY),IG))) 
+
+        P_TAU(JLON,NGS10+IG,JLAY) = P_COLH2O(JLON,JLAY) *&
+         & (P_FAC00(JLON,JLAY) * ABSA(IND0(JLAY)  ,IG) +&
+         & P_FAC10(JLON,JLAY) * ABSA(IND0(JLAY)+1,IG) +&
+         & P_FAC01(JLON,JLAY) * ABSA(IND1(JLAY)  ,IG) +&
+         & P_FAC11(JLON,JLAY) * ABSA(IND1(JLAY)+1,IG)) +&
+         & ZTAUSELF + ZTAUFOR + ZTAUO2 &
+         & + P_TAUAERL(JLON,JLAY,11)  
+        PFRAC(JLON,NGS10+IG,JLAY) = FRACREFA(IG)
+      ENDDO
+    ENDIF
+
+    IF (JLAY > K_LAYTROP(JLON)) THEN
+      IND0(JLAY) = ((K_JP(JLON,JLAY)-13)*5+(K_JT(JLON,JLAY)-1))*NSPB(11) + 1
+      IND1(JLAY) = ((K_JP(JLON,JLAY)-12)*5+(K_JT1(JLON,JLAY)-1))*NSPB(11) + 1
+      INDF(JLAY) = K_INDFOR(JLON,JLAY)
+      INDM(JLAY) = KINDMINOR(JLON,JLAY)
+      ZSCALEO2 = P_COLO2(JLON,JLAY) * PSCALEMINOR(JLON,JLAY)
+!-- JJM_000517
+!CDIR UNROLL=NG11
+      DO IG = 1, NG11
+!-- JJM_000517
+        ZTAUFOR = P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + &
+     &           P_FORFRAC(JLON,JLAY) * &
+     &           (FORREF(INDF(JLAY)+1,IG) - FORREF(INDF(JLAY),IG))) 
+
+        ZTAUO2 = ZSCALEO2*(KB_MO2(INDM(JLAY),IG) +  &
+     &           P_MINORFRAC(JLON,JLAY) * &
+     &           (KB_MO2(INDM(JLAY)+1,IG) - KB_MO2(INDM(JLAY),IG)))
+
+
+        P_TAU(JLON,NGS10+IG,JLAY) = P_COLH2O(JLON,JLAY) *&
+         & (P_FAC00(JLON,JLAY) * ABSB(IND0(JLAY)  ,IG) +&
+         & P_FAC10(JLON,JLAY) * ABSB(IND0(JLAY)+1,IG) +&
+         & P_FAC01(JLON,JLAY) * ABSB(IND1(JLAY)  ,IG) +&
+         & P_FAC11(JLON,JLAY) * ABSB(IND1(JLAY)+1,IG)) +&
+         & ZTAUFOR + ZTAUO2 + P_TAUAERL(JLON,JLAY,11)  
+        PFRAC(JLON,NGS10+IG,JLAY) = FRACREFB(IG)
+      ENDDO
+    ENDIF
+  ENDDO
+ENDDO
+
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL11',1,ZHOOK_HANDLE)
+
+END ASSOCIATE
+END SUBROUTINE RRTM_TAUMOL11
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol11.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol11.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol11.intfb.h	(revision 3908)
@@ -0,0 +1,34 @@
+INTERFACE
+SUBROUTINE RRTM_TAUMOL11 (KIDIA,KFDIA,KLEV,P_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,&
+ & P_COLH2O,P_COLO2,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC,P_MINORFRAC,KINDMINOR,PSCALEMINOR) 
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+USE PARRRTM , ONLY : JPBAND
+USE YOERRTM , ONLY : JPGPT ,NG11 ,NGS10
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLO2(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_MINORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KINDMINOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PSCALEMINOR(KIDIA:KFDIA,KLEV)
+END SUBROUTINE RRTM_TAUMOL11
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol12.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol12.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol12.F90	(revision 3908)
@@ -0,0 +1,272 @@
+!----------------------------------------------------------------------------
+SUBROUTINE RRTM_TAUMOL12 (KIDIA,KFDIA,KLEV,P_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLCO2,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC, &  
+ & PRAT_H2OCO2, PRAT_H2OCO2_1)
+
+!     BAND 12:  1800-2080 cm-1 (low - H2O,CO2; high - nothing)
+
+!     AUTHOR.
+!     -------
+!      JJMorcrette, ECMWF
+
+!     MODIFICATIONS.
+!     --------------
+!      M.Hamrud      01-Oct-2003 CY28 Cleaning
+!      NEC           25-Oct-2007 Optimisations
+!      JJMorcrette 20110613 flexible number of g-points
+!      ABozzo updated to rrtmg v4.85
+! ---------------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE PARRRTM  , ONLY : JPBAND
+USE YOERRTM  , ONLY : JPGPT  ,NG12 ,NGS11
+USE YOERRTWN , ONLY :      NSPA    
+USE YOERRTA12, ONLY : ABSA   ,FRACREFA,SELFREF,FORREF
+USE YOERRTRF, ONLY : CHI_MLS
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ONEMINUS
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCO2(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV) 
+
+REAL(KIND=JPRB)   ,INTENT(IN)   :: PRAT_H2OCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)   :: PRAT_H2OCO2_1(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)   :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFRAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFAC(KIDIA:KFDIA,KLEV) 
+
+
+! ---------------------------------------------------------------------------
+
+REAL(KIND=JPRB) :: Z_SPECCOMB(KLEV),Z_SPECCOMB1(KLEV),Z_SPECCOMB_PLANCK(KLEV)
+INTEGER(KIND=JPIM) :: IND0(KLEV),IND1(KLEV),INDS(KLEV),INDF(KLEV)
+
+INTEGER(KIND=JPIM) :: IG, JS, JLAY,JS1, JPL
+INTEGER(KIND=JPIM) :: JLON
+
+! REAL(KIND=JPRB) :: Z_FAC000, Z_FAC001, Z_FAC010, Z_FAC011, Z_FAC100, Z_FAC101,&
+!  & Z_FAC110, Z_FAC111
+REAL(KIND=JPRB) :: Z_FS, Z_SPECMULT, Z_SPECPARM,  &
+& Z_FS1, Z_SPECMULT1, Z_SPECPARM1, &
+& Z_FPL, Z_SPECMULT_PLANCK, Z_SPECPARM_PLANCK
+
+REAL(KIND=JPRB) ::  Z_FAC000, Z_FAC100, Z_FAC200,&
+ & Z_FAC010, Z_FAC110, Z_FAC210, &
+ & Z_FAC001, Z_FAC101, Z_FAC201, &
+ & Z_FAC011, Z_FAC111, Z_FAC211
+REAL(KIND=JPRB) :: ZP, ZP4, ZFK0, ZFK1, ZFK2
+REAL(KIND=JPRB) :: ZTAUFOR,ZTAUSELF,ZTAU_MAJOR,ZTAU_MAJOR1
+REAL(KIND=JPRB) :: ZREFRAT_PLANCK_A
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+!  ----------------------------------------------------------
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL12',0,ZHOOK_HANDLE)
+
+! Calculate reference ratio to be used in calculation of Planck
+! fraction in lower/upper atmosphere.
+
+! P =   174.164 mb 
+      Zrefrat_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.  
+
+DO JLAY = 1, KLEV
+  DO JLON = KIDIA, KFDIA
+    IF (JLAY <= K_LAYTROP(JLON)) THEN
+      Z_SPECCOMB(JLAY) = P_COLH2O(JLON,JLAY) + PRAT_H2OCO2(JLON,JLAY)*P_COLCO2(JLON,JLAY)
+      Z_SPECPARM = P_COLH2O(JLON,JLAY)/Z_SPECCOMB(JLAY)
+      Z_SPECPARM=MIN(P_ONEMINUS,Z_SPECPARM)
+      Z_SPECMULT = 8._JPRB*(Z_SPECPARM)
+      JS = 1 + INT(Z_SPECMULT)
+      Z_FS = MOD(Z_SPECMULT,1.0_JPRB)
+
+      Z_SPECCOMB1(JLAY) = P_COLH2O(JLON,JLAY) + PRAT_H2OCO2_1(JLON,JLAY)*P_COLCO2(JLON,JLAY)
+      Z_SPECPARM1 = P_COLH2O(JLON,JLAY)/Z_SPECCOMB1(JLAY)
+      IF (Z_SPECPARM1 >= P_ONEMINUS) Z_SPECPARM1 = P_ONEMINUS
+      Z_SPECMULT1 = 8._JPRB*(Z_SPECPARM1)
+      JS1 = 1 + INT(Z_SPECMULT1)
+      Z_FS1 = MOD(Z_SPECMULT1,1.0_JPRB)
+
+      Z_SPECCOMB_PLANCK(JLAY) = P_COLH2O(JLON,JLAY)+ZREFRAT_PLANCK_A*P_COLCO2(JLON,JLAY)
+      Z_SPECPARM_PLANCK = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_PLANCK(JLAY)
+      IF (Z_SPECPARM_PLANCK >= P_ONEMINUS) Z_SPECPARM_PLANCK=P_ONEMINUS
+      Z_SPECMULT_PLANCK = 8._JPRB*Z_SPECPARM_PLANCK
+      JPL= 1 + INT(Z_SPECMULT_PLANCK)
+      Z_FPL = MOD(Z_SPECMULT_PLANCK,1.0_JPRB)
+
+      IND0(JLAY) = ((K_JP(JLON,JLAY)-1)*5+(K_JT(JLON,JLAY)-1))*NSPA(12) + JS
+      IND1(JLAY) = (K_JP(JLON,JLAY)*5+(K_JT1(JLON,JLAY)-1))*NSPA(12) + JS1
+      INDS(JLAY) = K_INDSELF(JLON,JLAY)
+      INDF(JLAY) = K_INDFOR(JLON,JLAY)
+
+  IF (Z_SPECPARM < 0.125_JPRB) THEN
+            ZP = Z_FS - 1
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC000 = ZFK0*P_FAC00(JLON,JLAY)
+            Z_FAC100 = ZFK1*P_FAC00(JLON,JLAY)
+            Z_FAC200 = ZFK2*P_FAC00(JLON,JLAY)
+            Z_FAC010 = ZFK0*P_FAC10(JLON,JLAY)
+            Z_FAC110 = ZFK1*P_FAC10(JLON,JLAY)
+            Z_FAC210 = ZFK2*P_FAC10(JLON,JLAY)
+      ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
+            ZP = -Z_FS 
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC000 = ZFK0*P_FAC00(JLON,JLAY)
+            Z_FAC100 = ZFK1*P_FAC00(JLON,JLAY)
+            Z_FAC200 = ZFK2*P_FAC00(JLON,JLAY)
+            Z_FAC010 = ZFK0*P_FAC10(JLON,JLAY)
+            Z_FAC110 = ZFK1*P_FAC10(JLON,JLAY)
+            Z_FAC210 = ZFK2*P_FAC10(JLON,JLAY)
+      ELSE
+            Z_FAC000 = (1._JPRB - Z_FS) * P_FAC00(JLON,JLAY)
+            Z_FAC010 = (1._JPRB - Z_FS) * P_FAC10(JLON,JLAY)
+            Z_FAC100 = Z_FS * P_FAC00(JLON,JLAY)
+            Z_FAC110 = Z_FS * P_FAC10(JLON,JLAY)
+      ENDIF
+      IF (Z_SPECPARM1 < 0.125_JPRB) THEN
+            ZP = Z_FS1 - 1
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC001 = ZFK0*P_FAC01(JLON,JLAY)
+            Z_FAC101 = ZFK1*P_FAC01(JLON,JLAY)
+            Z_FAC201 = ZFK2*P_FAC01(JLON,JLAY)
+            Z_FAC011 = ZFK0*P_FAC11(JLON,JLAY)
+            Z_FAC111 = ZFK1*P_FAC11(JLON,JLAY)
+            Z_FAC211 = ZFK2*P_FAC11(JLON,JLAY)
+      ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
+            ZP = -Z_FS1 
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC001 = ZFK0*P_FAC01(JLON,JLAY)
+            Z_FAC101 = ZFK1*P_FAC01(JLON,JLAY)
+            Z_FAC201 = ZFK2*P_FAC01(JLON,JLAY)
+            Z_FAC011 = ZFK0*P_FAC11(JLON,JLAY)
+            Z_FAC111 = ZFK1*P_FAC11(JLON,JLAY)
+            Z_FAC211 = ZFK2*P_FAC11(JLON,JLAY)
+      ELSE
+            Z_FAC001 = (1._JPRB - Z_FS1) * P_FAC01(JLON,JLAY)
+            Z_FAC011 = (1._JPRB - Z_FS1) * P_FAC11(JLON,JLAY)
+            Z_FAC101 = Z_FS1 * P_FAC01(JLON,JLAY)
+            Z_FAC111 = Z_FS1 * P_FAC11(JLON,JLAY)
+      ENDIF
+
+
+
+!-- DS_000515
+!CDIR UNROLL=NG12
+      DO IG = 1, NG12
+!-- DS_000515 
+        ZTAUSELF = P_SELFFAC(JLON,JLAY)* (SELFREF(INDS(JLAY),IG) + P_SELFFRAC(JLON,JLAY) * &
+          &       (SELFREF(INDS(JLAY)+1,IG) - SELFREF(INDS(JLAY),IG)))
+        ZTAUFOR = P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + P_FORFRAC(JLON,JLAY) * &
+          &       (FORREF(INDF(JLAY)+1,IG) - FORREF(INDF(JLAY),IG))) 
+
+            IF (Z_SPECPARM < 0.125_JPRB) THEN
+               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
+                 &   (Z_FAC000 * ABSA(IND0(JLAY),IG) + &
+                 &   Z_FAC100 * ABSA(IND0(JLAY)+1,IG) + &
+                 &   Z_FAC200 * ABSA(IND0(JLAY)+2,IG) + &
+                 &   Z_FAC010 * ABSA(IND0(JLAY)+9,IG) + &
+                 &   Z_FAC110 * ABSA(IND0(JLAY)+10,IG) + &
+                 &   Z_FAC210 * ABSA(IND0(JLAY)+11,IG))
+            ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
+               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
+                 &   (Z_FAC200 * ABSA(IND0(JLAY)-1,IG) + &
+                 &   Z_FAC100 * ABSA(IND0(JLAY),IG) + &
+                 &   Z_FAC000 * ABSA(IND0(JLAY)+1,IG) + &
+                 &   Z_FAC210 * ABSA(IND0(JLAY)+8,IG) + &
+                 &   Z_FAC110 * ABSA(IND0(JLAY)+9,IG) + &
+                 &   Z_FAC010 * ABSA(IND0(JLAY)+10,IG))
+            ELSE
+               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
+                 &   (Z_FAC000 * ABSA(IND0(JLAY),IG) + &
+                 &   Z_FAC100 * ABSA(IND0(JLAY)+1,IG) + &
+                 &   Z_FAC010 * ABSA(IND0(JLAY)+9,IG) + &
+                 &   Z_FAC110 * ABSA(IND0(JLAY)+10,IG))
+            ENDIF
+
+            IF (Z_SPECPARM1 < 0.125_JPRB) THEN
+               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
+                &    (Z_FAC001 * ABSA(IND1(JLAY),IG) + &
+                &    Z_FAC101 * ABSA(IND1(JLAY)+1,IG) + &
+                &    Z_FAC201 * ABSA(IND1(JLAY)+2,IG) + &
+                &    Z_FAC011 * ABSA(IND1(JLAY)+9,IG) + &
+                &    Z_FAC111 * ABSA(IND1(JLAY)+10,IG) + &
+                &    Z_FAC211 * ABSA(IND1(JLAY)+11,IG))
+            ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
+               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
+                &    (Z_FAC201 * ABSA(IND1(JLAY)-1,IG) + &
+                &    Z_FAC101 * ABSA(IND1(JLAY),IG) + &
+                &    Z_FAC001 * ABSA(IND1(JLAY)+1,IG) + &
+                &    Z_FAC211 * ABSA(IND1(JLAY)+8,IG) + &
+                &    Z_FAC111 * ABSA(IND1(JLAY)+9,IG) + &
+                &    Z_FAC011 * ABSA(IND1(JLAY)+10,IG))
+            ELSE
+               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
+                &    (Z_FAC001 * ABSA(IND1(JLAY),IG) +  &
+                &    Z_FAC101 * ABSA(IND1(JLAY)+1,IG) + &
+                &    Z_FAC011 * ABSA(IND1(JLAY)+9,IG) + &
+                &    Z_FAC111 * ABSA(IND1(JLAY)+10,IG))
+            ENDIF
+
+        P_TAU(JLON,NGS11+IG,JLAY) = ZTAU_MAJOR + ZTAU_MAJOR1 &
+         & + ZTAUSELF + ZTAUFOR &
+         & + P_TAUAERL(JLON,JLAY,12)  
+        PFRAC(JLON,NGS11+IG,JLAY) = FRACREFA(IG,JPL) + Z_FPL *&
+         & (FRACREFA(IG,JPL+1) - FRACREFA(IG,JPL))
+      ENDDO
+    ENDIF
+
+!-- JJM_000517
+    IF (JLAY > K_LAYTROP(JLON)) THEN
+!CDIR UNROLL=NG12
+      DO IG = 1, NG12
+!-- JJM_000517
+        P_TAU(JLON,NGS11+IG,JLAY) = P_TAUAERL(JLON,JLAY,12)
+        PFRAC(JLON,NGS11+IG,JLAY) = 0.0_JPRB
+      ENDDO
+    ENDIF
+  ENDDO
+ENDDO
+
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL12',1,ZHOOK_HANDLE)
+
+END ASSOCIATE
+END SUBROUTINE RRTM_TAUMOL12
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol12.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol12.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol12.intfb.h	(revision 3908)
@@ -0,0 +1,35 @@
+INTERFACE
+SUBROUTINE RRTM_TAUMOL12 (KIDIA,KFDIA,KLEV,P_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLCO2,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC,&
+ & PRAT_H2OCO2, PRAT_H2OCO2_1) 
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+USE PARRRTM , ONLY : JPBAND
+USE YOERRTM , ONLY : JPGPT ,NG12 ,NGS11
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCO2(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRAT_H2OCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRAT_H2OCO2_1(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(KIDIA:KFDIA,KLEV)
+END SUBROUTINE RRTM_TAUMOL12
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol13.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol13.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol13.F90	(revision 3908)
@@ -0,0 +1,337 @@
+!----------------------------------------------------------------------------
+SUBROUTINE RRTM_TAUMOL13 (KIDIA,KFDIA,KLEV,P_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLN2O,P_COLCO2,P_COLO3,P_COLDRY,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC, &
+ & PRAT_H2ON2O, PRAT_H2ON2O_1,PMINORFRAC,KINDMINOR)  
+
+!     BAND 13:  2080-2250 cm-1 (low - H2O,N2O; high - nothing)
+
+!     AUTHOR.
+!     -------
+!      JJMorcrette, ECMWF
+
+  !     MODIFICATIONS.
+!     --------------
+!      M.Hamrud      01-Oct-2003 CY28 Cleaning
+!      NEC           25-Oct-2007 Optimisations
+!      JJMorcrette 20110613 flexible number of g-points
+!      ABozzo 201306 updated to rrtmg v4.85
+!     band 13:  2080-2250 cm-1 (low key - h2o,n2o; high minor - o3 minor)
+! ---------------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE PARRRTM  , ONLY : JPBAND
+USE YOERRTM  , ONLY : JPGPT  ,NG13  ,NGS12
+USE YOERRTWN , ONLY : NSPA   
+USE YOERRTA13, ONLY : ABSA   ,FRACREFA,FRACREFB,SELFREF,FORREF,KA_MCO2, KA_MCO, KB_MO3
+USE YOERRTRF, ONLY : CHI_MLS
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ONEMINUS
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLN2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLO3(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLDRY(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV) 
+
+REAL(KIND=JPRB)   ,INTENT(IN)   :: PRAT_H2ON2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)   :: PRAT_H2ON2O_1(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)   :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFRAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)   :: PMINORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)   :: KINDMINOR(KIDIA:KFDIA,KLEV)
+
+! ---------------------------------------------------------------------------
+
+
+REAL(KIND=JPRB) :: Z_SPECCOMB(KLEV),Z_SPECCOMB1(KLEV), Z_SPECCOMB_PLANCK(KLEV), &
+                   & Z_SPECCOMB_MCO2(KLEV), Z_SPECCOMB_MCO(KLEV)
+INTEGER(KIND=JPIM) :: IND0(KLEV),IND1(KLEV),INDS(KLEV),INDF(KLEV),INDM(KLEV)
+INTEGER(KIND=JPIM) :: IG, JS, JLAY, JS1, JPL, JMCO2, JMCO
+INTEGER(KIND=JPIM) :: JLON
+
+REAL(KIND=JPRB) :: ZREFRAT_PLANCK_A, ZREFRAT_M_A, ZREFRAT_M_A3
+REAL(KIND=JPRB) ::  Z_FAC000, Z_FAC100, Z_FAC200,&
+ & Z_FAC010, Z_FAC110, Z_FAC210, &
+ & Z_FAC001, Z_FAC101, Z_FAC201, &
+ & Z_FAC011, Z_FAC111, Z_FAC211
+REAL(KIND=JPRB) :: ZP, ZP4, ZFK0, ZFK1, ZFK2
+
+REAL(KIND=JPRB) :: ZTAUFOR,ZTAUSELF,ZTAU_MAJOR,ZTAU_MAJOR1, ZCO2M1, ZCO2M2, ZABSCO2
+REAL(KIND=JPRB) :: ZCOM1, ZCOM2, ZABSCO, ZABSO3
+REAL(KIND=JPRB) :: ZCHI_CO2, ZRATCO2, ZADJFAC, ZADJCOLCO2(KIDIA:KFDIA,KLEV)
+
+REAL(KIND=JPRB) :: Z_FS, Z_SPECMULT, Z_SPECPARM,  &
+& Z_FS1, Z_SPECMULT1, Z_SPECPARM1, &
+& Z_FMCO2, Z_SPECMULT_MCO2, Z_SPECPARM_MCO2, &
+& Z_FMCO , Z_SPECMULT_MCO , Z_SPECPARM_MCO , &
+& Z_FPL, Z_SPECMULT_PLANCK, Z_SPECPARM_PLANCK
+
+REAL(KIND=JPRB)   :: Z_COLCO(KIDIA:KFDIA,KLEV) !left =0 for now,not passed from rrtm_gasbas1a
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+ 
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL13',0,ZHOOK_HANDLE)
+
+! 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)
+      ZREFRAT_PLANCK_A = CHI_MLS(1,5)/CHI_MLS(4,5)
+
+! P = 1053. (Level 1)
+      ZREFRAT_M_A = CHI_MLS(1,1)/CHI_MLS(4,1)
+
+! P = 706. (Level 3)
+      ZREFRAT_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.  
+
+
+DO JLAY = 1, KLEV
+  DO JLON = KIDIA, KFDIA
+    Z_COLCO(JLON,JLAY) = 0.0_JPRB
+    IF (JLAY <= K_LAYTROP(JLON)) THEN
+      Z_SPECCOMB(JLAY) = P_COLH2O(JLON,JLAY) + PRAT_H2ON2O(JLON,JLAY)*P_COLN2O(JLON,JLAY)
+      Z_SPECPARM = P_COLH2O(JLON,JLAY)/Z_SPECCOMB(JLAY)
+      Z_SPECPARM=MIN(P_ONEMINUS,Z_SPECPARM)
+      Z_SPECMULT = 8._JPRB*(Z_SPECPARM)
+      JS = 1 + INT(Z_SPECMULT)
+      Z_FS = MOD(Z_SPECMULT,1.0_JPRB)
+
+      Z_SPECCOMB1(JLAY) = P_COLH2O(JLON,JLAY) + PRAT_H2ON2O_1(JLON,JLAY)*P_COLN2O(JLON,JLAY)
+      Z_SPECPARM1 = P_COLH2O(JLON,JLAY)/Z_SPECCOMB1(JLAY)
+      IF (Z_SPECPARM1 >= P_ONEMINUS) Z_SPECPARM1 = P_ONEMINUS
+      Z_SPECMULT1 = 8._JPRB*(Z_SPECPARM1)
+      JS1 = 1 + INT(Z_SPECMULT1)
+      Z_FS1 = MOD(Z_SPECMULT1,1.0_JPRB)
+
+      Z_SPECCOMB_MCO2(JLAY) = P_COLH2O(JLON,JLAY) + ZREFRAT_M_A*P_COLN2O(JLON,JLAY)
+      Z_SPECPARM_MCO2 = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_MCO2(JLAY)
+      IF (Z_SPECPARM_MCO2 >= P_ONEMINUS) Z_SPECPARM_MCO2 = P_ONEMINUS
+      Z_SPECMULT_MCO2 = 8._JPRB*Z_SPECPARM_MCO2
+      JMCO2 = 1 + INT(Z_SPECMULT_MCO2)
+      Z_FMCO2 = MOD(Z_SPECMULT_MCO2,1.0_JPRB)
+! 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.
+      ZCHI_CO2 = P_COLCO2(JLON,JLAY)/P_COLDRY(JLON,JLAY)
+      ZRATCO2 = 1.E20_JPRB*ZCHI_CO2/3.55E-4_JPRB
+      IF (ZRATCO2 > 3.0_JPRB) THEN
+         ZADJFAC = 2.0_JPRB+(ZRATCO2-2.0_JPRB)**0.68_JPRB
+         ZADJCOLCO2(JLON,JLAY) = ZADJFAC*3.55E-4*P_COLDRY(JLON,JLAY)*1.E-20_JPRB
+      ELSE
+         ZADJCOLCO2(JLON,JLAY) = P_COLCO2(JLON,JLAY)
+      ENDIF
+
+      Z_SPECCOMB_MCO(JLAY) = P_COLH2O(JLON,JLAY) + ZREFRAT_M_A3*P_COLN2O(JLON,JLAY)
+      Z_SPECPARM_MCO = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_MCO(JLAY)
+      IF (Z_SPECPARM_MCO >= P_ONEMINUS) Z_SPECPARM_MCO = P_ONEMINUS
+      Z_SPECMULT_MCO = 8._JPRB*Z_SPECPARM_MCO
+      JMCO = 1 + INT(Z_SPECMULT_MCO)
+      Z_FMCO = MOD(Z_SPECMULT_MCO,1.0_JPRB)
+
+      Z_SPECCOMB_PLANCK(JLAY) = P_COLH2O(JLON,JLAY)+ZREFRAT_PLANCK_A*P_COLN2O(JLON,JLAY)
+      Z_SPECPARM_PLANCK = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_PLANCK(JLAY)
+      IF (Z_SPECPARM_PLANCK >= P_ONEMINUS) Z_SPECPARM_PLANCK=P_ONEMINUS
+      Z_SPECMULT_PLANCK = 8._JPRB*Z_SPECPARM_PLANCK
+      JPL= 1 + INT(Z_SPECMULT_PLANCK)
+      Z_FPL = MOD(Z_SPECMULT_PLANCK,1.0_JPRB)
+
+      IND0(JLAY) = ((K_JP(JLON,JLAY)-1)*5+(K_JT(JLON,JLAY)-1))*NSPA(13) + JS
+      IND1(JLAY) = (K_JP(JLON,JLAY)*5+(K_JT1(JLON,JLAY)-1))*NSPA(13) + JS1
+      INDS(JLAY) = K_INDSELF(JLON,JLAY)
+      INDF(JLAY) = K_INDFOR(JLON,JLAY)
+      INDM(JLAY) = KINDMINOR(JLON,JLAY)
+  
+IF (Z_SPECPARM < 0.125_JPRB) THEN
+            ZP = Z_FS - 1
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC000 = ZFK0*P_FAC00(JLON,JLAY)
+            Z_FAC100 = ZFK1*P_FAC00(JLON,JLAY)
+            Z_FAC200 = ZFK2*P_FAC00(JLON,JLAY)
+            Z_FAC010 = ZFK0*P_FAC10(JLON,JLAY)
+            Z_FAC110 = ZFK1*P_FAC10(JLON,JLAY)
+            Z_FAC210 = ZFK2*P_FAC10(JLON,JLAY)
+      ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
+            ZP = -Z_FS 
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC000 = ZFK0*P_FAC00(JLON,JLAY)
+            Z_FAC100 = ZFK1*P_FAC00(JLON,JLAY)
+            Z_FAC200 = ZFK2*P_FAC00(JLON,JLAY)
+            Z_FAC010 = ZFK0*P_FAC10(JLON,JLAY)
+            Z_FAC110 = ZFK1*P_FAC10(JLON,JLAY)
+            Z_FAC210 = ZFK2*P_FAC10(JLON,JLAY)
+      ELSE
+            Z_FAC000 = (1._JPRB - Z_FS) * P_FAC00(JLON,JLAY)
+            Z_FAC010 = (1._JPRB - Z_FS) * P_FAC10(JLON,JLAY)
+            Z_FAC100 = Z_FS * P_FAC00(JLON,JLAY)
+            Z_FAC110 = Z_FS * P_FAC10(JLON,JLAY)
+      ENDIF
+      IF (Z_SPECPARM1 < 0.125_JPRB) THEN
+            ZP = Z_FS1 - 1
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC001 = ZFK0*P_FAC01(JLON,JLAY)
+            Z_FAC101 = ZFK1*P_FAC01(JLON,JLAY)
+            Z_FAC201 = ZFK2*P_FAC01(JLON,JLAY)
+            Z_FAC011 = ZFK0*P_FAC11(JLON,JLAY)
+            Z_FAC111 = ZFK1*P_FAC11(JLON,JLAY)
+            Z_FAC211 = ZFK2*P_FAC11(JLON,JLAY)
+      ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
+            ZP = -Z_FS1 
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC001 = ZFK0*P_FAC01(JLON,JLAY)
+            Z_FAC101 = ZFK1*P_FAC01(JLON,JLAY)
+            Z_FAC201 = ZFK2*P_FAC01(JLON,JLAY)
+            Z_FAC011 = ZFK0*P_FAC11(JLON,JLAY)
+            Z_FAC111 = ZFK1*P_FAC11(JLON,JLAY)
+            Z_FAC211 = ZFK2*P_FAC11(JLON,JLAY)
+      ELSE
+            Z_FAC001 = (1._JPRB - Z_FS1) * P_FAC01(JLON,JLAY)
+            Z_FAC011 = (1._JPRB - Z_FS1) * P_FAC11(JLON,JLAY)
+            Z_FAC101 = Z_FS1 * P_FAC01(JLON,JLAY)
+            Z_FAC111 = Z_FS1 * P_FAC11(JLON,JLAY)
+      ENDIF
+
+
+!-- DS_000515
+!CDIR UNROLL=NG13
+      DO IG = 1, NG13
+!-- DS_000515
+        ZTAUSELF = P_SELFFAC(JLON,JLAY)* (SELFREF(INDS(JLAY),IG) + P_SELFFRAC(JLON,JLAY) * &
+          &       (SELFREF(INDS(JLAY)+1,IG) - SELFREF(INDS(JLAY),IG)))
+        ZTAUFOR = P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + P_FORFRAC(JLON,JLAY) * &
+          &       (FORREF(INDF(JLAY)+1,IG) - FORREF(INDF(JLAY),IG))) 
+        ZCO2M1 = KA_MCO2(JMCO2,INDM(JLAY),IG) + Z_FMCO2 * &
+          &       (KA_MCO2(JMCO2+1,INDM(JLAY),IG) - KA_MCO2(JMCO2,INDM(JLAY),IG))
+        ZCO2M2 = KA_MCO2(JMCO2,INDM(JLAY)+1,IG) + Z_FMCO2 * &
+          &       (KA_MCO2(JMCO2+1,INDM(JLAY)+1,IG) - KA_MCO2(JMCO2,INDM(JLAY)+1,IG))
+        ZABSCO2 = ZCO2M1 + PMINORFRAC(JLON,JLAY) * (ZCO2M2 - ZCO2M1)
+        ZCOM1 = KA_MCO(JMCO,INDM(JLAY),IG) + Z_FMCO * &
+          &       (KA_MCO(JMCO+1,INDM(JLAY),IG) - KA_MCO(JMCO,INDM(JLAY),IG))
+        ZCOM2 = KA_MCO(JMCO,INDM(JLAY)+1,IG) + Z_FMCO * &
+          &       (KA_MCO(JMCO+1,INDM(JLAY)+1,IG) - KA_MCO(JMCO,INDM(JLAY)+1,IG))
+        ZABSCO = ZCOM1 + PMINORFRAC(JLON,JLAY) * (ZCOM2 - ZCOM1)
+
+      IF (Z_SPECPARM < 0.125_JPRB) THEN
+               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
+                 &   (Z_FAC000 * ABSA(IND0(JLAY),IG) + &
+                 &   Z_FAC100 * ABSA(IND0(JLAY)+1,IG) + &
+                 &   Z_FAC200 * ABSA(IND0(JLAY)+2,IG) + &
+                 &   Z_FAC010 * ABSA(IND0(JLAY)+9,IG) + &
+                 &   Z_FAC110 * ABSA(IND0(JLAY)+10,IG) + &
+                 &   Z_FAC210 * ABSA(IND0(JLAY)+11,IG))
+            ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
+               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
+                 &   (Z_FAC200 * ABSA(IND0(JLAY)-1,IG) + &
+                 &   Z_FAC100 * ABSA(IND0(JLAY),IG) + &
+                 &   Z_FAC000 * ABSA(IND0(JLAY)+1,IG) + &
+                 &   Z_FAC210 * ABSA(IND0(JLAY)+8,IG) + &
+                 &   Z_FAC110 * ABSA(IND0(JLAY)+9,IG) + &
+                 &   Z_FAC010 * ABSA(IND0(JLAY)+10,IG))
+            ELSE
+               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
+                 &   (Z_FAC000 * ABSA(IND0(JLAY),IG) + &
+                 &   Z_FAC100 * ABSA(IND0(JLAY)+1,IG) + &
+                 &   Z_FAC010 * ABSA(IND0(JLAY)+9,IG) + &
+                 &   Z_FAC110 * ABSA(IND0(JLAY)+10,IG))
+            ENDIF
+
+            IF (Z_SPECPARM1 < 0.125_JPRB) THEN
+               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
+                &    (Z_FAC001 * ABSA(IND1(JLAY),IG) + &
+                &    Z_FAC101 * ABSA(IND1(JLAY)+1,IG) + &
+                &    Z_FAC201 * ABSA(IND1(JLAY)+2,IG) + &
+                &    Z_FAC011 * ABSA(IND1(JLAY)+9,IG) + &
+                &    Z_FAC111 * ABSA(IND1(JLAY)+10,IG) + &
+                &    Z_FAC211 * ABSA(IND1(JLAY)+11,IG))
+            ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
+               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
+                &    (Z_FAC201 * ABSA(IND1(JLAY)-1,IG) + &
+                &    Z_FAC101 * ABSA(IND1(JLAY),IG) + &
+                &    Z_FAC001 * ABSA(IND1(JLAY)+1,IG) + &
+                &    Z_FAC211 * ABSA(IND1(JLAY)+8,IG) + &
+                &    Z_FAC111 * ABSA(IND1(JLAY)+9,IG) + &
+                &    Z_FAC011 * ABSA(IND1(JLAY)+10,IG))
+            ELSE
+               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
+                &    (Z_FAC001 * ABSA(IND1(JLAY),IG) +  &
+                &    Z_FAC101 * ABSA(IND1(JLAY)+1,IG) + &
+                &    Z_FAC011 * ABSA(IND1(JLAY)+9,IG) + &
+                &    Z_FAC111 * ABSA(IND1(JLAY)+10,IG))
+            ENDIF
+
+
+        P_TAU(JLON,NGS12+IG,JLAY) = ZTAU_MAJOR + ZTAU_MAJOR1 &
+               & + ZTAUSELF + ZTAUFOR &
+               & + ZADJCOLCO2(JLON,JLAY)*ZABSCO2 &
+               & + Z_COLCO(JLON,JLAY)*ZABSCO &
+               & + P_TAUAERL(JLON,JLAY,13)  
+        PFRAC(JLON,NGS12+IG,JLAY) = FRACREFA(IG,JPL) + Z_FPL * &
+         & (FRACREFA(IG,JPL+1) - FRACREFA(IG,JPL))  
+      ENDDO
+    ENDIF
+
+!-- JJM_000517
+    IF (JLAY > K_LAYTROP(JLON)) THEN
+      INDM(JLAY) = KINDMINOR(JLON,JLAY)
+!CDIR UNROLL=NG13
+      DO IG = 1, NG13
+!-- JJM_000517
+        ZABSO3 = KB_MO3(INDM(JLAY),IG) + PMINORFRAC(JLON,JLAY) * &
+         &       (KB_MO3(INDM(JLAY)+1,IG) - KB_MO3(INDM(JLAY),IG))
+        P_TAU(JLON,NGS12+IG,JLAY) = P_COLO3(JLON,JLAY)*ZABSO3+P_TAUAERL(JLON,JLAY,13)
+        PFRAC(JLON,NGS12+IG,JLAY) = FRACREFB(IG)
+      ENDDO
+    ENDIF
+  ENDDO
+ENDDO
+
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL13',1,ZHOOK_HANDLE)
+
+END ASSOCIATE
+END SUBROUTINE RRTM_TAUMOL13
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol13.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol13.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol13.intfb.h	(revision 3908)
@@ -0,0 +1,40 @@
+INTERFACE
+SUBROUTINE RRTM_TAUMOL13 (KIDIA,KFDIA,KLEV,P_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLN2O,P_COLCO2,P_COLO3,P_COLDRY,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC,&
+ & PRAT_H2ON2O, PRAT_H2ON2O_1,PMINORFRAC,KINDMINOR) 
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+USE PARRRTM , ONLY : JPBAND
+USE YOERRTM , ONLY : JPGPT ,NG13 ,NGS12
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLN2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLO3(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLDRY(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRAT_H2ON2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRAT_H2ON2O_1(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PMINORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KINDMINOR(KIDIA:KFDIA,KLEV)
+END SUBROUTINE RRTM_TAUMOL13
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol14.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol14.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol14.F90	(revision 3908)
@@ -0,0 +1,121 @@
+!******************************************************************************
+SUBROUTINE RRTM_TAUMOL14 (KIDIA,KFDIA,KLEV,P_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,&
+ & P_COLCO2,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
+
+!     BAND 14:  2250-2380 cm-1 (low - CO2; high - CO2)
+
+!     AUTHOR.
+!     -------
+!      JJMorcrette, ECMWF
+
+!     MODIFICATIONS.
+!     --------------
+!        M.Hamrud      01-Oct-2003 CY28 Cleaning
+!        NEC           25-Oct-2007 Optimisations
+!        JJMorcrette 20110613 flexible number of g-points
+!        ABozzo 201306 updated to rrtmg v4.85
+! ---------------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE PARRRTM  , ONLY : JPBAND
+USE YOERRTM  , ONLY : JPGPT  ,NGS13  ,NG14
+USE YOERRTWN , ONLY : NSPA   ,NSPB
+USE YOERRTA14, ONLY : ABSA   ,ABSB   ,FRACREFA, FRACREFB,SELFREF,FORREF
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCO2(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV) 
+
+INTEGER(KIND=JPIM),INTENT(IN)   :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFRAC(KIDIA:KFDIA,KLEV) 
+! ---------------------------------------------------------------------------
+
+INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, INDF, JLAY
+INTEGER(KIND=JPIM) :: JLON
+REAL(KIND=JPRB) :: ZTAUFOR,ZTAUSELF
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+! 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.  
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL14',0,ZHOOK_HANDLE)
+
+DO JLAY = 1, KLEV
+  DO JLON = KIDIA, KFDIA
+    IF (JLAY <= K_LAYTROP(JLON)) THEN
+      IND0 = ((K_JP(JLON,JLAY)-1)*5+(K_JT(JLON,JLAY)-1))*NSPA(14) + 1
+      IND1 = (K_JP(JLON,JLAY)*5+(K_JT1(JLON,JLAY)-1))*NSPA(14) + 1
+      INDS = K_INDSELF(JLON,JLAY)
+      INDF = K_INDFOR(JLON,JLAY)
+
+!-- DS_990714  
+!-- jjm20110728 re-establishing the loop instead of specified IG to allow a flexible number of NG14
+      DO IG = 1, NG14
+!      IG=1
+        ZTAUSELF = P_SELFFAC(JLON,JLAY)* (SELFREF(INDS,IG) + P_SELFFRAC(JLON,JLAY) * &
+          &       (SELFREF(INDS+1,IG) - SELFREF(INDS,IG)))
+        ZTAUFOR = P_FORFAC(JLON,JLAY) * (FORREF(INDF,IG) + P_FORFRAC(JLON,JLAY) * &
+          &       (FORREF(INDF+1,IG) - FORREF(INDF,IG))) 
+
+        P_TAU(JLON,NGS13+IG,JLAY) = P_COLCO2(JLON,JLAY) *&
+         & (P_FAC00(JLON,JLAY) * ABSA(IND0  ,IG) +&
+         & P_FAC10(JLON,JLAY) * ABSA(IND0+1,IG) +&
+         & P_FAC01(JLON,JLAY) * ABSA(IND1  ,IG) +&
+         & P_FAC11(JLON,JLAY) * ABSA(IND1+1,IG)) &
+         & + ZTAUSELF + ZTAUFOR &
+         & + P_TAUAERL(JLON,JLAY,14)  
+        PFRAC(JLON,NGS13+IG,JLAY) = FRACREFA(IG)
+      ENDDO
+!-- jjm20110728
+!-- DS_990714  
+    ENDIF
+
+    IF (JLAY > K_LAYTROP(JLON)) THEN
+      IND0 = ((K_JP(JLON,JLAY)-13)*5+(K_JT(JLON,JLAY)-1))*NSPB(14) + 1
+      IND1 = ((K_JP(JLON,JLAY)-12)*5+(K_JT1(JLON,JLAY)-1))*NSPB(14) + 1
+!-- DS_990714  
+!-- jjm20110728 re-establishing the loop instead of specified IG to allow a flexible number of NG14
+      DO IG = 1, NG14
+!      IG=1
+        P_TAU(JLON,NGS13+IG,JLAY) = P_COLCO2(JLON,JLAY) *&
+         & (P_FAC00(JLON,JLAY) * ABSB(IND0  ,IG) +&
+         & P_FAC10(JLON,JLAY) * ABSB(IND0+1,IG) +&
+         & P_FAC01(JLON,JLAY) * ABSB(IND1  ,IG) +&
+         & P_FAC11(JLON,JLAY) * ABSB(IND1+1,IG)) &
+         & + P_TAUAERL(JLON,JLAY,14)  
+        PFRAC(JLON,NGS13+IG,JLAY) = FRACREFB(IG)
+      ENDDO
+!-- jjm20110728
+!-- DS_990714  
+    ENDIF
+  ENDDO
+ENDDO
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL14',1,ZHOOK_HANDLE)
+
+END ASSOCIATE
+END SUBROUTINE RRTM_TAUMOL14
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol14.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol14.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol14.intfb.h	(revision 3908)
@@ -0,0 +1,30 @@
+INTERFACE
+SUBROUTINE RRTM_TAUMOL14 (KIDIA,KFDIA,KLEV,P_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,&
+ & P_COLCO2,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC) 
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+USE PARRRTM , ONLY : JPBAND
+USE YOERRTM , ONLY : JPGPT ,NGS13 ,NG14
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCO2(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+END SUBROUTINE RRTM_TAUMOL14
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol15.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol15.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol15.F90	(revision 3908)
@@ -0,0 +1,292 @@
+!----------------------------------------------------------------------------
+SUBROUTINE RRTM_TAUMOL15 (KIDIA,KFDIA,KLEV,P_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLCO2,P_COLN2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC, &
+ & PRAT_N2OCO2, PRAT_N2OCO2_1,PMINORFRAC,KINDMINOR,PSCALEMINOR,PCOLBRD)  
+
+!     BAND 15:  2380-2600 cm-1 (low - N2O,CO2; high - nothing)
+
+!     AUTHOR.
+!     -------
+!      JJMorcrette, ECMWF
+
+!     MODIFICATIONS.
+!     --------------
+!      M.Hamrud      01-Oct-2003 CY28 Cleaning
+!      NEC           25-Oct-2007 Optimisations
+!      JJMorcrette 20110613 flexible number of g-points
+!     ABozzo 2001306 updated to rrtmg v4.85
+!     band 15:  2380-2600 cm-1 (low - n2o,co2; low minor - n2)
+!                              (high - nothing)
+! ---------------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE PARRRTM  , ONLY : JPBAND
+USE YOERRTM  , ONLY : JPGPT  ,NGS14  ,NG15
+USE YOERRTWN , ONLY : NSPA   
+USE YOERRTA15, ONLY : ABSA   ,KA_MN2,FRACREFA,SELFREF,FORREF
+USE YOERRTRF, ONLY : CHI_MLS
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ONEMINUS
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCO2(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLN2O(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV) 
+
+REAL(KIND=JPRB)   ,INTENT(IN)   :: PRAT_N2OCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)   :: PRAT_N2OCO2_1(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)   :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFRAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)   :: PMINORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)   :: KINDMINOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PSCALEMINOR(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLBRD(KIDIA:KFDIA,KLEV)         
+! ---------------------------------------------------------------------------
+
+INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS,INDF,INDM, JS,JS1,JPL,JMN2, JLAY
+INTEGER(KIND=JPIM) :: JLON
+REAL(KIND=JPRB) :: ZREFRAT_PLANCK_A, ZREFRAT_M_A
+REAL(KIND=JPRB) :: ZTAUFOR,ZTAUSELF,ZTAU_MAJOR,ZTAU_MAJOR1, ZN2M1, ZN2M2, ZTAUN2,ZSCALEN2
+REAL(KIND=JPRB) ::  Z_FAC000, Z_FAC100, Z_FAC200,&
+ & Z_FAC010, Z_FAC110, Z_FAC210, &
+ & Z_FAC001, Z_FAC101, Z_FAC201, &
+ & Z_FAC011, Z_FAC111, Z_FAC211
+REAL(KIND=JPRB) :: ZP, ZP4, ZFK0, ZFK1, ZFK2
+
+REAL(KIND=JPRB) :: Z_FS, Z_SPECMULT, Z_SPECPARM,Z_SPECCOMB,  &
+& Z_FS1, Z_SPECMULT1, Z_SPECPARM1,Z_SPECCOMB1, &
+& Z_FMN2, Z_SPECMULT_MN2, Z_SPECPARM_MN2,Z_SPECCOMB_MN2, &
+& Z_FPL, Z_SPECMULT_PLANCK, Z_SPECPARM_PLANCK,Z_SPECCOMB_PLANCK
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+! ---------------------------------------------------------------------------
+! 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)
+      Zrefrat_planck_a = chi_mls(4,1)/chi_mls(2,1)
+
+! P = 1053.
+      Zrefrat_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.  
+ 
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL15',0,ZHOOK_HANDLE)
+
+DO JLAY = 1, KLEV
+  DO JLON = KIDIA, KFDIA
+    IF (JLAY <= K_LAYTROP(JLON)) THEN
+
+      Z_SPECCOMB = P_COLN2O(JLON,JLAY) + PRAT_N2OCO2(JLON,JLAY)*P_COLCO2(JLON,JLAY)
+      Z_SPECPARM = P_COLN2O(JLON,JLAY)/Z_SPECCOMB
+      Z_SPECPARM = MIN(Z_SPECPARM,P_ONEMINUS)
+      Z_SPECMULT = 8._JPRB*(Z_SPECPARM)
+      JS = 1 + INT(Z_SPECMULT)
+      Z_FS = MOD(Z_SPECMULT,1.0_JPRB)
+
+      Z_SPECCOMB1 = P_COLN2O(JLON,JLAY) + PRAT_N2OCO2_1(JLON,JLAY)*P_COLCO2(JLON,JLAY)
+      Z_SPECPARM1 = P_COLN2O(JLON,JLAY)/Z_SPECCOMB1
+      IF (Z_SPECPARM1 >= P_ONEMINUS) Z_SPECPARM1 = P_ONEMINUS
+      Z_SPECMULT1 = 8._JPRB*(Z_SPECPARM1)
+      JS1 = 1 + INT(Z_SPECMULT1)
+      Z_FS1 = MOD(Z_SPECMULT1,1.0_JPRB)
+
+      Z_SPECCOMB_MN2 = P_COLN2O(JLON,JLAY) + ZREFRAT_M_A*P_COLCO2(JLON,JLAY)
+      Z_SPECPARM_MN2 = P_COLN2O(JLON,JLAY)/Z_SPECCOMB_MN2
+      IF (Z_SPECPARM_MN2 >= P_ONEMINUS) Z_SPECPARM_MN2 = P_ONEMINUS
+      Z_SPECMULT_MN2 = 8._JPRB*Z_SPECPARM_MN2
+      JMN2 = 1 + INT(Z_SPECMULT_MN2)
+      Z_FMN2 = MOD(Z_SPECMULT_MN2,1.0_JPRB)
+      
+      Z_SPECCOMB_PLANCK = P_COLN2O(JLON,JLAY)+ZREFRAT_PLANCK_A*P_COLCO2(JLON,JLAY)
+      Z_SPECPARM_PLANCK = P_COLN2O(JLON,JLAY)/Z_SPECCOMB_PLANCK
+      IF (Z_SPECPARM_PLANCK >= P_ONEMINUS) Z_SPECPARM_PLANCK=P_ONEMINUS
+      Z_SPECMULT_PLANCK = 8._JPRB*Z_SPECPARM_PLANCK
+      JPL= 1 + INT(Z_SPECMULT_PLANCK)
+      Z_FPL = MOD(Z_SPECMULT_PLANCK,1.0_JPRB)
+
+      IND0 = ((K_JP(JLON,JLAY)-1)*5+(K_JT(JLON,JLAY)-1))*NSPA(15) + JS
+      IND1 = (K_JP(JLON,JLAY)*5+(K_JT1(JLON,JLAY)-1))*NSPA(15) + JS1
+      INDS = K_INDSELF(JLON,JLAY)
+      INDF = K_INDFOR(JLON,JLAY)
+      INDM = KINDMINOR(JLON,JLAY)
+ 
+      ZSCALEN2 = PCOLBRD(JLON,JLAY)*PSCALEMINOR(JLON,JLAY)
+
+IF (Z_SPECPARM < 0.125_JPRB) THEN
+            ZP = Z_FS - 1
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC000 = ZFK0*P_FAC00(JLON,JLAY)
+            Z_FAC100 = ZFK1*P_FAC00(JLON,JLAY)
+            Z_FAC200 = ZFK2*P_FAC00(JLON,JLAY)
+            Z_FAC010 = ZFK0*P_FAC10(JLON,JLAY)
+            Z_FAC110 = ZFK1*P_FAC10(JLON,JLAY)
+            Z_FAC210 = ZFK2*P_FAC10(JLON,JLAY)
+      ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
+            ZP = -Z_FS 
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC000 = ZFK0*P_FAC00(JLON,JLAY)
+            Z_FAC100 = ZFK1*P_FAC00(JLON,JLAY)
+            Z_FAC200 = ZFK2*P_FAC00(JLON,JLAY)
+            Z_FAC010 = ZFK0*P_FAC10(JLON,JLAY)
+            Z_FAC110 = ZFK1*P_FAC10(JLON,JLAY)
+            Z_FAC210 = ZFK2*P_FAC10(JLON,JLAY)
+      ELSE
+            Z_FAC000 = (1._JPRB - Z_FS) * P_FAC00(JLON,JLAY)
+            Z_FAC010 = (1._JPRB - Z_FS) * P_FAC10(JLON,JLAY)
+            Z_FAC100 = Z_FS * P_FAC00(JLON,JLAY)
+            Z_FAC110 = Z_FS * P_FAC10(JLON,JLAY)
+      ENDIF
+      IF (Z_SPECPARM1 < 0.125_JPRB) THEN
+            ZP = Z_FS1 - 1
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC001 = ZFK0*P_FAC01(JLON,JLAY)
+            Z_FAC101 = ZFK1*P_FAC01(JLON,JLAY)
+            Z_FAC201 = ZFK2*P_FAC01(JLON,JLAY)
+            Z_FAC011 = ZFK0*P_FAC11(JLON,JLAY)
+            Z_FAC111 = ZFK1*P_FAC11(JLON,JLAY)
+            Z_FAC211 = ZFK2*P_FAC11(JLON,JLAY)
+      ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
+            ZP = -Z_FS1 
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC001 = ZFK0*P_FAC01(JLON,JLAY)
+            Z_FAC101 = ZFK1*P_FAC01(JLON,JLAY)
+            Z_FAC201 = ZFK2*P_FAC01(JLON,JLAY)
+            Z_FAC011 = ZFK0*P_FAC11(JLON,JLAY)
+            Z_FAC111 = ZFK1*P_FAC11(JLON,JLAY)
+            Z_FAC211 = ZFK2*P_FAC11(JLON,JLAY)
+      ELSE
+            Z_FAC001 = (1._JPRB - Z_FS1) * P_FAC01(JLON,JLAY)
+            Z_FAC011 = (1._JPRB - Z_FS1) * P_FAC11(JLON,JLAY)
+            Z_FAC101 = Z_FS1 * P_FAC01(JLON,JLAY)
+            Z_FAC111 = Z_FS1 * P_FAC11(JLON,JLAY)
+      ENDIF
+
+
+!-- DS_990714  
+!-- jjm20110728 re-establishing the loop instead of specified IG to allow a flexible number of NG15
+      DO IG = 1, NG15
+        ZTAUSELF = P_SELFFAC(JLON,JLAY)* (SELFREF(INDS,IG) + P_SELFFRAC(JLON,JLAY) * &
+          &       (SELFREF(INDS+1,IG) - SELFREF(INDS,IG)))
+        ZTAUFOR = P_FORFAC(JLON,JLAY) * (FORREF(INDF,IG) + P_FORFRAC(JLON,JLAY) * &
+          &       (FORREF(INDF+1,IG) - FORREF(INDF,IG))) 
+        ZN2M1 = KA_MN2(JMN2,INDM,IG) + Z_FMN2 * &
+          &       (KA_MN2(JMN2+1,INDM,IG) - KA_MN2(JMN2,INDM,IG))
+        ZN2M2 = KA_MN2(JMN2,INDM+1,IG) + Z_FMN2 * &
+          &       (KA_MN2(JMN2+1,INDM+1,IG) - KA_MN2(JMN2,INDM+1,IG))
+        ZTAUN2 = ZSCALEN2 * (ZN2M1 + PMINORFRAC(JLON,JLAY) * (ZN2M2 - ZN2M1))
+
+     IF (Z_SPECPARM < 0.125_JPRB) THEN
+               ZTAU_MAJOR = Z_SPECCOMB * &
+                 &   (Z_FAC000 * ABSA(IND0,IG) + &
+                 &   Z_FAC100 * ABSA(IND0+1,IG) + &
+                 &   Z_FAC200 * ABSA(IND0+2,IG) + &
+                 &   Z_FAC010 * ABSA(IND0+9,IG) + &
+                 &   Z_FAC110 * ABSA(IND0+10,IG) + &
+                 &   Z_FAC210 * ABSA(IND0+11,IG))
+            ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
+               ZTAU_MAJOR = Z_SPECCOMB * &
+                 &   (Z_FAC200 * ABSA(IND0-1,IG) + &
+                 &   Z_FAC100 * ABSA(IND0,IG) + &
+                 &   Z_FAC000 * ABSA(IND0+1,IG) + &
+                 &   Z_FAC210 * ABSA(IND0+8,IG) + &
+                 &   Z_FAC110 * ABSA(IND0+9,IG) + &
+                 &   Z_FAC010 * ABSA(IND0+10,IG))
+            ELSE
+               ZTAU_MAJOR = Z_SPECCOMB * &
+                 &   (Z_FAC000 * ABSA(IND0,IG) + &
+                 &   Z_FAC100 * ABSA(IND0+1,IG) + &
+                 &   Z_FAC010 * ABSA(IND0+9,IG) + &
+                 &   Z_FAC110 * ABSA(IND0+10,IG))
+            ENDIF
+
+            IF (Z_SPECPARM1 < 0.125_JPRB) THEN
+               ZTAU_MAJOR1 = Z_SPECCOMB1 * &
+                &    (Z_FAC001 * ABSA(IND1,IG) + &
+                &    Z_FAC101 * ABSA(IND1+1,IG) + &
+                &    Z_FAC201 * ABSA(IND1+2,IG) + &
+                &    Z_FAC011 * ABSA(IND1+9,IG) + &
+                &    Z_FAC111 * ABSA(IND1+10,IG) + &
+                &    Z_FAC211 * ABSA(IND1+11,IG))
+            ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
+               ZTAU_MAJOR1 = Z_SPECCOMB1 * &
+                &    (Z_FAC201 * ABSA(IND1-1,IG) + &
+                &    Z_FAC101 * ABSA(IND1,IG) + &
+                &    Z_FAC001 * ABSA(IND1+1,IG) + &
+                &    Z_FAC211 * ABSA(IND1+8,IG) + &
+                &    Z_FAC111 * ABSA(IND1+9,IG) + &
+                &    Z_FAC011 * ABSA(IND1+10,IG))
+            ELSE
+               ZTAU_MAJOR1 = Z_SPECCOMB1 * &
+                &    (Z_FAC001 * ABSA(IND1,IG) +  &
+                &    Z_FAC101 * ABSA(IND1+1,IG) + &
+                &    Z_FAC011 * ABSA(IND1+9,IG) + &
+                &    Z_FAC111 * ABSA(IND1+10,IG))
+            ENDIF
+
+
+        P_TAU(JLON,NGS14+IG,JLAY) = ZTAU_MAJOR + ZTAU_MAJOR1 &
+               & + ZTAUSELF + ZTAUFOR + ZTAUN2 &
+               & + P_TAUAERL(JLON,JLAY,15)  
+       PFRAC(JLON,NGS14+IG,JLAY) = FRACREFA(IG,JPL) + Z_FPL * &
+         & (FRACREFA(IG,JPL+1) - FRACREFA(IG,JPL))  
+      ENDDO
+!-- jjm20110728
+!-- DS_990714  
+    ENDIF
+
+    IF (JLAY > K_LAYTROP(JLON)) THEN
+      DO IG = 1, NG15
+!-- jjm20110728 re-establishing the loop instead of specified IG to allow a flexible number of NG15
+!-- DS_990714  
+        P_TAU(JLON,NGS14+IG,JLAY) = P_TAUAERL(JLON,JLAY,15)
+        PFRAC(JLON,NGS14+IG,JLAY) = 0.0_JPRB
+      ENDDO
+!-- jjm20110728
+!-- DS_990714  
+    ENDIF
+  ENDDO
+ENDDO
+
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL15',1,ZHOOK_HANDLE)
+
+END ASSOCIATE
+END SUBROUTINE RRTM_TAUMOL15
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol15.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol15.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol15.intfb.h	(revision 3908)
@@ -0,0 +1,40 @@
+INTERFACE
+SUBROUTINE RRTM_TAUMOL15 (KIDIA,KFDIA,KLEV,P_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLCO2,P_COLN2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC,&
+ & PRAT_N2OCO2, PRAT_N2OCO2_1,PMINORFRAC,KINDMINOR,PSCALEMINOR,PCOLBRD) 
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+USE PARRRTM , ONLY : JPBAND
+USE YOERRTM , ONLY : JPGPT ,NGS14 ,NG15
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLN2O(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRAT_N2OCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRAT_N2OCO2_1(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PMINORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KINDMINOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PSCALEMINOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLBRD(KIDIA:KFDIA,KLEV)
+END SUBROUTINE RRTM_TAUMOL15
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol16.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol16.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol16.F90	(revision 3908)
@@ -0,0 +1,273 @@
+!----------------------------------------------------------------------------
+SUBROUTINE RRTM_TAUMOL16 (KIDIA,KFDIA,KLEV,P_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLCH4,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC, &
+ & P_RAT_H2OCH4,P_RAT_H2OCH4_1)  
+
+!     BAND 16:  2600-3000 cm-1 (low - H2O,CH4; high - nothing)
+
+!     AUTHOR.
+!     -------
+!      JJMorcrette, ECMWF
+
+!     MODIFICATIONS.
+!     --------------
+!      M.Hamrud      01-Oct-2003 CY28 Cleaning
+!      NEC           25-Oct-2007 Optimisations
+!      JJMorcrette 20110613 flexible number of g-points
+!      ABozzo 201306 updated to rrtmg v4.85
+!      band 16:  2600-3250 cm-1 (low key- h2o,ch4; high key - ch4)
+! ---------------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE PARRRTM  , ONLY : JPBAND
+USE YOERRTM  , ONLY : JPGPT  ,NGS15  ,NG16
+USE YOERRTWN , ONLY : NSPA,NSPB   
+USE YOERRTA16, ONLY : ABSA,ABSB,FRACREFA,FRACREFB,SELFREF,FORREF 
+USE YOERRTRF, ONLY : CHI_MLS
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ONEMINUS
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCH4(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV) 
+
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_RAT_H2OCH4(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_RAT_H2OCH4_1(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)   :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFRAC(KIDIA:KFDIA,KLEV) 
+
+! ---------------------------------------------------------------------------
+
+INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS,INDF, JS,JS1,JPL,JLAY
+INTEGER(KIND=JPIM) :: JLON
+
+REAL(KIND=JPRB) ::  Z_FAC000, Z_FAC100, Z_FAC200,&
+ & Z_FAC010, Z_FAC110, Z_FAC210, &
+ & Z_FAC001, Z_FAC101, Z_FAC201, &
+ & Z_FAC011, Z_FAC111, Z_FAC211
+REAL(KIND=JPRB) :: ZP, ZP4, ZFK0, ZFK1, ZFK2
+
+REAL(KIND=JPRB) :: ZREFRAT_PLANCK_A
+REAL(KIND=JPRB) :: ZTAUFOR,ZTAUSELF,ZTAU_MAJOR,ZTAU_MAJOR1
+REAL(KIND=JPRB) :: Z_FS, Z_SPECMULT, Z_SPECPARM,Z_SPECCOMB,  &
+& Z_FS1, Z_SPECMULT1, Z_SPECPARM1,Z_SPECCOMB1, &
+& Z_FPL, Z_SPECMULT_PLANCK, Z_SPECPARM_PLANCK,Z_SPECCOMB_PLANCK
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+ 
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL16',0,ZHOOK_HANDLE)
+
+! Calculate reference ratio to be used in calculation of Planck
+! fraction in lower atmosphere.
+
+! P = 387. mb (Level 6)
+      Zrefrat_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.  
+
+
+DO JLAY = 1, KLEV
+  DO JLON = KIDIA, KFDIA
+    IF (JLAY <= K_LAYTROP(JLON)) THEN
+      Z_SPECCOMB = P_COLH2O(JLON,JLAY) + P_RAT_H2OCH4(JLON,JLAY)*P_COLCH4(JLON,JLAY)
+      Z_SPECPARM = P_COLH2O(JLON,JLAY)/Z_SPECCOMB
+      Z_SPECPARM = MIN(Z_SPECPARM,P_ONEMINUS)
+      Z_SPECMULT = 8._JPRB*(Z_SPECPARM)
+      JS = 1 + INT(Z_SPECMULT)
+      Z_FS = MOD(Z_SPECMULT,1.0_JPRB)
+
+      Z_SPECCOMB1 = P_COLH2O(JLON,JLAY) + P_RAT_H2OCH4_1(JLON,JLAY)*P_COLCH4(JLON,JLAY)
+      Z_SPECPARM1 = P_COLH2O(JLON,JLAY)/Z_SPECCOMB1
+      IF (Z_SPECPARM1 >= P_ONEMINUS) Z_SPECPARM1 = P_ONEMINUS
+      Z_SPECMULT1 = 8._JPRB*(Z_SPECPARM1)
+      JS1 = 1 + INT(Z_SPECMULT1)
+      Z_FS1 = MOD(Z_SPECMULT1,1.0_JPRB)
+
+      Z_SPECCOMB_PLANCK = P_COLH2O(JLON,JLAY)+ZREFRAT_PLANCK_A*P_COLCH4(JLON,JLAY)
+      Z_SPECPARM_PLANCK = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_PLANCK
+      IF (Z_SPECPARM_PLANCK >= P_ONEMINUS) Z_SPECPARM_PLANCK=P_ONEMINUS
+      Z_SPECMULT_PLANCK = 8._JPRB*Z_SPECPARM_PLANCK
+      JPL= 1 + INT(Z_SPECMULT_PLANCK)
+      Z_FPL = MOD(Z_SPECMULT_PLANCK,1.0_JPRB)
+
+      IND0 = ((K_JP(JLON,JLAY)-1)*5+(K_JT(JLON,JLAY)-1))*NSPA(16) + JS
+      IND1 = (K_JP(JLON,JLAY)*5+(K_JT1(JLON,JLAY)-1))*NSPA(16) + JS1
+      INDS = K_INDSELF(JLON,JLAY)
+      INDF = K_INDFOR(JLON,JLAY)
+
+IF (Z_SPECPARM < 0.125_JPRB) THEN
+            ZP = Z_FS - 1
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC000 = ZFK0*P_FAC00(JLON,JLAY)
+            Z_FAC100 = ZFK1*P_FAC00(JLON,JLAY)
+            Z_FAC200 = ZFK2*P_FAC00(JLON,JLAY)
+            Z_FAC010 = ZFK0*P_FAC10(JLON,JLAY)
+            Z_FAC110 = ZFK1*P_FAC10(JLON,JLAY)
+            Z_FAC210 = ZFK2*P_FAC10(JLON,JLAY)
+      ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
+            ZP = -Z_FS 
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC000 = ZFK0*P_FAC00(JLON,JLAY)
+            Z_FAC100 = ZFK1*P_FAC00(JLON,JLAY)
+            Z_FAC200 = ZFK2*P_FAC00(JLON,JLAY)
+            Z_FAC010 = ZFK0*P_FAC10(JLON,JLAY)
+            Z_FAC110 = ZFK1*P_FAC10(JLON,JLAY)
+            Z_FAC210 = ZFK2*P_FAC10(JLON,JLAY)
+      ELSE
+            Z_FAC000 = (1._JPRB - Z_FS) * P_FAC00(JLON,JLAY)
+            Z_FAC010 = (1._JPRB - Z_FS) * P_FAC10(JLON,JLAY)
+            Z_FAC100 = Z_FS * P_FAC00(JLON,JLAY)
+            Z_FAC110 = Z_FS * P_FAC10(JLON,JLAY)
+      ENDIF
+      IF (Z_SPECPARM1 < 0.125_JPRB) THEN
+            ZP = Z_FS1 - 1
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC001 = ZFK0*P_FAC01(JLON,JLAY)
+            Z_FAC101 = ZFK1*P_FAC01(JLON,JLAY)
+            Z_FAC201 = ZFK2*P_FAC01(JLON,JLAY)
+            Z_FAC011 = ZFK0*P_FAC11(JLON,JLAY)
+            Z_FAC111 = ZFK1*P_FAC11(JLON,JLAY)
+            Z_FAC211 = ZFK2*P_FAC11(JLON,JLAY)
+      ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
+            ZP = -Z_FS1 
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC001 = ZFK0*P_FAC01(JLON,JLAY)
+            Z_FAC101 = ZFK1*P_FAC01(JLON,JLAY)
+            Z_FAC201 = ZFK2*P_FAC01(JLON,JLAY)
+            Z_FAC011 = ZFK0*P_FAC11(JLON,JLAY)
+            Z_FAC111 = ZFK1*P_FAC11(JLON,JLAY)
+            Z_FAC211 = ZFK2*P_FAC11(JLON,JLAY)
+      ELSE
+            Z_FAC001 = (1._JPRB - Z_FS1) * P_FAC01(JLON,JLAY)
+            Z_FAC011 = (1._JPRB - Z_FS1) * P_FAC11(JLON,JLAY)
+            Z_FAC101 = Z_FS1 * P_FAC01(JLON,JLAY)
+            Z_FAC111 = Z_FS1 * P_FAC11(JLON,JLAY)
+      ENDIF
+
+
+      DO IG = 1, NG16
+!- - DS_990714
+        ZTAUSELF = P_SELFFAC(JLON,JLAY)* (SELFREF(INDS,IG) + P_SELFFRAC(JLON,JLAY) * &
+          &       (SELFREF(INDS+1,IG) - SELFREF(INDS,IG)))
+        ZTAUFOR = P_FORFAC(JLON,JLAY) * (FORREF(INDF,IG) + P_FORFRAC(JLON,JLAY) * &
+          &       (FORREF(INDF+1,IG) - FORREF(INDF,IG))) 
+
+     IF (Z_SPECPARM < 0.125_JPRB) THEN
+               ZTAU_MAJOR = Z_SPECCOMB * &
+                 &   (Z_FAC000 * ABSA(IND0,IG) + &
+                 &   Z_FAC100 * ABSA(IND0+1,IG) + &
+                 &   Z_FAC200 * ABSA(IND0+2,IG) + &
+                 &   Z_FAC010 * ABSA(IND0+9,IG) + &
+                 &   Z_FAC110 * ABSA(IND0+10,IG) + &
+                 &   Z_FAC210 * ABSA(IND0+11,IG))
+            ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
+               ZTAU_MAJOR = Z_SPECCOMB * &
+                 &   (Z_FAC200 * ABSA(IND0-1,IG) + &
+                 &   Z_FAC100 * ABSA(IND0,IG) + &
+                 &   Z_FAC000 * ABSA(IND0+1,IG) + &
+                 &   Z_FAC210 * ABSA(IND0+8,IG) + &
+                 &   Z_FAC110 * ABSA(IND0+9,IG) + &
+                 &   Z_FAC010 * ABSA(IND0+10,IG))
+            ELSE
+               ZTAU_MAJOR = Z_SPECCOMB * &
+                 &   (Z_FAC000 * ABSA(IND0,IG) + &
+                 &   Z_FAC100 * ABSA(IND0+1,IG) + &
+                 &   Z_FAC010 * ABSA(IND0+9,IG) + &
+                 &   Z_FAC110 * ABSA(IND0+10,IG))
+            ENDIF
+
+            IF (Z_SPECPARM1 < 0.125_JPRB) THEN
+               ZTAU_MAJOR1 = Z_SPECCOMB1 * &
+                &    (Z_FAC001 * ABSA(IND1,IG) + &
+                &    Z_FAC101 * ABSA(IND1+1,IG) + &
+                &    Z_FAC201 * ABSA(IND1+2,IG) + &
+                &    Z_FAC011 * ABSA(IND1+9,IG) + &
+                &    Z_FAC111 * ABSA(IND1+10,IG) + &
+                &    Z_FAC211 * ABSA(IND1+11,IG))
+            ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
+               ZTAU_MAJOR1 = Z_SPECCOMB1 * &
+                &    (Z_FAC201 * ABSA(IND1-1,IG) + &
+                &    Z_FAC101 * ABSA(IND1,IG) + &
+                &    Z_FAC001 * ABSA(IND1+1,IG) + &
+                &    Z_FAC211 * ABSA(IND1+8,IG) + &
+                &    Z_FAC111 * ABSA(IND1+9,IG) + &
+                &    Z_FAC011 * ABSA(IND1+10,IG))
+            ELSE
+               ZTAU_MAJOR1 = Z_SPECCOMB1 * &
+                &    (Z_FAC001 * ABSA(IND1,IG) +  &
+                &    Z_FAC101 * ABSA(IND1+1,IG) + &
+                &    Z_FAC011 * ABSA(IND1+9,IG) + &
+                &    Z_FAC111 * ABSA(IND1+10,IG))
+            ENDIF
+
+
+        P_TAU(JLON,NGS15+IG,JLAY) = ZTAU_MAJOR + ZTAU_MAJOR1 &
+                & + ZTAUSELF + ZTAUFOR &
+                & + P_TAUAERL(JLON,JLAY,16)  
+        PFRAC(JLON,NGS15+IG,JLAY) = FRACREFA(IG,JPL) + Z_FPL * &
+         & (FRACREFA(IG,JPL+1) - FRACREFA(IG,JPL))
+
+        ENDDO
+
+!-- DS_990714
+    ENDIF
+
+    IF (JLAY > K_LAYTROP(JLON)) THEN
+      IND0 = ((K_JP(JLON,JLAY)-13)*5+(K_JT(JLON,JLAY)-1))*NSPB(16) + 1
+      IND1 = ((K_JP(JLON,JLAY)-12)*5+(K_JT1(JLON,JLAY)-1))*NSPB(16) + 1
+      DO IG = 1, NG16
+
+        P_TAU(JLON,NGS15+IG,JLAY) =  P_COLCH4(JLON,JLAY) * &
+               &  (P_FAC00(JLON,JLAY) * ABSB(IND0,IG) + &
+               &  P_FAC10(JLON,JLAY) * ABSB(IND0+1,IG) + &
+               &  P_FAC01(JLON,JLAY) * ABSB(IND1,IG) + &
+               &  P_FAC11(JLON,JLAY) * ABSB(IND1+1,IG)) + &
+               &  P_TAUAERL(JLON,JLAY,16)
+        PFRAC(JLON,NGS15+IG,JLAY) = FRACREFB(IG)
+
+      ENDDO
+    ENDIF
+  ENDDO
+ENDDO
+
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL16',1,ZHOOK_HANDLE)
+
+END ASSOCIATE
+END SUBROUTINE RRTM_TAUMOL16
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol16.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol16.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol16.intfb.h	(revision 3908)
@@ -0,0 +1,35 @@
+INTERFACE
+SUBROUTINE RRTM_TAUMOL16 (KIDIA,KFDIA,KLEV,P_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLCH4,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC,&
+ & P_RAT_H2OCH4,P_RAT_H2OCH4_1) 
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+USE PARRRTM , ONLY : JPBAND
+USE YOERRTM , ONLY : JPGPT ,NGS15 ,NG16
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCH4(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_RAT_H2OCH4(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_RAT_H2OCH4_1(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+END SUBROUTINE RRTM_TAUMOL16
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol2.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol2.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol2.F90	(revision 3908)
@@ -0,0 +1,132 @@
+!----------------------------------------------------------------------------
+SUBROUTINE RRTM_TAUMOL2 (KIDIA,KFDIA,KLEV,P_TAU,PAVEL,P_COLDRY,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,&
+ & P_COLH2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
+
+!     BAND 2:  250-500 cm-1 (low - H2O; high - H2O)
+
+!     AUTHOR.
+!     -------
+!      JJMorcrette, ECMWF
+
+!     MODIFICATIONS.
+!     --------------
+!      M.Hamrud      01-Oct-2003 CY28 Cleaning
+!      NEC           25-Oct-2007 Optimisations
+!      JJMorcrette 20110613 flexible number of g-points
+!      ABozzo 201305 updated to rrtmg_lw_v4.85:
+!*********
+!     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 PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE PARRRTM  , ONLY : JPBAND
+USE YOERRTM  , ONLY : JPGPT  ,NG2   ,NGS1
+USE YOERRTWN , ONLY : NSPA   ,NSPB
+USE YOERRTA2 , ONLY : ABSA   ,ABSB   ,FRACREFA, FRACREFB,&
+ & FORREF   ,SELFREF  
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PAVEL(KIDIA:KFDIA,KLEV) ! Layer pressures (hPa)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLDRY(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFRAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDFOR(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV) 
+
+! ---------------------------------------------------------------------------
+
+INTEGER(KIND=JPIM) :: IND0(KLEV),IND1(KLEV),INDS(KLEV), INDF(KLEV)
+
+INTEGER(KIND=JPIM) :: IG, JLAY
+INTEGER(KIND=JPIM) :: JLON
+
+REAL(KIND=JPRB) :: ZTAUFOR,ZTAUSELF,ZCORRADJ,ZPP
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+!     Compute the optical depth by interpolating in ln(pressure) and 
+!     temperature.  Below LAYTROP, the water vapor self-continuum is 
+!     interpolated (in temperature) separately.
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL2',0,ZHOOK_HANDLE)
+
+DO JLAY = 1, KLEV
+  DO JLON = KIDIA, KFDIA
+    IF (JLAY <= K_LAYTROP(JLON)) THEN
+      IND0(JLAY) = ((K_JP(JLON,JLAY)-1)*5+(K_JT(JLON,JLAY)-1))*NSPA(2) + 1
+      IND1(JLAY) = (K_JP(JLON,JLAY)*5+(K_JT1(JLON,JLAY)-1))*NSPA(2) + 1
+      INDS(JLAY) = K_INDSELF(JLON,JLAY)
+      INDF(JLAY) = K_INDFOR(JLON,JLAY)
+      ZPP = PAVEL(JLON,JLAY) !hPa(mb)
+      ZCORRADJ = 1._JPRB - .05_JPRB * (ZPP - 100._JPRB) / 900._JPRB
+!-- DS_000515  
+!CDIR UNROLL=NG2
+      DO IG = 1, NG2
+!-- DS_000515  
+         ZTAUSELF = P_SELFFAC(JLON,JLAY) * (SELFREF(INDS(JLAY),IG) + P_SELFFRAC(JLON,JLAY) * &
+                 & (SELFREF(INDS(JLAY)+1,IG) - SELFREF(INDS(JLAY),IG)))
+         ZTAUFOR =  P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + P_FORFRAC(JLON,JLAY) * &
+                 & (FORREF(INDF(JLAY)+1,IG) - FORREF(INDF(JLAY),IG))) 
+         P_TAU(JLON,NGS1+IG,JLAY) = ZCORRADJ * (P_COLH2O(JLON,JLAY) * &
+                 & (P_FAC00(JLON,JLAY) * ABSA(IND0(JLAY),IG) + &
+                 &  P_FAC10(JLON,JLAY) * ABSA(IND0(JLAY)+1,IG) + &
+                 &  P_FAC01(JLON,JLAY) * ABSA(IND1(JLAY),IG) + &
+                 &  P_FAC11(JLON,JLAY) * ABSA(IND1(JLAY)+1,IG)) &
+               &  + ZTAUSELF + ZTAUFOR)+ P_TAUAERL(JLON,JLAY,2)
+        PFRAC(JLON,NGS1+IG,JLAY) = FRACREFA(IG) 
+
+      ENDDO
+    ENDIF
+    IF (JLAY > K_LAYTROP(JLON)) THEN
+
+      IND0(JLAY) = ((K_JP(JLON,JLAY)-13)*5+(K_JT(JLON,JLAY)-1))*NSPB(2) + 1
+      IND1(JLAY) = ((K_JP(JLON,JLAY)-12)*5+(K_JT1(JLON,JLAY)-1))*NSPB(2) + 1
+      INDF(JLAY) = K_INDFOR(JLON,JLAY)
+!-- JJM_000517
+!CDIR UNROLL=NG2
+      DO IG = 1, NG2
+!-- JJM_000517
+         ZTAUFOR = P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + &
+                &  P_FORFRAC(JLON,JLAY) * (FORREF(INDF(JLAY)+1,IG) - FORREF(INDF(JLAY),IG))) 
+         P_TAU(JLON,NGS1+IG,JLAY) = P_COLH2O(JLON,JLAY) * &
+              &  (P_FAC00(JLON,JLAY) * ABSB(IND0(JLAY),IG) + &
+              &   P_FAC10(JLON,JLAY) * ABSB(IND0(JLAY)+1,IG) + &
+              &   P_FAC01(JLON,JLAY) * ABSB(IND1(JLAY),IG) + &
+              &   P_FAC11(JLON,JLAY) * ABSB(IND1(JLAY)+1,IG)) &
+              &   + ZTAUFOR + P_TAUAERL(JLON,JLAY,2)
+       PFRAC(JLON,NGS1+IG,JLAY) = FRACREFB(IG)
+
+      ENDDO
+    ENDIF
+  ENDDO
+ENDDO
+
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL2',1,ZHOOK_HANDLE)
+
+END ASSOCIATE
+END SUBROUTINE RRTM_TAUMOL2
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol2.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol2.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol2.intfb.h	(revision 3908)
@@ -0,0 +1,32 @@
+INTERFACE
+SUBROUTINE RRTM_TAUMOL2 (KIDIA,KFDIA,KLEV,P_TAU,PAVEL,P_COLDRY,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,&
+ & P_COLH2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC) 
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+USE PARRRTM , ONLY : JPBAND
+USE YOERRTM , ONLY : JPGPT ,NG2 ,NGS1
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PAVEL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLDRY(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
+END SUBROUTINE RRTM_TAUMOL2
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol3.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol3.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol3.F90	(revision 3908)
@@ -0,0 +1,402 @@
+!----------------------------------------------------------------------------
+SUBROUTINE RRTM_TAUMOL3 (KIDIA,KFDIA,KLEV,P_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLCO2,P_COLN2O,P_COLDRY,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC, &
+ & PRAT_H2OCO2, PRAT_H2OCO2_1,PMINORFRAC,KINDMINOR)  
+
+!     BAND 3:  500-630 cm-1 (low - H2O,CO2; high - H2O,CO2)
+
+!     AUTHOR.
+!     -------
+!      JJMorcrette, ECMWF
+
+!     MODIFICATIONS.
+!     --------------
+!      M.Hamrud      01-Oct-2003 CY28 Cleaning
+!      NEC           25-Oct-2007 Optimisations
+!      JJMorcrette 20110613 flexible number of g-points
+!      ABozzo 20130517 updated to rrtmg_lw_v4.85:
+!     band 3:  500-630 cm-1 (low key - h2o,co2; low minor - n2o)
+!                           (high key - h2o,co2; high minor - n2o)
+! ---------------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE PARRRTM  , ONLY : JPBAND
+USE YOERRTM  , ONLY : JPGPT  ,NG3   ,NGS2
+USE YOERRTWN , ONLY : NSPA   ,NSPB
+USE YOERRTA3 , ONLY : ABSA   ,ABSB   ,FRACREFA, FRACREFB,&
+ & FORREF   ,SELFREF , KA_MN2O ,  KB_MN2O
+USE YOERRTRF, ONLY : CHI_MLS
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ONEMINUS
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCO2(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLN2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLDRY(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV) 
+
+REAL(KIND=JPRB)   ,INTENT(IN)   :: PRAT_H2OCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)   :: PRAT_H2OCO2_1(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)   :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFRAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)   :: PMINORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)   :: KINDMINOR(KIDIA:KFDIA,KLEV)
+! ---------------------------------------------------------------------------
+
+REAL(KIND=JPRB) :: Z_SPECCOMB(KLEV),Z_SPECCOMB1(KLEV),Z_SPECCOMB_MN2O(KLEV), &
+& Z_SPECCOMB_PLANCK(KLEV)
+REAL(KIND=JPRB) :: ZREFRAT_PLANCK_A, ZREFRAT_PLANCK_B, ZREFRAT_M_A, ZREFRAT_M_B
+
+INTEGER(KIND=JPIM) :: IND0(KLEV),IND1(KLEV),INDS(KLEV),INDF(KLEV),INDM(KLEV)
+INTEGER(KIND=JPIM) :: IG, JS, JLAY, JS1,JMN2O,JPL
+INTEGER(KIND=JPIM) :: JLON
+
+REAL(KIND=JPRB) :: Z_FS, Z_SPECMULT, Z_SPECPARM,  &
+ & Z_FS1, Z_SPECMULT1, Z_SPECPARM1,   &
+ & Z_FMN2O, Z_FMN2OMF, Z_SPECMULT_MN2O, Z_SPECPARM_MN2O,   &
+ & Z_FPL, Z_SPECMULT_PLANCK, Z_SPECPARM_PLANCK
+
+REAL(KIND=JPRB) :: ZADJFAC,ZADJCOLN2O(KIDIA:KFDIA,KLEV),ZRATN2O,Z_CHI_N2O
+
+ REAL(KIND=JPRB) ::  Z_FAC000, Z_FAC100, Z_FAC200,&
+ & Z_FAC010, Z_FAC110, Z_FAC210, &
+ & Z_FAC001, Z_FAC101, Z_FAC201, &
+ & Z_FAC011, Z_FAC111, Z_FAC211
+REAL(KIND=JPRB) :: ZP, ZP4, ZFK0, ZFK1, ZFK2
+REAL(KIND=JPRB) :: ZTAUFOR,ZTAUSELF,ZN2OM1,ZN2OM2,ZABSN2O,ZTAU_MAJOR,ZTAU_MAJOR1
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL3',0,ZHOOK_HANDLE)
+
+!     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.  
+
+
+! 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
+      ZREFRAT_PLANCK_A = CHI_MLS(1,9)/CHI_MLS(2,9)
+
+!  P = 95.58 mb
+      ZREFRAT_PLANCK_B = CHI_MLS(1,13)/CHI_MLS(2,13)
+
+!  P = 706.270mb
+      ZREFRAT_M_A = CHI_MLS(1,3)/CHI_MLS(2,3)
+
+!  P = 95.58 mb 
+      ZREFRAT_M_B = CHI_MLS(1,13)/CHI_MLS(2,13)
+ASSOCIATE(NFLEVG=>KLEV)
+
+
+DO JLAY = 1, KLEV
+  DO JLON = KIDIA, KFDIA
+    IF (JLAY <= K_LAYTROP(JLON)) THEN
+      Z_SPECCOMB(JLAY) = P_COLH2O(JLON,JLAY) + PRAT_H2OCO2(JLON,JLAY)*P_COLCO2(JLON,JLAY)
+      Z_SPECPARM = P_COLH2O(JLON,JLAY)/Z_SPECCOMB(JLAY)
+      Z_SPECPARM=MIN(P_ONEMINUS,Z_SPECPARM)
+      Z_SPECMULT = 8._JPRB*(Z_SPECPARM)
+      JS = 1 + INT(Z_SPECMULT)
+      Z_FS = MOD(Z_SPECMULT,1.0_JPRB)
+
+
+        Z_SPECCOMB1(JLAY) = P_COLH2O(JLON,JLAY) + PRAT_H2OCO2_1(JLON,JLAY)*P_COLCO2(JLON,JLAY)
+        Z_SPECPARM1 = P_COLH2O(JLON,JLAY)/Z_SPECCOMB1(JLAY)
+        IF (Z_SPECPARM1 >= P_ONEMINUS) Z_SPECPARM1 = P_ONEMINUS
+        Z_SPECMULT1 = 8._JPRB*(Z_SPECPARM1)
+        JS1 = 1 + INT(Z_SPECMULT1)
+        Z_FS1 = MOD(Z_SPECMULT1,1.0_JPRB)
+
+        Z_SPECCOMB_MN2O(JLAY) = P_COLH2O(JLON,JLAY) + ZREFRAT_M_A*P_COLCO2(JLON,JLAY)
+        Z_SPECPARM_MN2O = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_MN2O(JLAY)
+        IF (Z_SPECPARM_MN2O >= P_ONEMINUS) Z_SPECPARM_MN2O = P_ONEMINUS
+        Z_SPECMULT_MN2O = 8._JPRB*Z_SPECPARM_MN2O
+        JMN2O = 1 + INT(Z_SPECMULT_MN2O)
+        Z_FMN2O = MOD(Z_SPECMULT_MN2O,1.0_JPRB)
+        Z_FMN2OMF = PMINORFRAC(JLON,JLAY)*Z_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.
+        Z_CHI_N2O = P_COLN2O(JLON,JLAY)/P_COLDRY(JLON,JLAY)
+        ZRATN2O = 1.E20_JPRB*Z_CHI_N2O/CHI_MLS(4,K_JP(JLON,JLAY)+1)
+        IF (ZRATN2O > 1.5_JPRB) THEN
+           ZADJFAC = 0.5_JPRB+(ZRATN2O-0.5_JPRB)**0.65_JPRB
+           ZADJCOLN2O(JLON,JLAY) = ZADJFAC*CHI_MLS(4,K_JP(JLON,JLAY)+1)*P_COLDRY(JLON,JLAY)*1.E-20_JPRB
+        ELSE
+           ZADJCOLN2O(JLON,JLAY) = P_COLN2O(JLON,JLAY)
+        ENDIF
+        
+        Z_SPECCOMB_PLANCK(JLAY) = P_COLH2O(JLON,JLAY)+ZREFRAT_PLANCK_A*P_COLCO2(JLON,JLAY)
+        Z_SPECPARM_PLANCK = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_PLANCK(JLAY)
+        IF (Z_SPECPARM_PLANCK >= P_ONEMINUS) Z_SPECPARM_PLANCK=P_ONEMINUS
+        Z_SPECMULT_PLANCK = 8._JPRB*Z_SPECPARM_PLANCK
+        JPL= 1 + INT(Z_SPECMULT_PLANCK)
+        Z_FPL = MOD(Z_SPECMULT_PLANCK,1.0_JPRB)
+
+
+
+      IND0(JLAY) = ((K_JP(JLON,JLAY)-1)*5+(K_JT(JLON,JLAY)-1))*NSPA(3) + JS
+      IND1(JLAY) = (K_JP(JLON,JLAY)*5+(K_JT1(JLON,JLAY)-1))*NSPA(3) + JS1
+      INDS(JLAY) = K_INDSELF(JLON,JLAY)
+      INDF(JLAY) = K_INDFOR(JLON,JLAY)
+      INDM(JLAY) = KINDMINOR(JLON,JLAY)
+
+
+
+         IF (Z_SPECPARM < 0.125_JPRB) THEN
+            ZP = Z_FS - 1
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC000 = ZFK0*P_FAC00(JLON,JLAY)
+            Z_FAC100 = ZFK1*P_FAC00(JLON,JLAY)
+            Z_FAC200 = ZFK2*P_FAC00(JLON,JLAY)
+            Z_FAC010 = ZFK0*P_FAC10(JLON,JLAY)
+            Z_FAC110 = ZFK1*P_FAC10(JLON,JLAY)
+            Z_FAC210 = ZFK2*P_FAC10(JLON,JLAY)
+         ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
+            ZP = -Z_FS 
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC000 = ZFK0*P_FAC00(JLON,JLAY)
+            Z_FAC100 = ZFK1*P_FAC00(JLON,JLAY)
+            Z_FAC200 = ZFK2*P_FAC00(JLON,JLAY)
+            Z_FAC010 = ZFK0*P_FAC10(JLON,JLAY)
+            Z_FAC110 = ZFK1*P_FAC10(JLON,JLAY)
+            Z_FAC210 = ZFK2*P_FAC10(JLON,JLAY)
+         ELSE
+            Z_FAC000 = (1._JPRB - Z_FS) * P_FAC00(JLON,JLAY)
+            Z_FAC010 = (1._JPRB - Z_FS) * P_FAC10(JLON,JLAY)
+            Z_FAC100 = Z_FS * P_FAC00(JLON,JLAY)
+            Z_FAC110 = Z_FS * P_FAC10(JLON,JLAY)
+         ENDIF
+         IF (Z_SPECPARM1 < 0.125_JPRB) THEN
+            ZP = Z_FS1 - 1
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC001 = ZFK0*P_FAC01(JLON,JLAY)
+            Z_FAC101 = ZFK1*P_FAC01(JLON,JLAY)
+            Z_FAC201 = ZFK2*P_FAC01(JLON,JLAY)
+            Z_FAC011 = ZFK0*P_FAC11(JLON,JLAY)
+            Z_FAC111 = ZFK1*P_FAC11(JLON,JLAY)
+            Z_FAC211 = ZFK2*P_FAC11(JLON,JLAY)
+         ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
+            ZP = -Z_FS1 
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC001 = ZFK0*P_FAC01(JLON,JLAY)
+            Z_FAC101 = ZFK1*P_FAC01(JLON,JLAY)
+            Z_FAC201 = ZFK2*P_FAC01(JLON,JLAY)
+            Z_FAC011 = ZFK0*P_FAC11(JLON,JLAY)
+            Z_FAC111 = ZFK1*P_FAC11(JLON,JLAY)
+            Z_FAC211 = ZFK2*P_FAC11(JLON,JLAY)
+         ELSE
+            Z_FAC001 = (1._JPRB - Z_FS1) * P_FAC01(JLON,JLAY)
+            Z_FAC011 = (1._JPRB - Z_FS1) * P_FAC11(JLON,JLAY)
+            Z_FAC101 = Z_FS1 * P_FAC01(JLON,JLAY)
+            Z_FAC111 = Z_FS1 * P_FAC11(JLON,JLAY)
+         ENDIF
+
+
+
+
+
+!-- DS_000515
+!CDIR UNROLL=NG3
+      DO IG = 1, NG3
+!-- DS_000515
+         ZTAUSELF = P_SELFFAC(JLON,JLAY)* (SELFREF(INDS(JLAY),IG) + P_SELFFRAC(JLON,JLAY) * &
+            &    (SELFREF(INDS(JLAY)+1,IG) - SELFREF(INDS(JLAY),IG)))
+         ZTAUFOR = P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + P_FORFRAC(JLON,JLAY) * &
+            &    (FORREF(INDF(JLAY)+1,IG) - FORREF(INDF(JLAY),IG))) 
+         ZN2OM1 = KA_MN2O(JMN2O,INDM(JLAY),IG) + Z_FMN2O * &
+            &    (KA_MN2O(JMN2O+1,INDM(JLAY),IG) - KA_MN2O(JMN2O,INDM(JLAY),IG))
+         ZN2OM2 = KA_MN2O(JMN2O,INDM(JLAY)+1,IG) + Z_FMN2O * &
+            &    (KA_MN2O(JMN2O+1,INDM(JLAY)+1,IG) - KA_MN2O(JMN2O,INDM(JLAY)+1,IG))
+         ZABSN2O = ZN2OM1 + PMINORFRAC(JLON,JLAY) * (ZN2OM2 - ZN2OM1)
+
+            IF (Z_SPECPARM < 0.125_JPRB) THEN
+               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
+                 &  (Z_FAC000 * ABSA(IND0(JLAY),IG) + &
+                 &  Z_FAC100 * ABSA(IND0(JLAY)+1,IG) + &
+                 &  Z_FAC200 * ABSA(IND0(JLAY)+2,IG) + &
+                 &  Z_FAC010 * ABSA(IND0(JLAY)+9,IG) + &
+                 &  Z_FAC110 * ABSA(IND0(JLAY)+10,IG) + &
+                 &  Z_FAC210 * ABSA(IND0(JLAY)+11,IG))
+            ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
+               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
+                 &  (Z_FAC200 * ABSA(IND0(JLAY)-1,IG) + &
+                 &  Z_FAC100 * ABSA(IND0(JLAY),IG) + &
+                 &  Z_FAC000 * ABSA(IND0(JLAY)+1,IG) + &
+                 &  Z_FAC210 * ABSA(IND0(JLAY)+8,IG) + &
+                 &  Z_FAC110 * ABSA(IND0(JLAY)+9,IG) + &
+                 &  Z_FAC010 * ABSA(IND0(JLAY)+10,IG))
+            ELSE
+               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
+                 &  (Z_FAC000 * ABSA(IND0(JLAY),IG) + &
+                 &  Z_FAC100 * ABSA(IND0(JLAY)+1,IG) + &
+                 &  Z_FAC010 * ABSA(IND0(JLAY)+9,IG) + &
+                 &  Z_FAC110 * ABSA(IND0(JLAY)+10,IG))
+            ENDIF
+
+            IF (Z_SPECPARM1 < 0.125_JPRB) THEN
+               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
+                 &  (Z_FAC001 * ABSA(IND1(JLAY),IG) + &
+                 &  Z_FAC101 * ABSA(IND1(JLAY)+1,IG) + &
+                 &  Z_FAC201 * ABSA(IND1(JLAY)+2,IG) + &
+                 &  Z_FAC011 * ABSA(IND1(JLAY)+9,IG) + &
+                 &  Z_FAC111 * ABSA(IND1(JLAY)+10,IG) + &
+                 &  Z_FAC211 * ABSA(IND1(JLAY)+11,IG))
+            ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
+               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
+                 &  (Z_FAC201 * ABSA(IND1(JLAY)-1,IG) + &
+                 &  Z_FAC101 * ABSA(IND1(JLAY),IG) + &
+                 &  Z_FAC001 * ABSA(IND1(JLAY)+1,IG) + &
+                 &  Z_FAC211 * ABSA(IND1(JLAY)+8,IG) + &
+                 &  Z_FAC111 * ABSA(IND1(JLAY)+9,IG) + &
+                 &  Z_FAC011 * ABSA(IND1(JLAY)+10,IG))
+            ELSE
+               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
+                 &  (Z_FAC001 * ABSA(IND1(JLAY),IG) +  &
+                 &  Z_FAC101 * ABSA(IND1(JLAY)+1,IG) + &
+                 &  Z_FAC011 * ABSA(IND1(JLAY)+9,IG) + &
+                 &  Z_FAC111 * ABSA(IND1(JLAY)+10,IG))
+            ENDIF
+ 
+
+        P_TAU(JLON,NGS2+IG,JLAY) = ZTAU_MAJOR + ZTAU_MAJOR1 &
+               & + ZTAUSELF + ZTAUFOR &
+               & + ZADJCOLN2O(JLON,JLAY)*ZABSN2O &
+               & + P_TAUAERL(JLON,JLAY,3)  
+
+        if (JPL < 1) call abort
+
+        PFRAC(JLON,NGS2+IG,JLAY) = FRACREFA(IG,JPL) + Z_FPL *&
+         & (FRACREFA(IG,JPL+1) - FRACREFA(IG,JPL))  
+      ENDDO
+    ENDIF
+
+    IF (JLAY > K_LAYTROP(JLON)) THEN
+      Z_SPECCOMB(JLAY) = P_COLH2O(JLON,JLAY) + PRAT_H2OCO2(JLON,JLAY)*P_COLCO2(JLON,JLAY)
+      Z_SPECPARM = P_COLH2O(JLON,JLAY)/Z_SPECCOMB(JLAY)
+      Z_SPECPARM=MIN(P_ONEMINUS,Z_SPECPARM)
+      Z_SPECMULT = 4._JPRB*(Z_SPECPARM)
+      JS = 1 + INT(Z_SPECMULT)
+      Z_FS = MOD(Z_SPECMULT,1.0_JPRB)
+
+      Z_SPECCOMB1(JLAY) = P_COLH2O(JLON,JLAY) + PRAT_H2OCO2_1(JLON,JLAY)*P_COLCO2(JLON,JLAY)
+      Z_SPECPARM1 = P_COLH2O(JLON,JLAY)/Z_SPECCOMB1(JLAY)
+      IF (Z_SPECPARM1 >= P_ONEMINUS) Z_SPECPARM1 = P_ONEMINUS
+      Z_SPECMULT1 = 4._JPRB*(Z_SPECPARM1)
+      JS1 = 1 + INT(Z_SPECMULT1)
+      Z_FS1 = MOD(Z_SPECMULT1,1.0_JPRB)
+
+      Z_FAC000 = (1._JPRB - Z_FS) * P_FAC00(JLON,JLAY)
+      Z_FAC010 = (1._JPRB - Z_FS) * P_FAC10(JLON,JLAY)
+      Z_FAC100 = Z_FS * P_FAC00(JLON,JLAY)
+      Z_FAC110 = Z_FS * P_FAC10(JLON,JLAY)
+      Z_FAC001 = (1._JPRB - Z_FS1) * P_FAC01(JLON,JLAY)
+      Z_FAC011 = (1._JPRB - Z_FS1) * P_FAC11(JLON,JLAY)
+      Z_FAC101 = Z_FS1 * P_FAC01(JLON,JLAY)
+      Z_FAC111 = Z_FS1 * P_FAC11(JLON,JLAY)
+
+
+        Z_SPECCOMB_MN2O(JLAY) = P_COLH2O(JLON,JLAY) + ZREFRAT_M_B*P_COLCO2(JLON,JLAY)
+        Z_SPECPARM_MN2O = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_MN2O(JLAY)
+        IF (Z_SPECPARM_MN2O >= P_ONEMINUS) Z_SPECPARM_MN2O = P_ONEMINUS
+        Z_SPECMULT_MN2O = 4._JPRB*Z_SPECPARM_MN2O
+        JMN2O = 1 + INT(Z_SPECMULT_MN2O)
+        Z_FMN2O = MOD(Z_SPECMULT_MN2O,1.0_JPRB)
+        Z_FMN2OMF = PMINORFRAC(JLON,JLAY)*Z_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.
+        Z_CHI_N2O = P_COLN2O(JLON,JLAY)/P_COLDRY(JLON,JLAY)
+        ZRATN2O = 1.E20_JPRB*Z_CHI_N2O/CHI_MLS(4,K_JP(JLON,JLAY)+1)
+        IF (ZRATN2O > 1.5_JPRB) THEN
+           ZADJFAC = 0.5_JPRB+(ZRATN2O-0.5_JPRB)**0.65_JPRB
+           ZADJCOLN2O(JLON,JLAY) = ZADJFAC*CHI_MLS(4,K_JP(JLON,JLAY)+1)*P_COLDRY(JLON,JLAY)*1.E-20_JPRB
+        ELSE
+           ZADJCOLN2O(JLON,JLAY) = P_COLN2O(JLON,JLAY)
+        ENDIF
+        
+        Z_SPECCOMB_PLANCK(JLAY) = P_COLH2O(JLON,JLAY)+ZREFRAT_PLANCK_B*P_COLCO2(JLON,JLAY)
+        Z_SPECPARM_PLANCK = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_PLANCK(JLAY)
+        IF (Z_SPECPARM_PLANCK >= P_ONEMINUS) Z_SPECPARM_PLANCK=P_ONEMINUS
+        Z_SPECMULT_PLANCK = 4._JPRB*Z_SPECPARM_PLANCK
+        JPL= 1 + INT(Z_SPECMULT_PLANCK)
+        Z_FPL = MOD(Z_SPECMULT_PLANCK,1.0_JPRB)
+
+       IND0(JLAY) = ((K_JP(JLON,JLAY)-13)*5+(K_JT(JLON,JLAY)-1))*NSPB(3) + JS
+       IND1(JLAY) = ((K_JP(JLON,JLAY)-12)*5+(K_JT1(JLON,JLAY)-1))*NSPB(3) + JS1
+       INDF(JLAY) = K_INDFOR(JLON,JLAY)
+       INDM(JLAY) = KINDMINOR(JLON,JLAY)
+
+
+!CDIR UNROLL=NG3
+      DO IG = 1, NG3
+         ZTAUFOR = P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + P_FORFRAC(JLON,JLAY) * &
+               & (FORREF(INDF(JLAY)+1,IG) - FORREF(INDF(JLAY),IG))) 
+         ZN2OM1 = KB_MN2O(JMN2O,INDM(JLAY),IG) + Z_FMN2O * &
+               & (KB_MN2O(JMN2O+1,INDM(JLAY),IG) - KB_MN2O(JMN2O,INDM(JLAY),IG))
+         ZN2OM2 = KB_MN2O(JMN2O,INDM(JLAY)+1,IG) + Z_FMN2O * &
+               & (KB_MN2O(JMN2O+1,INDM(JLAY)+1,IG) - KB_MN2O(JMN2O,INDM(JLAY)+1,IG))
+         ZABSN2O = ZN2OM1 + PMINORFRAC(JLON,JLAY) * (ZN2OM2 - ZN2OM1)
+
+
+        P_TAU(JLON,NGS2+IG,JLAY) = Z_SPECCOMB(JLAY) *   &
+          &(Z_FAC000 * ABSB(IND0(JLAY)  ,IG) +&
+          & Z_FAC100 * ABSB(IND0(JLAY)+1,IG) +&
+          & Z_FAC010 * ABSB(IND0(JLAY)+5,IG) +&
+          & Z_FAC110 * ABSB(IND0(JLAY)+6,IG)) +&
+          & Z_SPECCOMB1(JLAY) * &
+          & (Z_FAC001 * ABSB(IND1(JLAY)  ,IG) +&
+          & Z_FAC101 * ABSB(IND1(JLAY)+1,IG) +&
+          & Z_FAC011 * ABSB(IND1(JLAY)+5,IG) +&
+          & Z_FAC111 * ABSB(IND1(JLAY)+6,IG))+&
+          & ZTAUFOR + ZADJCOLN2O(JLON,JLAY)*ZABSN2O &
+          & + P_TAUAERL(JLON,JLAY,3)  
+
+
+        PFRAC(JLON,NGS2+IG,JLAY) = FRACREFB(IG,JPL) + Z_FPL *&
+         & (FRACREFB(IG,JPL+1) - FRACREFB(IG,JPL))  
+      ENDDO
+    ENDIF
+  ENDDO
+ENDDO
+
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL3',1,ZHOOK_HANDLE)
+
+END ASSOCIATE
+END SUBROUTINE RRTM_TAUMOL3
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol3.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol3.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol3.intfb.h	(revision 3908)
@@ -0,0 +1,39 @@
+INTERFACE
+SUBROUTINE RRTM_TAUMOL3 (KIDIA,KFDIA,KLEV,P_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLCO2,P_COLN2O,P_COLDRY,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC,&
+ & PRAT_H2OCO2, PRAT_H2OCO2_1,PMINORFRAC,KINDMINOR) 
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+USE PARRRTM , ONLY : JPBAND
+USE YOERRTM , ONLY : JPGPT ,NG3 ,NGS2
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLN2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLDRY(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRAT_H2OCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRAT_H2OCO2_1(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PMINORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KINDMINOR(KIDIA:KFDIA,KLEV)
+END SUBROUTINE RRTM_TAUMOL3
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol4.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol4.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol4.F90	(revision 3908)
@@ -0,0 +1,326 @@
+!----------------------------------------------------------------------------
+SUBROUTINE RRTM_TAUMOL4 (KIDIA,KFDIA,KLEV,P_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLCO2,P_COLO3,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC, &
+ & P_RAT_H2OCO2, P_RAT_H2OCO2_1, P_RAT_O3CO2, P_RAT_O3CO2_1)  
+
+!     BAND 4:  630-700 cm-1 (low - H2O,CO2; high - O3,CO2)
+
+!     AUTHOR.
+!     -------
+!      JJMorcrette, ECMWF
+
+!     MODIFICATIONS.
+!     --------------
+!      M.Hamrud      01-Oct-2003 CY28 Cleaning
+!      NEC           25-Oct-2007 Optimisations
+!      JJMorcrette 20110613 flexible number of g-points
+!      ABozzo 201306 updated to rrtmg v4.85
+! ---------------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE PARRRTM  , ONLY : JPBAND
+USE YOERRTM  , ONLY : JPGPT  ,NG4   ,NGS3
+USE YOERRTWN , ONLY : NSPA   ,NSPB
+USE YOERRTA4 , ONLY : ABSA   ,ABSB   ,FRACREFA, FRACREFB,SELFREF,FORREF
+USE YOERRTRF, ONLY : CHI_MLS
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ONEMINUS
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCO2(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLO3(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV) 
+
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_RAT_H2OCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_RAT_H2OCO2_1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_RAT_O3CO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_RAT_O3CO2_1(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)   :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFRAC(KIDIA:KFDIA,KLEV) 
+! ---------------------------------------------------------------------------
+
+REAL(KIND=JPRB) :: Z_SPECCOMB(KLEV),Z_SPECCOMB1(KLEV), Z_SPECCOMB_PLANCK(KLEV)
+INTEGER(KIND=JPIM) :: IND0(KLEV),IND1(KLEV),INDS(KLEV),INDF(KLEV)
+
+INTEGER(KIND=JPIM) :: IG, JS, JLAY, JS1, JPL
+INTEGER(KIND=JPIM) :: JLON
+
+
+REAL(KIND=JPRB) :: ZREFRAT_PLANCK_A, ZREFRAT_PLANCK_B
+ REAL(KIND=JPRB) ::  Z_FAC000, Z_FAC100, Z_FAC200,&
+ & Z_FAC010, Z_FAC110, Z_FAC210, &
+ & Z_FAC001, Z_FAC101, Z_FAC201, &
+ & Z_FAC011, Z_FAC111, Z_FAC211
+REAL(KIND=JPRB) :: ZP, ZP4, ZFK0, ZFK1, ZFK2
+REAL(KIND=JPRB) :: ZTAUFOR,ZTAUSELF,ZTAU_MAJOR,ZTAU_MAJOR1
+REAL(KIND=JPRB) :: Z_FS, Z_SPECMULT, Z_SPECPARM,  &
+ & Z_FS1, Z_SPECMULT1, Z_SPECPARM1, &
+ & Z_FPL, Z_SPECMULT_PLANCK, Z_SPECPARM_PLANCK
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+! P =   142.5940 mb
+      ZREFRAT_PLANCK_A = CHI_MLS(1,11)/CHI_MLS(2,11)
+
+! P = 95.58350 mb
+      ZREFRAT_PLANCK_B = CHI_MLS(3,13)/CHI_MLS(2,13)
+
+
+!     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. 
+ 
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL4',0,ZHOOK_HANDLE)
+
+DO JLAY = 1, KLEV
+  DO JLON = KIDIA, KFDIA
+    IF (JLAY <= K_LAYTROP(JLON)) THEN
+      Z_SPECCOMB(JLAY) = P_COLH2O(JLON,JLAY) + P_RAT_H2OCO2(JLON,JLAY)*P_COLCO2(JLON,JLAY)
+      Z_SPECPARM = P_COLH2O(JLON,JLAY)/Z_SPECCOMB(JLAY)
+      Z_SPECPARM=MIN(P_ONEMINUS,Z_SPECPARM)
+      Z_SPECMULT = 8._JPRB*(Z_SPECPARM)
+      JS = 1 + INT(Z_SPECMULT)
+      Z_FS = MOD(Z_SPECMULT,1.0_JPRB)
+
+      Z_SPECCOMB1(JLAY) = P_COLH2O(JLON,JLAY) + P_RAT_H2OCO2_1(JLON,JLAY)*P_COLCO2(JLON,JLAY)
+      Z_SPECPARM1 = P_COLH2O(JLON,JLAY)/Z_SPECCOMB1(JLAY)
+      IF (Z_SPECPARM1 >= P_ONEMINUS) Z_SPECPARM1 = P_ONEMINUS
+      Z_SPECMULT1 = 8._JPRB*(Z_SPECPARM1)
+      JS1 = 1 + INT(Z_SPECMULT1)
+      Z_FS1 = MOD(Z_SPECMULT1,1.0_JPRB)
+
+      Z_SPECCOMB_PLANCK(JLAY) = P_COLH2O(JLON,JLAY)+ZREFRAT_PLANCK_A*P_COLCO2(JLON,JLAY)
+      Z_SPECPARM_PLANCK = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_PLANCK(JLAY)
+      IF (Z_SPECPARM_PLANCK >= P_ONEMINUS) Z_SPECPARM_PLANCK=P_ONEMINUS
+      Z_SPECMULT_PLANCK = 8._JPRB*Z_SPECPARM_PLANCK
+      JPL= 1 + INT(Z_SPECMULT_PLANCK)
+      Z_FPL = MOD(Z_SPECMULT_PLANCK,1.0_JPRB)
+
+      IND0(JLAY) = ((K_JP(JLON,JLAY)-1)*5+(K_JT(JLON,JLAY)-1))*NSPA(4) + JS
+      IND1(JLAY) = (K_JP(JLON,JLAY)*5+(K_JT1(JLON,JLAY)-1))*NSPA(4) + JS1
+      INDS(JLAY) = K_INDSELF(JLON,JLAY)
+      INDF(JLAY) = K_INDFOR(JLON,JLAY)
+
+    IF (Z_SPECPARM < 0.125_JPRB) THEN
+            ZP = Z_FS - 1
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC000 = ZFK0*P_FAC00(JLON,JLAY)
+            Z_FAC100 = ZFK1*P_FAC00(JLON,JLAY)
+            Z_FAC200 = ZFK2*P_FAC00(JLON,JLAY)
+            Z_FAC010 = ZFK0*P_FAC10(JLON,JLAY)
+            Z_FAC110 = ZFK1*P_FAC10(JLON,JLAY)
+            Z_FAC210 = ZFK2*P_FAC10(JLON,JLAY)
+         ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
+            ZP = -Z_FS 
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC000 = ZFK0*P_FAC00(JLON,JLAY)
+            Z_FAC100 = ZFK1*P_FAC00(JLON,JLAY)
+            Z_FAC200 = ZFK2*P_FAC00(JLON,JLAY)
+            Z_FAC010 = ZFK0*P_FAC10(JLON,JLAY)
+            Z_FAC110 = ZFK1*P_FAC10(JLON,JLAY)
+            Z_FAC210 = ZFK2*P_FAC10(JLON,JLAY)
+         ELSE
+            Z_FAC000 = (1._JPRB - Z_FS) * P_FAC00(JLON,JLAY)
+            Z_FAC010 = (1._JPRB - Z_FS) * P_FAC10(JLON,JLAY)
+            Z_FAC100 = Z_FS * P_FAC00(JLON,JLAY)
+            Z_FAC110 = Z_FS * P_FAC10(JLON,JLAY)
+         ENDIF
+         IF (Z_SPECPARM1 < 0.125_JPRB) THEN
+            ZP = Z_FS1 - 1
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC001 = ZFK0*P_FAC01(JLON,JLAY)
+            Z_FAC101 = ZFK1*P_FAC01(JLON,JLAY)
+            Z_FAC201 = ZFK2*P_FAC01(JLON,JLAY)
+            Z_FAC011 = ZFK0*P_FAC11(JLON,JLAY)
+            Z_FAC111 = ZFK1*P_FAC11(JLON,JLAY)
+            Z_FAC211 = ZFK2*P_FAC11(JLON,JLAY)
+         ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
+            ZP = -Z_FS1 
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC001 = ZFK0*P_FAC01(JLON,JLAY)
+            Z_FAC101 = ZFK1*P_FAC01(JLON,JLAY)
+            Z_FAC201 = ZFK2*P_FAC01(JLON,JLAY)
+            Z_FAC011 = ZFK0*P_FAC11(JLON,JLAY)
+            Z_FAC111 = ZFK1*P_FAC11(JLON,JLAY)
+            Z_FAC211 = ZFK2*P_FAC11(JLON,JLAY)
+         ELSE
+            Z_FAC001 = (1._JPRB - Z_FS1) * P_FAC01(JLON,JLAY)
+            Z_FAC011 = (1._JPRB - Z_FS1) * P_FAC11(JLON,JLAY)
+            Z_FAC101 = Z_FS1 * P_FAC01(JLON,JLAY)
+            Z_FAC111 = Z_FS1 * P_FAC11(JLON,JLAY)
+         ENDIF
+
+
+
+!-- DS_000515
+!CDIR UNROLL=NG4
+      DO IG = 1, NG4
+!-- DS_000515
+         ZTAUSELF = P_SELFFAC(JLON,JLAY)* (SELFREF(INDS(JLAY),IG) + P_SELFFRAC(JLON,JLAY) * &
+              &  (SELFREF(INDS(JLAY)+1,IG) - SELFREF(INDS(JLAY),IG)))
+         ZTAUFOR = P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + P_FORFRAC(JLON,JLAY) * &
+              &  (FORREF(INDF(JLAY)+1,IG) - FORREF(INDF(JLAY),IG))) 
+
+            IF (Z_SPECPARM < 0.125_JPRB) THEN
+               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
+                 &  (Z_FAC000 * ABSA(IND0(JLAY),IG) + &
+                 &  Z_FAC100 * ABSA(IND0(JLAY)+1,IG) + &
+                 &  Z_FAC200 * ABSA(IND0(JLAY)+2,IG) + &
+                 &  Z_FAC010 * ABSA(IND0(JLAY)+9,IG) + &
+                 &  Z_FAC110 * ABSA(IND0(JLAY)+10,IG) + &
+                 &  Z_FAC210 * ABSA(IND0(JLAY)+11,IG))
+            ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
+               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
+                 &  (Z_FAC200 * ABSA(IND0(JLAY)-1,IG) + &
+                 &  Z_FAC100 * ABSA(IND0(JLAY),IG) + &
+                 &  Z_FAC000 * ABSA(IND0(JLAY)+1,IG) + &
+                 &  Z_FAC210 * ABSA(IND0(JLAY)+8,IG) + &
+                 &  Z_FAC110 * ABSA(IND0(JLAY)+9,IG) + &
+                 &  Z_FAC010 * ABSA(IND0(JLAY)+10,IG))
+            ELSE
+               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
+                 &  (Z_FAC000 * ABSA(IND0(JLAY),IG) + &
+                 &  Z_FAC100 * ABSA(IND0(JLAY)+1,IG) + &
+                 &  Z_FAC010 * ABSA(IND0(JLAY)+9,IG) + &
+                 &  Z_FAC110 * ABSA(IND0(JLAY)+10,IG))
+            ENDIF
+
+            IF (Z_SPECPARM1 < 0.125_JPRB) THEN
+               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
+                 &  (Z_FAC001 * ABSA(IND1(JLAY),IG) + &
+                 &  Z_FAC101 * ABSA(IND1(JLAY)+1,IG) + &
+                 &  Z_FAC201 * ABSA(IND1(JLAY)+2,IG) + &
+                 &  Z_FAC011 * ABSA(IND1(JLAY)+9,IG) + &
+                 &  Z_FAC111 * ABSA(IND1(JLAY)+10,IG) + &
+                 &  Z_FAC211 * ABSA(IND1(JLAY)+11,IG))
+            ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
+               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
+                 &  (Z_FAC201 * ABSA(IND1(JLAY)-1,IG) + &
+                 &  Z_FAC101 * ABSA(IND1(JLAY),IG) + &
+                 &  Z_FAC001 * ABSA(IND1(JLAY)+1,IG) + &
+                 &  Z_FAC211 * ABSA(IND1(JLAY)+8,IG) + &
+                 &  Z_FAC111 * ABSA(IND1(JLAY)+9,IG) + &
+                 &  Z_FAC011 * ABSA(IND1(JLAY)+10,IG))
+            ELSE
+               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
+                 &  (Z_FAC001 * ABSA(IND1(JLAY),IG) +  &
+                 &  Z_FAC101 * ABSA(IND1(JLAY)+1,IG) + &
+                 &  Z_FAC011 * ABSA(IND1(JLAY)+9,IG) + &
+                 &  Z_FAC111 * ABSA(IND1(JLAY)+10,IG))
+            ENDIF
+
+
+            P_TAU(JLON,NGS3+IG,JLAY) = ZTAU_MAJOR + ZTAU_MAJOR1 &
+               & + ZTAUSELF + ZTAUFOR &
+               & + P_TAUAERL(JLON,JLAY,4)  
+            PFRAC(JLON,NGS3+IG,JLAY) = FRACREFA(IG,JPL) + Z_FPL *&
+               & (FRACREFA(IG,JPL+1) - FRACREFA(IG,JPL)) 
+      ENDDO
+    ENDIF
+
+    IF (JLAY > K_LAYTROP(JLON)) THEN
+      Z_SPECCOMB(JLAY) = P_COLO3(JLON,JLAY) + P_RAT_O3CO2(JLON,JLAY)*P_COLCO2(JLON,JLAY)
+      Z_SPECPARM = P_COLO3(JLON,JLAY)/Z_SPECCOMB(JLAY)
+      Z_SPECPARM=MIN(P_ONEMINUS,Z_SPECPARM)
+      Z_SPECMULT = 4._JPRB*(Z_SPECPARM)
+      JS = 1 + INT(Z_SPECMULT)
+      Z_FS = MOD(Z_SPECMULT,1.0_JPRB)
+
+      Z_SPECCOMB1(JLAY) = P_COLO3(JLON,JLAY) + P_RAT_O3CO2_1(JLON,JLAY)*P_COLCO2(JLON,JLAY)
+      Z_SPECPARM1 = P_COLO3(JLON,JLAY)/Z_SPECCOMB1(JLAY)
+      Z_SPECPARM1=MIN(P_ONEMINUS,Z_SPECPARM1)
+      Z_SPECMULT1 = 4._JPRB*(Z_SPECPARM1)
+      JS1 = 1 + INT(Z_SPECMULT1)
+      Z_FS1 = MOD(Z_SPECMULT1,1.0_JPRB)
+
+      Z_FAC000 = (1._JPRB - Z_FS) * P_FAC00(JLON,JLAY)
+      Z_FAC010 = (1._JPRB - Z_FS) * P_FAC10(JLON,JLAY)
+      Z_FAC100 = Z_FS * P_FAC00(JLON,JLAY)
+      Z_FAC110 = Z_FS * P_FAC10(JLON,JLAY)
+      Z_FAC001 = (1._JPRB - Z_FS1) * P_FAC01(JLON,JLAY)
+      Z_FAC011 = (1._JPRB - Z_FS1) * P_FAC11(JLON,JLAY)
+      Z_FAC101 = Z_FS1 * P_FAC01(JLON,JLAY)
+      Z_FAC111 = Z_FS1 * P_FAC11(JLON,JLAY)
+
+      Z_SPECCOMB_PLANCK(JLAY) = P_COLO3(JLON,JLAY)+ZREFRAT_PLANCK_B*P_COLCO2(JLON,JLAY)
+      Z_SPECPARM_PLANCK = P_COLO3(JLON,JLAY)/Z_SPECCOMB_PLANCK(JLAY)
+      IF (Z_SPECPARM_PLANCK >= P_ONEMINUS) Z_SPECPARM_PLANCK=P_ONEMINUS
+      Z_SPECMULT_PLANCK = 4._JPRB*Z_SPECPARM_PLANCK
+      JPL= 1 + INT(Z_SPECMULT_PLANCK)
+      Z_FPL = MOD(Z_SPECMULT_PLANCK,1.0_JPRB)
+
+      IND0(JLAY) = ((K_JP(JLON,JLAY)-13)*5+(K_JT(JLON,JLAY)-1))*NSPB(4) + JS
+      IND1(JLAY) = ((K_JP(JLON,JLAY)-12)*5+(K_JT1(JLON,JLAY)-1))*NSPB(4) + JS1
+
+
+!CDIR UNROLL=NG4
+      DO IG = 1, NG4
+        P_TAU(JLON,NGS3+IG,JLAY) = Z_SPECCOMB(JLAY) *   &
+          &(Z_FAC000 * ABSB(IND0(JLAY)  ,IG) +&
+          & Z_FAC100 * ABSB(IND0(JLAY)+1,IG) +&
+          & Z_FAC010 * ABSB(IND0(JLAY)+5,IG) +&
+          & Z_FAC110 * ABSB(IND0(JLAY)+6,IG)) +&
+          & Z_SPECCOMB1(JLAY) * &
+          & (Z_FAC001 * ABSB(IND1(JLAY)  ,IG) +&
+          & Z_FAC101 * ABSB(IND1(JLAY)+1,IG) +&
+          & Z_FAC011 * ABSB(IND1(JLAY)+5,IG) +&
+          & Z_FAC111 * ABSB(IND1(JLAY)+6,IG))+&
+          & P_TAUAERL(JLON,JLAY,4)  
+        PFRAC(JLON,NGS3+IG,JLAY) = FRACREFB(IG,JPL) + Z_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.
+
+         P_TAU(JLON,NGS3+8,JLAY)=P_TAU(JLON,NGS3+8,JLAY)*0.92
+         P_TAU(JLON,NGS3+9,JLAY)=P_TAU(JLON,NGS3+9,JLAY)*0.88
+         P_TAU(JLON,NGS3+10,JLAY)=P_TAU(JLON,NGS3+10,JLAY)*1.07
+         P_TAU(JLON,NGS3+11,JLAY)=P_TAU(JLON,NGS3+11,JLAY)*1.1
+         P_TAU(JLON,NGS3+12,JLAY)=P_TAU(JLON,NGS3+12,JLAY)*0.99
+         P_TAU(JLON,NGS3+13,JLAY)=P_TAU(JLON,NGS3+13,JLAY)*0.88
+         P_TAU(JLON,NGS3+14,JLAY)=P_TAU(JLON,NGS3+14,JLAY)*0.943
+
+
+    ENDIF
+  ENDDO
+ENDDO
+
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL4',1,ZHOOK_HANDLE)
+
+END ASSOCIATE
+END SUBROUTINE RRTM_TAUMOL4
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol4.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol4.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol4.intfb.h	(revision 3908)
@@ -0,0 +1,38 @@
+INTERFACE
+SUBROUTINE RRTM_TAUMOL4 (KIDIA,KFDIA,KLEV,P_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLCO2,P_COLO3,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC,&
+ & P_RAT_H2OCO2, P_RAT_H2OCO2_1, P_RAT_O3CO2, P_RAT_O3CO2_1) 
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+USE PARRRTM , ONLY : JPBAND
+USE YOERRTM , ONLY : JPGPT ,NG4 ,NGS3
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLO3(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_RAT_H2OCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_RAT_H2OCO2_1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_RAT_O3CO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_RAT_O3CO2_1(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+END SUBROUTINE RRTM_TAUMOL4
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol5.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol5.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol5.F90	(revision 3908)
@@ -0,0 +1,354 @@
+!----------------------------------------------------------------------------
+SUBROUTINE RRTM_TAUMOL5 (KIDIA,KFDIA,KLEV,P_TAU,P_WX,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLCO2, P_COLO3,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC, &
+ & P_RAT_H2OCO2, P_RAT_H2OCO2_1, P_RAT_O3CO2, P_RAT_O3CO2_1,PMINORFRAC,KINDMINOR)  
+
+!     BAND 5:  700-820 cm-1 (low - H2O,CO2; high - O3,CO2)
+
+!     AUTHOR.
+!     -------
+!      JJMorcrette, ECMWF
+
+!     MODIFICATIONS.
+!     --------------
+!      M.Hamrud      01-Oct-2003 CY28 Cleaning
+!      NEC           25-Oct-2007 Optimisations
+!      JJMorcrette 20110613 flexible number of g-points
+!      ABozzo 201306 updated to rrtmg v4.85
+!      band 5:  700-820 cm-1 (low key - h2o,co2; low minor - o3, ccl4)
+!                            (high key - o3,co2)
+! ---------------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE PARRRTM  , ONLY : JPBAND ,JPXSEC
+USE YOERRTM  , ONLY : JPGPT  ,NG5    ,NGS4
+USE YOERRTWN , ONLY : NSPA   ,NSPB  
+USE YOERRTA5 , ONLY : ABSA   ,ABSB   ,CCL4   , FRACREFA, FRACREFB,SELFREF,FORREF, &
+ & KA_MO3
+USE YOERRTRF, ONLY : CHI_MLS
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_WX(KIDIA:KFDIA,JPXSEC,KLEV) ! Amount of trace gases
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ONEMINUS
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCO2(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLO3(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV) 
+
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_RAT_H2OCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_RAT_H2OCO2_1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_RAT_O3CO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_RAT_O3CO2_1(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)   :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFRAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)   :: PMINORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)   :: KINDMINOR(KIDIA:KFDIA,KLEV)
+! ---------------------------------------------------------------------------
+
+REAL(KIND=JPRB) :: Z_SPECCOMB(KLEV),Z_SPECCOMB1(KLEV), &
+& Z_SPECCOMB_MO3(KLEV), Z_SPECCOMB_PLANCK(KLEV)
+INTEGER(KIND=JPIM) :: IND0(KLEV),IND1(KLEV),INDS(KLEV),INDF(KLEV),INDM(KLEV)
+
+INTEGER(KIND=JPIM) :: IG, JS, JLAY, JS1, JPL, JMO3
+INTEGER(KIND=JPIM) :: JLON
+
+REAL(KIND=JPRB) :: Z_REFRAT_PLANCK_A, Z_REFRAT_PLANCK_B,Z_REFRAT_M_A
+
+REAL(KIND=JPRB) ::  Z_FAC000, Z_FAC100, Z_FAC200,&
+ & Z_FAC010, Z_FAC110, Z_FAC210, &
+ & Z_FAC001, Z_FAC101, Z_FAC201, &
+ & Z_FAC011, Z_FAC111, Z_FAC211
+REAL(KIND=JPRB) :: ZP, ZP4, ZFK0, ZFK1, ZFK2
+REAL(KIND=JPRB) :: ZTAUFOR,ZTAUSELF,ZTAU_MAJOR,ZTAU_MAJOR1, ZO3M1, ZO3M2, ZABSO3
+
+REAL(KIND=JPRB) :: Z_FS, Z_SPECMULT, Z_SPECPARM, &
+& Z_FS1, Z_SPECMULT1, Z_SPECPARM1, &
+& Z_FPL, Z_SPECMULT_PLANCK, Z_SPECPARM_PLANCK, &
+& Z_FMO3, Z_SPECMULT_MO3, Z_SPECPARM_MO3  
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+! 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
+      Z_REFRAT_PLANCK_A = CHI_MLS(1,5)/CHI_MLS(2,5)
+
+! P = 0.2369 mb
+      Z_REFRAT_PLANCK_B = CHI_MLS(3,43)/CHI_MLS(2,43)
+
+! P = 317.3480
+      Z_REFRAT_M_A = CHI_MLS(1,7)/CHI_MLS(2,7)
+
+
+!     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.  
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL5',0,ZHOOK_HANDLE)
+
+DO JLAY = 1, KLEV
+  DO JLON = KIDIA, KFDIA
+    IF (JLAY <= K_LAYTROP(JLON)) THEN
+      Z_SPECCOMB(JLAY) = P_COLH2O(JLON,JLAY) + P_RAT_H2OCO2(JLON,JLAY)*P_COLCO2(JLON,JLAY)
+      Z_SPECPARM = P_COLH2O(JLON,JLAY)/Z_SPECCOMB(JLAY)
+      Z_SPECPARM=MIN(P_ONEMINUS,Z_SPECPARM)
+      Z_SPECMULT = 8._JPRB*(Z_SPECPARM)
+      JS = 1 + INT(Z_SPECMULT)
+      Z_FS = MOD(Z_SPECMULT,1.0_JPRB)
+
+      Z_SPECCOMB1(JLAY) = P_COLH2O(JLON,JLAY) + P_RAT_H2OCO2_1(JLON,JLAY)*P_COLCO2(JLON,JLAY)
+      Z_SPECPARM1 = P_COLH2O(JLON,JLAY)/Z_SPECCOMB1(JLAY)
+      IF (Z_SPECPARM1 >= P_ONEMINUS) Z_SPECPARM1 = P_ONEMINUS
+      Z_SPECMULT1 = 8._JPRB*(Z_SPECPARM1)
+      JS1 = 1 + INT(Z_SPECMULT1)
+      Z_FS1 = MOD(Z_SPECMULT1,1.0_JPRB)
+
+      Z_SPECCOMB_MO3(JLAY) = P_COLH2O(JLON,JLAY) + Z_REFRAT_M_A*P_COLCO2(JLON,JLAY)
+      Z_SPECPARM_MO3 = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_MO3(JLAY)
+      IF (Z_SPECPARM_MO3 >= P_ONEMINUS) Z_SPECPARM_MO3 = P_ONEMINUS
+      Z_SPECMULT_MO3 = 8._JPRB*Z_SPECPARM_MO3
+      JMO3 = 1 + INT(Z_SPECMULT_MO3)
+      Z_FMO3 = MOD(Z_SPECMULT_MO3,1.0_JPRB)
+
+      Z_SPECCOMB_PLANCK(JLAY) = P_COLH2O(JLON,JLAY)+Z_REFRAT_PLANCK_A*P_COLCO2(JLON,JLAY)
+      Z_SPECPARM_PLANCK = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_PLANCK(JLAY)
+      IF (Z_SPECPARM_PLANCK >= P_ONEMINUS) Z_SPECPARM_PLANCK=P_ONEMINUS
+      Z_SPECMULT_PLANCK = 8._JPRB*Z_SPECPARM_PLANCK
+      JPL= 1 + INT(Z_SPECMULT_PLANCK)
+      Z_FPL = MOD(Z_SPECMULT_PLANCK,1.0_JPRB)
+
+
+      IND0(JLAY) = ((K_JP(JLON,JLAY)-1)*5+(K_JT(JLON,JLAY)-1))*NSPA(5) + JS
+      IND1(JLAY) = (K_JP(JLON,JLAY)*5+(K_JT1(JLON,JLAY)-1))*NSPA(5) + JS1
+      INDS(JLAY) = K_INDSELF(JLON,JLAY)
+      INDF(JLAY) = K_INDFOR(JLON,JLAY)
+      INDM(JLAY) = KINDMINOR(JLON,JLAY)
+
+
+      IF (Z_SPECPARM < 0.125_JPRB) THEN
+            ZP = Z_FS - 1
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC000 = ZFK0*P_FAC00(JLON,JLAY)
+            Z_FAC100 = ZFK1*P_FAC00(JLON,JLAY)
+            Z_FAC200 = ZFK2*P_FAC00(JLON,JLAY)
+            Z_FAC010 = ZFK0*P_FAC10(JLON,JLAY)
+            Z_FAC110 = ZFK1*P_FAC10(JLON,JLAY)
+            Z_FAC210 = ZFK2*P_FAC10(JLON,JLAY)
+      ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
+            ZP = -Z_FS 
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC000 = ZFK0*P_FAC00(JLON,JLAY)
+            Z_FAC100 = ZFK1*P_FAC00(JLON,JLAY)
+            Z_FAC200 = ZFK2*P_FAC00(JLON,JLAY)
+            Z_FAC010 = ZFK0*P_FAC10(JLON,JLAY)
+            Z_FAC110 = ZFK1*P_FAC10(JLON,JLAY)
+            Z_FAC210 = ZFK2*P_FAC10(JLON,JLAY)
+      ELSE
+            Z_FAC000 = (1._JPRB - Z_FS) * P_FAC00(JLON,JLAY)
+            Z_FAC010 = (1._JPRB - Z_FS) * P_FAC10(JLON,JLAY)
+            Z_FAC100 = Z_FS * P_FAC00(JLON,JLAY)
+            Z_FAC110 = Z_FS * P_FAC10(JLON,JLAY)
+      ENDIF
+      IF (Z_SPECPARM1 < 0.125_JPRB) THEN
+            ZP = Z_FS1 - 1
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC001 = ZFK0*P_FAC01(JLON,JLAY)
+            Z_FAC101 = ZFK1*P_FAC01(JLON,JLAY)
+            Z_FAC201 = ZFK2*P_FAC01(JLON,JLAY)
+            Z_FAC011 = ZFK0*P_FAC11(JLON,JLAY)
+            Z_FAC111 = ZFK1*P_FAC11(JLON,JLAY)
+            Z_FAC211 = ZFK2*P_FAC11(JLON,JLAY)
+      ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
+            ZP = -Z_FS1 
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC001 = ZFK0*P_FAC01(JLON,JLAY)
+            Z_FAC101 = ZFK1*P_FAC01(JLON,JLAY)
+            Z_FAC201 = ZFK2*P_FAC01(JLON,JLAY)
+            Z_FAC011 = ZFK0*P_FAC11(JLON,JLAY)
+            Z_FAC111 = ZFK1*P_FAC11(JLON,JLAY)
+            Z_FAC211 = ZFK2*P_FAC11(JLON,JLAY)
+      ELSE
+            Z_FAC001 = (1._JPRB - Z_FS1) * P_FAC01(JLON,JLAY)
+            Z_FAC011 = (1._JPRB - Z_FS1) * P_FAC11(JLON,JLAY)
+            Z_FAC101 = Z_FS1 * P_FAC01(JLON,JLAY)
+            Z_FAC111 = Z_FS1 * P_FAC11(JLON,JLAY)
+      ENDIF
+
+
+
+!CDIR UNROLL=NG5
+      DO IG = 1, NG5
+
+         ZTAUSELF = P_SELFFAC(JLON,JLAY)* (SELFREF(INDS(JLAY),IG) + P_SELFFRAC(JLON,JLAY) * &
+            &     (SELFREF(INDS(JLAY)+1,IG) - SELFREF(INDS(JLAY),IG)))
+         ZTAUFOR = P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + P_FORFRAC(JLON,JLAY) * &
+            &     (FORREF(INDF(JLAY)+1,IG) - FORREF(INDF(JLAY),IG))) 
+         ZO3M1 = KA_MO3(JMO3,INDM(JLAY),IG) + Z_FMO3 * &
+            &     (KA_MO3(JMO3+1,INDM(JLAY),IG) - KA_MO3(JMO3,INDM(JLAY),IG))
+         ZO3M2 = KA_MO3(JMO3,INDM(JLAY)+1,IG) + Z_FMO3 * &
+            &     (KA_MO3(JMO3+1,INDM(JLAY)+1,IG) - KA_MO3(JMO3,INDM(JLAY)+1,IG))
+         ZABSO3 = ZO3M1 + PMINORFRAC(JLON,JLAY) * (ZO3M2 - ZO3M1)
+
+
+            IF (Z_SPECPARM < 0.125_JPRB) THEN
+               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
+                 &   (Z_FAC000 * ABSA(IND0(JLAY),IG) + &
+                 &   Z_FAC100 * ABSA(IND0(JLAY)+1,IG) + &
+                 &   Z_FAC200 * ABSA(IND0(JLAY)+2,IG) + &
+                 &   Z_FAC010 * ABSA(IND0(JLAY)+9,IG) + &
+                 &   Z_FAC110 * ABSA(IND0(JLAY)+10,IG) + &
+                 &   Z_FAC210 * ABSA(IND0(JLAY)+11,IG))
+            ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
+               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
+                 &   (Z_FAC200 * ABSA(IND0(JLAY)-1,IG) + &
+                 &   Z_FAC100 * ABSA(IND0(JLAY),IG) + &
+                 &   Z_FAC000 * ABSA(IND0(JLAY)+1,IG) + &
+                 &   Z_FAC210 * ABSA(IND0(JLAY)+8,IG) + &
+                 &   Z_FAC110 * ABSA(IND0(JLAY)+9,IG) + &
+                 &   Z_FAC010 * ABSA(IND0(JLAY)+10,IG))
+            ELSE
+               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
+                 &   (Z_FAC000 * ABSA(IND0(JLAY),IG) + &
+                 &   Z_FAC100 * ABSA(IND0(JLAY)+1,IG) + &
+                 &   Z_FAC010 * ABSA(IND0(JLAY)+9,IG) + &
+                 &   Z_FAC110 * ABSA(IND0(JLAY)+10,IG))
+            ENDIF
+
+            IF (Z_SPECPARM1 < 0.125_JPRB) THEN
+               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
+                 &   (Z_FAC001 * ABSA(IND1(JLAY),IG) + &
+                 &   Z_FAC101 * ABSA(IND1(JLAY)+1,IG) + &
+                 &   Z_FAC201 * ABSA(IND1(JLAY)+2,IG) + &
+                 &   Z_FAC011 * ABSA(IND1(JLAY)+9,IG) + &
+                 &   Z_FAC111 * ABSA(IND1(JLAY)+10,IG) + &
+                 &   Z_FAC211 * ABSA(IND1(JLAY)+11,IG))
+            ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
+               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
+                 &   (Z_FAC201 * ABSA(IND1(JLAY)-1,IG) + &
+                 &   Z_FAC101 * ABSA(IND1(JLAY),IG) + &
+                 &   Z_FAC001 * ABSA(IND1(JLAY)+1,IG) + &
+                 &   Z_FAC211 * ABSA(IND1(JLAY)+8,IG) + &
+                 &   Z_FAC111 * ABSA(IND1(JLAY)+9,IG) + &
+                 &   Z_FAC011 * ABSA(IND1(JLAY)+10,IG))
+            ELSE
+               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
+                 &   (Z_FAC001 * ABSA(IND1(JLAY),IG) +  &
+                 &   Z_FAC101 * ABSA(IND1(JLAY)+1,IG) + &
+                 &   Z_FAC011 * ABSA(IND1(JLAY)+9,IG) + &
+                 &   Z_FAC111 * ABSA(IND1(JLAY)+10,IG))
+            ENDIF
+
+
+
+        P_TAU(JLON,NGS4+IG,JLAY) = ZTAU_MAJOR + ZTAU_MAJOR1 &
+         & + ZTAUSELF + ZTAUFOR &
+         & + ZABSO3*P_COLO3(JLON,JLAY) &
+         & + P_WX(JLON,1,JLAY) * CCL4(IG)&
+         & + P_TAUAERL(JLON,JLAY,5)  
+        PFRAC(JLON,NGS4+IG,JLAY) = FRACREFA(IG,JPL) + Z_FPL *&
+         & (FRACREFA(IG,JPL+1) - FRACREFA(IG,JPL))  
+      ENDDO
+    ENDIF
+
+    IF (JLAY > K_LAYTROP(JLON)) THEN
+      Z_SPECCOMB(JLAY) = P_COLO3(JLON,JLAY) + P_RAT_O3CO2(JLON,JLAY)*P_COLCO2(JLON,JLAY)
+      Z_SPECPARM = P_COLO3(JLON,JLAY)/Z_SPECCOMB(JLAY)
+      Z_SPECPARM=MIN(P_ONEMINUS,Z_SPECPARM)
+      Z_SPECMULT = 4._JPRB*(Z_SPECPARM)
+      JS = 1 + INT(Z_SPECMULT)
+      Z_FS = MOD(Z_SPECMULT,1.0_JPRB)
+
+      Z_SPECCOMB1(JLAY) = P_COLO3(JLON,JLAY) + P_RAT_O3CO2_1(JLON,JLAY)*P_COLCO2(JLON,JLAY)
+      Z_SPECPARM1 = P_COLO3(JLON,JLAY)/Z_SPECCOMB1(JLAY)
+      IF (Z_SPECPARM1 >= P_ONEMINUS) Z_SPECPARM1 = P_ONEMINUS
+      Z_SPECMULT1 = 4._JPRB*(Z_SPECPARM1)
+      JS1 = 1 + INT(Z_SPECMULT1)
+      Z_FS1 = MOD(Z_SPECMULT1,1.0_JPRB)
+
+      Z_FAC000 = (1._JPRB - Z_FS) * P_FAC00(JLON,JLAY)
+      Z_FAC010 = (1._JPRB - Z_FS) * P_FAC10(JLON,JLAY)
+      Z_FAC100 = Z_FS * P_FAC00(JLON,JLAY)
+      Z_FAC110 = Z_FS * P_FAC10(JLON,JLAY)
+      Z_FAC001 = (1._JPRB - Z_FS1) * P_FAC01(JLON,JLAY)
+      Z_FAC011 = (1._JPRB - Z_FS1) * P_FAC11(JLON,JLAY)
+      Z_FAC101 = Z_FS1 * P_FAC01(JLON,JLAY)
+      Z_FAC111 = Z_FS1 * P_FAC11(JLON,JLAY)
+
+      Z_SPECCOMB_PLANCK(JLAY) = P_COLO3(JLON,JLAY)+Z_REFRAT_PLANCK_B*P_COLCO2(JLON,JLAY)
+      Z_SPECPARM_PLANCK = P_COLO3(JLON,JLAY)/Z_SPECCOMB_PLANCK(JLAY)
+      IF (Z_SPECPARM_PLANCK >= P_ONEMINUS) Z_SPECPARM_PLANCK=P_ONEMINUS
+      Z_SPECMULT_PLANCK = 4._JPRB*Z_SPECPARM_PLANCK
+      JPL= 1 + INT(Z_SPECMULT_PLANCK)
+      Z_FPL = MOD(Z_SPECMULT_PLANCK,1.0_JPRB)
+
+
+      IND0(JLAY) = ((K_JP(JLON,JLAY)-13)*5+(K_JT(JLON,JLAY)-1))*NSPB(5) + JS
+      IND1(JLAY) = ((K_JP(JLON,JLAY)-12)*5+(K_JT1(JLON,JLAY)-1))*NSPB(5) + JS1
+
+
+
+!CDIR UNROLL=NG5
+      DO IG = 1, NG5
+!-- DS_000515
+        P_TAU(JLON,NGS4+IG,JLAY) = Z_SPECCOMB(JLAY) *   &
+         &(Z_FAC000 * ABSB(IND0(JLAY)  ,IG) +&
+         & Z_FAC100 * ABSB(IND0(JLAY)+1,IG) +&
+         & Z_FAC010 * ABSB(IND0(JLAY)+5,IG) +&
+         & Z_FAC110 * ABSB(IND0(JLAY)+6,IG)) +&
+         & Z_SPECCOMB1(JLAY) * &
+         & (Z_FAC001 * ABSB(IND1(JLAY)  ,IG) +&
+         & Z_FAC101 * ABSB(IND1(JLAY)+1,IG) +&
+         & Z_FAC011 * ABSB(IND1(JLAY)+5,IG) +&
+         & Z_FAC111 * ABSB(IND1(JLAY)+6,IG))+&
+         & P_WX(JLON,1,JLAY) * CCL4(IG)+&
+         & P_TAUAERL(JLON,JLAY,5)  
+        PFRAC(JLON,NGS4+IG,JLAY) = FRACREFB(IG,JPL) + Z_FPL *&
+         & (FRACREFB(IG,JPL+1) - FRACREFB(IG,JPL))  
+      ENDDO
+    ENDIF
+  ENDDO
+ENDDO
+
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL5',1,ZHOOK_HANDLE)
+
+END ASSOCIATE
+END SUBROUTINE RRTM_TAUMOL5
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol5.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol5.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol5.intfb.h	(revision 3908)
@@ -0,0 +1,41 @@
+INTERFACE
+SUBROUTINE RRTM_TAUMOL5 (KIDIA,KFDIA,KLEV,P_TAU,P_WX,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLCO2, P_COLO3,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC,&
+ & P_RAT_H2OCO2, P_RAT_H2OCO2_1, P_RAT_O3CO2, P_RAT_O3CO2_1,PMINORFRAC,KINDMINOR) 
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+USE PARRRTM , ONLY : JPBAND ,JPXSEC
+USE YOERRTM , ONLY : JPGPT ,NG5 ,NGS4
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_WX(KIDIA:KFDIA,JPXSEC,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLO3(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_RAT_H2OCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_RAT_H2OCO2_1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_RAT_O3CO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_RAT_O3CO2_1(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PMINORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KINDMINOR(KIDIA:KFDIA,KLEV)
+END SUBROUTINE RRTM_TAUMOL5
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol6.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol6.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol6.F90	(revision 3908)
@@ -0,0 +1,150 @@
+!----------------------------------------------------------------------------
+SUBROUTINE RRTM_TAUMOL6 (KIDIA,KFDIA,KLEV,P_TAU,P_WX,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,&
+ & P_COLH2O,P_COLCO2,P_COLDRY,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC,PMINORFRAC,KINDMINOR)  
+
+!     BAND 6:  820-980 cm-1 (low - H2O; high - nothing)
+
+!     AUTHOR.
+!     -------
+!      JJMorcrette, ECMWF
+
+!     MODIFICATIONS.
+!     --------------
+!      M.Hamrud      01-Oct-2003 CY28 Cleaning
+!      NEC           25-Oct-2007 Optimisations
+!      JJMorcrette 20110613 flexible number of g-points
+!      ABozzo 201306 updated to rrtmg v4.85
+!     band 6:  820-980 cm-1 (low key - h2o; low minor - co2)
+!                           (high key - nothing; high minor - cfc11, cfc12)
+! ---------------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE PARRRTM  , ONLY : JPBAND ,JPXSEC
+USE YOERRTM  , ONLY : JPGPT  ,NG6   ,NGS5
+USE YOERRTWN , ONLY : NSPA   
+USE YOERRTA6 , ONLY : ABSA   ,KA_MCO2 ,CFC11ADJ , CFC12  ,&
+ & FRACREFA,SELFREF,FORREF  
+USE YOERRTRF, ONLY : CHI_MLS
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_WX(KIDIA:KFDIA,JPXSEC,KLEV) ! Amount of trace gases
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCO2(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLDRY(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV) 
+
+INTEGER(KIND=JPIM),INTENT(IN)   :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFRAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)   :: PMINORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)   :: KINDMINOR(KIDIA:KFDIA,KLEV)
+
+! ---------------------------------------------------------------------------
+
+INTEGER(KIND=JPIM) :: IND0(KLEV),IND1(KLEV),INDS(KLEV),INDF(KLEV),INDM(KLEV)
+
+INTEGER(KIND=JPIM) :: IG, JLAY
+INTEGER(KIND=JPIM) :: JLON
+
+REAL(KIND=JPRB) :: ZADJFAC,ZADJCOLCO2(KIDIA:KFDIA,KLEV),ZRATCO2,ZCHI_CO2
+REAL(KIND=JPRB) :: ZTAUFOR,ZTAUSELF,ZABSCO2
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+! 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- and foreign- continuum is interpolated
+!     (in temperature) separately.  
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL6',0,ZHOOK_HANDLE)
+
+DO JLAY = 1, KLEV
+  DO JLON = KIDIA, KFDIA
+    IF (JLAY <= K_LAYTROP(JLON)) THEN
+! In atmospheres where the amount of CO2 is too great to be considered
+! a minor species, adjust the column amount of CO2 by an empirical factor 
+! to obtain the proper contribution.
+      ZCHI_CO2 = P_COLCO2(JLON,JLAY)/P_COLDRY(JLON,JLAY)
+      ZRATCO2 = 1.E20_JPRB*ZCHI_CO2/CHI_MLS(2,K_JP(JLON,JLAY)+1)
+      IF (ZRATCO2 > 3.0_JPRB) THEN
+         ZADJFAC = 2.0_JPRB+(ZRATCO2-2.0_JPRB)**0.77_JPRB
+         ZADJCOLCO2(JLON,JLAY) = ZADJFAC*CHI_MLS(2,K_JP(JLON,JLAY)+1)*P_COLDRY(JLON,JLAY)*1.E-20_JPRB
+      ELSE
+         ZADJCOLCO2(JLON,JLAY) = P_COLCO2(JLON,JLAY)
+      ENDIF
+
+      IND0(JLAY) = ((K_JP(JLON,JLAY)-1)*5+(K_JT(JLON,JLAY)-1))*NSPA(6) + 1
+      IND1(JLAY) = (K_JP(JLON,JLAY)*5+(K_JT1(JLON,JLAY)-1))*NSPA(6) + 1
+      INDS(JLAY) = K_INDSELF(JLON,JLAY)
+      INDF(JLAY) = K_INDFOR(JLON,JLAY)
+      INDM(JLAY) = KINDMINOR(JLON,JLAY)
+
+!-- DS_000515  
+!CDIR UNROLL=NG6
+      DO IG = 1, NG6
+!-- DS_000515  
+        ZTAUSELF = P_SELFFAC(JLON,JLAY)* (SELFREF(INDS(JLAY),IG) + P_SELFFRAC(JLON,JLAY) * &
+            &     (SELFREF(INDS(JLAY)+1,IG) - SELFREF(INDS(JLAY),IG)))
+        ZTAUFOR = P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + P_FORFRAC(JLON,JLAY) * &
+            &     (FORREF(INDF(JLAY)+1,IG) - FORREF(INDF(JLAY),IG))) 
+        ZABSCO2 = KA_MCO2(INDM(JLAY),IG) + PMINORFRAC(JLON,JLAY) * &
+            &     (KA_MCO2(INDM(JLAY)+1,IG) - KA_MCO2(INDM(JLAY),IG))
+
+        P_TAU(JLON,NGS5+IG,JLAY) = P_COLH2O(JLON,JLAY) *&
+         & (P_FAC00(JLON,JLAY) * ABSA(IND0(JLAY)  ,IG) +&
+         & P_FAC10(JLON,JLAY) * ABSA(IND0(JLAY)+1,IG) +&
+         & P_FAC01(JLON,JLAY) * ABSA(IND1(JLAY)  ,IG) +&
+         & P_FAC11(JLON,JLAY) * ABSA(IND1(JLAY)+1,IG)) +&
+         & ZTAUSELF + ZTAUFOR &
+         & + P_WX(JLON,2,JLAY) * CFC11ADJ(IG)&
+         & + P_WX(JLON,3,JLAY) * CFC12(IG)&
+         & + ZADJCOLCO2(JLON,JLAY) * ZABSCO2 &
+         & + P_TAUAERL(JLON,JLAY,6)  
+        PFRAC(JLON,NGS5+IG,JLAY) = FRACREFA(IG)
+      ENDDO
+    ENDIF
+
+!     Nothing important goes on above LAYTROP in this band.
+!-- JJM_000517
+    IF (JLAY > K_LAYTROP(JLON)) THEN
+!CDIR UNROLL=NG6
+      DO IG = 1, NG6
+!-- JJM_000517
+        P_TAU(JLON,NGS5+IG,JLAY) = 0.0_JPRB &
+         & + P_WX(JLON,2,JLAY) * CFC11ADJ(IG)&
+         & + P_WX(JLON,3,JLAY) * CFC12(IG)&
+         & + P_TAUAERL(JLON,JLAY,6)  
+        PFRAC(JLON,NGS5+IG,JLAY) = FRACREFA(IG)
+      ENDDO
+    ENDIF
+  ENDDO
+ENDDO
+
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL6',1,ZHOOK_HANDLE)
+
+END ASSOCIATE
+END SUBROUTINE RRTM_TAUMOL6
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol6.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol6.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol6.intfb.h	(revision 3908)
@@ -0,0 +1,35 @@
+INTERFACE
+SUBROUTINE RRTM_TAUMOL6 (KIDIA,KFDIA,KLEV,P_TAU,P_WX,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,&
+ & P_COLH2O,P_COLCO2,P_COLDRY,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC,PMINORFRAC,KINDMINOR) 
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+USE PARRRTM , ONLY : JPBAND ,JPXSEC
+USE YOERRTM , ONLY : JPGPT ,NG6 ,NGS5
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_WX(KIDIA:KFDIA,JPXSEC,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLDRY(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PMINORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KINDMINOR(KIDIA:KFDIA,KLEV)
+END SUBROUTINE RRTM_TAUMOL6
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol7.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol7.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol7.F90	(revision 3908)
@@ -0,0 +1,349 @@
+!----------------------------------------------------------------------------
+SUBROUTINE RRTM_TAUMOL7 (KIDIA,KFDIA,KLEV,P_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLO3,P_COLCO2,P_COLDRY,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC, &
+ & P_RAT_H2OO3, P_RAT_H2OO3_1,PMINORFRAC,KINDMINOR)  
+
+!     BAND 7:  980-1080 cm-1 (low - H2O,O3; high - O3)
+
+!     AUTHOR.
+!     -------
+!      JJMorcrette, ECMWF
+
+!     MODIFICATIONS.
+!     --------------
+!      M.Hamrud      01-Oct-2003 CY28 Cleaning
+!      NEC           25-Oct-2007 Optimisations
+!      JJMorcrette 20110613 flexible number of g-points
+!      ABozzo 201306 updated to rrtmg v4.85
+!     band 7:  980-1080 cm-1 (low key - h2o,o3; low minor - co2)
+!                            (high key - o3; high minor - co2)
+! ---------------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE PARRRTM  , ONLY : JPBAND
+USE YOERRTM  , ONLY : JPGPT  ,NG7   ,NGS6
+USE YOERRTWN , ONLY : NSPA   ,NSPB
+USE YOERRTA7 , ONLY : ABSA   ,ABSB   ,KA_MCO2,KB_MCO2 ,FRACREFA ,FRACREFB,SELFREF,FORREF
+USE YOERRTRF, ONLY : CHI_MLS
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ONEMINUS
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLO3(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCO2(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLDRY(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV) 
+
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_RAT_H2OO3(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_RAT_H2OO3_1(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)   :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFRAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)   :: PMINORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)   :: KINDMINOR(KIDIA:KFDIA,KLEV)
+
+
+! ---------------------------------------------------------------------------
+
+REAL(KIND=JPRB) :: Z_SPECCOMB(KLEV),Z_SPECCOMB1(KLEV), &
+& Z_SPECCOMB_MCO2(KLEV), Z_SPECCOMB_PLANCK(KLEV)
+INTEGER(KIND=JPIM) :: IND0(KLEV),IND1(KLEV),INDS(KLEV),INDF(KLEV),INDM(KLEV)
+
+INTEGER(KIND=JPIM) :: IG, JS, JLAY, JS1, JPL, JMCO2
+INTEGER(KIND=JPIM) :: JLON
+
+REAL(KIND=JPRB) :: ZREFRAT_PLANCK_A, ZREFRAT_M_A
+REAL(KIND=JPRB) :: ZCHI_CO2, ZRATCO2, ZADJFAC, ZADJCOLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ::  Z_FAC000, Z_FAC100, Z_FAC200,&
+ & Z_FAC010, Z_FAC110, Z_FAC210, &
+ & Z_FAC001, Z_FAC101, Z_FAC201, &
+ & Z_FAC011, Z_FAC111, Z_FAC211
+REAL(KIND=JPRB) :: ZP, ZP4, ZFK0, ZFK1, ZFK2
+REAL(KIND=JPRB) :: ZTAUFOR,ZTAUSELF,ZTAU_MAJOR,ZTAU_MAJOR1, ZCO2M1, ZCO2M2, ZABSCO2
+
+
+REAL(KIND=JPRB) :: Z_FS, Z_SPECMULT, Z_SPECPARM,  &
+& Z_FS1, Z_SPECMULT1, Z_SPECPARM1, &
+& Z_FPL, Z_SPECMULT_PLANCK, Z_SPECPARM_PLANCK, &
+& Z_FMCO2, Z_SPECMULT_MCO2, Z_SPECPARM_MCO2  
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL7',0,ZHOOK_HANDLE)
+
+! 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
+      Zrefrat_planck_a = chi_mls(1,3)/chi_mls(3,3)
+
+! P = 706.2720 mb
+      Zrefrat_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. 
+
+DO JLAY = 1, KLEV
+  DO JLON = KIDIA, KFDIA
+    IF (JLAY <= K_LAYTROP(JLON)) THEN
+      Z_SPECCOMB(JLAY) = P_COLH2O(JLON,JLAY) + P_RAT_H2OO3(JLON,JLAY)*P_COLO3(JLON,JLAY)
+      Z_SPECPARM = P_COLH2O(JLON,JLAY)/Z_SPECCOMB(JLAY)
+      Z_SPECPARM=MIN(P_ONEMINUS,Z_SPECPARM)
+      Z_SPECMULT = 8._JPRB*Z_SPECPARM
+      JS = 1 + INT(Z_SPECMULT)
+      Z_FS = MOD(Z_SPECMULT,1.0_JPRB)
+
+      Z_SPECCOMB1(JLAY) = P_COLH2O(JLON,JLAY) + P_RAT_H2OO3_1(JLON,JLAY)*P_COLO3(JLON,JLAY)
+      Z_SPECPARM1 = P_COLH2O(JLON,JLAY)/Z_SPECCOMB1(JLAY)
+      IF (Z_SPECPARM1 >= P_ONEMINUS) Z_SPECPARM1 = P_ONEMINUS
+      Z_SPECMULT1 = 8._JPRB*(Z_SPECPARM1)
+      JS1 = 1 + INT(Z_SPECMULT1)
+      Z_FS1 = MOD(Z_SPECMULT1,1.0_JPRB)
+
+      Z_SPECCOMB_MCO2(JLAY) = P_COLH2O(JLON,JLAY) + ZREFRAT_M_A*P_COLO3(JLON,JLAY)
+      Z_SPECPARM_MCO2 = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_MCO2(JLAY)
+      IF (Z_SPECPARM_MCO2 >= P_ONEMINUS) Z_SPECPARM_MCO2 = P_ONEMINUS
+      Z_SPECMULT_MCO2 = 8._JPRB*Z_SPECPARM_MCO2
+      JMCO2 = 1 + INT(Z_SPECMULT_MCO2)
+      Z_FMCO2 = MOD(Z_SPECMULT_MCO2,1.0_JPRB)
+
+! 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.
+      ZCHI_CO2 = P_COLCO2(JLON,JLAY)/P_COLDRY(JLON,JLAY)
+      ZRATCO2 = 1.E20_JPRB*ZCHI_CO2/CHI_MLS(2,K_JP(JLON,JLAY)+1)
+      IF (ZRATCO2 > 3.0_JPRB) THEN
+         ZADJFAC = 3.0_JPRB+(ZRATCO2-3.0_JPRB)**0.79_JPRB
+         ZADJCOLCO2(JLON,JLAY) = ZADJFAC*CHI_MLS(2,K_JP(JLON,JLAY)+1)*P_COLDRY(JLON,JLAY)*1.E-20_JPRB
+      ELSE
+         ZADJCOLCO2(JLON,JLAY) = P_COLCO2(JLON,JLAY)
+      ENDIF
+
+
+      Z_SPECCOMB_PLANCK(JLAY) = P_COLH2O(JLON,JLAY)+ZREFRAT_PLANCK_A*P_COLO3(JLON,JLAY)
+      Z_SPECPARM_PLANCK = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_PLANCK(JLAY)
+      IF (Z_SPECPARM_PLANCK >= P_ONEMINUS) Z_SPECPARM_PLANCK=P_ONEMINUS
+      Z_SPECMULT_PLANCK = 8._JPRB*Z_SPECPARM_PLANCK
+      JPL= 1 + INT(Z_SPECMULT_PLANCK)
+      Z_FPL = MOD(Z_SPECMULT_PLANCK,1.0_JPRB)
+
+      IND0(JLAY) = ((K_JP(JLON,JLAY)-1)*5+(K_JT(JLON,JLAY)-1))*NSPA(7) + JS
+      IND1(JLAY) = (K_JP(JLON,JLAY)*5+(K_JT1(JLON,JLAY)-1))*NSPA(7) + JS1
+      INDS(JLAY) = K_INDSELF(JLON,JLAY)
+      INDF(JLAY) = K_INDFOR(JLON,JLAY)
+      INDM(JLAY) = KINDMINOR(JLON,JLAY)
+
+  IF (Z_SPECPARM < 0.125_JPRB) THEN
+            ZP = Z_FS - 1
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC000 = ZFK0*P_FAC00(JLON,JLAY)
+            Z_FAC100 = ZFK1*P_FAC00(JLON,JLAY)
+            Z_FAC200 = ZFK2*P_FAC00(JLON,JLAY)
+            Z_FAC010 = ZFK0*P_FAC10(JLON,JLAY)
+            Z_FAC110 = ZFK1*P_FAC10(JLON,JLAY)
+            Z_FAC210 = ZFK2*P_FAC10(JLON,JLAY)
+      ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
+            ZP = -Z_FS 
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC000 = ZFK0*P_FAC00(JLON,JLAY)
+            Z_FAC100 = ZFK1*P_FAC00(JLON,JLAY)
+            Z_FAC200 = ZFK2*P_FAC00(JLON,JLAY)
+            Z_FAC010 = ZFK0*P_FAC10(JLON,JLAY)
+            Z_FAC110 = ZFK1*P_FAC10(JLON,JLAY)
+            Z_FAC210 = ZFK2*P_FAC10(JLON,JLAY)
+      ELSE
+            Z_FAC000 = (1._JPRB - Z_FS) * P_FAC00(JLON,JLAY)
+            Z_FAC010 = (1._JPRB - Z_FS) * P_FAC10(JLON,JLAY)
+            Z_FAC100 = Z_FS * P_FAC00(JLON,JLAY)
+            Z_FAC110 = Z_FS * P_FAC10(JLON,JLAY)
+      ENDIF
+      IF (Z_SPECPARM1 < 0.125_JPRB) THEN
+            ZP = Z_FS1 - 1
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC001 = ZFK0*P_FAC01(JLON,JLAY)
+            Z_FAC101 = ZFK1*P_FAC01(JLON,JLAY)
+            Z_FAC201 = ZFK2*P_FAC01(JLON,JLAY)
+            Z_FAC011 = ZFK0*P_FAC11(JLON,JLAY)
+            Z_FAC111 = ZFK1*P_FAC11(JLON,JLAY)
+            Z_FAC211 = ZFK2*P_FAC11(JLON,JLAY)
+      ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
+            ZP = -Z_FS1 
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC001 = ZFK0*P_FAC01(JLON,JLAY)
+            Z_FAC101 = ZFK1*P_FAC01(JLON,JLAY)
+            Z_FAC201 = ZFK2*P_FAC01(JLON,JLAY)
+            Z_FAC011 = ZFK0*P_FAC11(JLON,JLAY)
+            Z_FAC111 = ZFK1*P_FAC11(JLON,JLAY)
+            Z_FAC211 = ZFK2*P_FAC11(JLON,JLAY)
+      ELSE
+            Z_FAC001 = (1._JPRB - Z_FS1) * P_FAC01(JLON,JLAY)
+            Z_FAC011 = (1._JPRB - Z_FS1) * P_FAC11(JLON,JLAY)
+            Z_FAC101 = Z_FS1 * P_FAC01(JLON,JLAY)
+            Z_FAC111 = Z_FS1 * P_FAC11(JLON,JLAY)
+      ENDIF
+
+!-- DS_000515
+!CDIR UNROLL=NG7
+      DO IG = 1, NG7
+!-- DS_000515
+         ZTAUSELF = P_SELFFAC(JLON,JLAY)* (SELFREF(INDS(JLAY),IG) + P_SELFFRAC(JLON,JLAY) * &
+          &       (SELFREF(INDS(JLAY)+1,IG) - SELFREF(INDS(JLAY),IG)))
+         ZTAUFOR = P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + P_FORFRAC(JLON,JLAY) * &
+          &       (FORREF(INDF(JLAY)+1,IG) - FORREF(INDF(JLAY),IG))) 
+         ZCO2M1 = KA_MCO2(JMCO2,INDM(JLAY),IG) + Z_FMCO2 * &
+          &       (KA_MCO2(JMCO2+1,INDM(JLAY),IG) - KA_MCO2(JMCO2,INDM(JLAY),IG))
+         ZCO2M2 = KA_MCO2(JMCO2,INDM(JLAY)+1,IG) + Z_FMCO2 * &
+          &       (KA_MCO2(JMCO2+1,INDM(JLAY)+1,IG) - KA_MCO2(JMCO2,INDM(JLAY)+1,IG))
+         ZABSCO2 = ZCO2M1 + PMINORFRAC(JLON,JLAY) * (ZCO2M2 - ZCO2M1)
+
+            IF (Z_SPECPARM < 0.125_JPRB) THEN
+               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
+                 &   (Z_FAC000 * ABSA(IND0(JLAY),IG) + &
+                 &   Z_FAC100 * ABSA(IND0(JLAY)+1,IG) + &
+                 &   Z_FAC200 * ABSA(IND0(JLAY)+2,IG) + &
+                 &   Z_FAC010 * ABSA(IND0(JLAY)+9,IG) + &
+                 &   Z_FAC110 * ABSA(IND0(JLAY)+10,IG) + &
+                 &   Z_FAC210 * ABSA(IND0(JLAY)+11,IG))
+            ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
+               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
+                 &   (Z_FAC200 * ABSA(IND0(JLAY)-1,IG) + &
+                 &   Z_FAC100 * ABSA(IND0(JLAY),IG) + &
+                 &   Z_FAC000 * ABSA(IND0(JLAY)+1,IG) + &
+                 &   Z_FAC210 * ABSA(IND0(JLAY)+8,IG) + &
+                 &   Z_FAC110 * ABSA(IND0(JLAY)+9,IG) + &
+                 &   Z_FAC010 * ABSA(IND0(JLAY)+10,IG))
+            ELSE
+               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
+                 &   (Z_FAC000 * ABSA(IND0(JLAY),IG) + &
+                 &   Z_FAC100 * ABSA(IND0(JLAY)+1,IG) + &
+                 &   Z_FAC010 * ABSA(IND0(JLAY)+9,IG) + &
+                 &   Z_FAC110 * ABSA(IND0(JLAY)+10,IG))
+            ENDIF
+
+            IF (Z_SPECPARM1 < 0.125_JPRB) THEN
+               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
+                &    (Z_FAC001 * ABSA(IND1(JLAY),IG) + &
+                &    Z_FAC101 * ABSA(IND1(JLAY)+1,IG) + &
+                &    Z_FAC201 * ABSA(IND1(JLAY)+2,IG) + &
+                &    Z_FAC011 * ABSA(IND1(JLAY)+9,IG) + &
+                &    Z_FAC111 * ABSA(IND1(JLAY)+10,IG) + &
+                &    Z_FAC211 * ABSA(IND1(JLAY)+11,IG))
+            ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
+               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
+                &    (Z_FAC201 * ABSA(IND1(JLAY)-1,IG) + &
+                &    Z_FAC101 * ABSA(IND1(JLAY),IG) + &
+                &    Z_FAC001 * ABSA(IND1(JLAY)+1,IG) + &
+                &    Z_FAC211 * ABSA(IND1(JLAY)+8,IG) + &
+                &    Z_FAC111 * ABSA(IND1(JLAY)+9,IG) + &
+                &    Z_FAC011 * ABSA(IND1(JLAY)+10,IG))
+            ELSE
+               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
+                &    (Z_FAC001 * ABSA(IND1(JLAY),IG) +  &
+                &    Z_FAC101 * ABSA(IND1(JLAY)+1,IG) + &
+                &    Z_FAC011 * ABSA(IND1(JLAY)+9,IG) + &
+                &    Z_FAC111 * ABSA(IND1(JLAY)+10,IG))
+            ENDIF
+
+
+        P_TAU(JLON,NGS6+IG,JLAY) = ZTAU_MAJOR + ZTAU_MAJOR1 &
+               & + ZTAUSELF + ZTAUFOR &
+               & + ZADJCOLCO2(JLON,JLAY)*ZABSCO2 &
+               & + P_TAUAERL(JLON,JLAY,7)  
+        PFRAC(JLON,NGS6+IG,JLAY) = FRACREFA(IG,JPL) + Z_FPL *&
+         & (FRACREFA(IG,JPL+1) - FRACREFA(IG,JPL))  
+      ENDDO
+    ENDIF
+
+    IF (JLAY > K_LAYTROP(JLON)) THEN
+
+! In atmospheres where the amount of CO2 is too great to be considered
+! a minor species, adjust the column amount of CO2 by an empirical factor 
+! to obtain the proper contribution.
+      ZCHI_CO2 = P_COLCO2(JLON,JLAY)/P_COLDRY(JLON,JLAY)
+      ZRATCO2 = 1.E20_JPRB*ZCHI_CO2/CHI_MLS(2,K_JP(JLON,JLAY)+1)
+      IF (ZRATCO2 > 3.0_JPRB) THEN
+         ZADJFAC = 2.0_JPRB+(ZRATCO2-2.0_JPRB)**0.79_JPRB
+         ZADJCOLCO2(JLON,JLAY) = ZADJFAC*CHI_MLS(2,K_JP(JLON,JLAY)+1)*P_COLDRY(JLON,JLAY)*1.E-20_JPRB
+      ELSE
+         ZADJCOLCO2(JLON,JLAY) = P_COLCO2(JLON,JLAY)
+      ENDIF
+
+
+      IND0(JLAY) = ((K_JP(JLON,JLAY)-13)*5+(K_JT(JLON,JLAY)-1))*NSPB(7) + 1
+      IND1(JLAY) = ((K_JP(JLON,JLAY)-12)*5+(K_JT1(JLON,JLAY)-1))*NSPB(7) + 1
+      INDM(JLAY) = KINDMINOR(JLON,JLAY)
+!-- JJM_000517
+!CDIR UNROLL=NG7
+      DO IG = 1, NG7
+!-- JJM_000517
+        ZABSCO2 = KB_MCO2(INDM(JLAY),IG) + PMINORFRAC(JLON,JLAY) * &
+         &       (KB_MCO2(INDM(JLAY)+1,IG) - KB_MCO2(INDM(JLAY),IG))
+
+        P_TAU(JLON,NGS6+IG,JLAY) = P_COLO3(JLON,JLAY) *&
+         & (P_FAC00(JLON,JLAY) * ABSB(IND0(JLAY)  ,IG) +&
+         & P_FAC10(JLON,JLAY) * ABSB(IND0(JLAY)+1,IG) +&
+         & P_FAC01(JLON,JLAY) * ABSB(IND1(JLAY)  ,IG) +&
+         & P_FAC11(JLON,JLAY) * ABSB(IND1(JLAY)+1,IG))&
+         & + ZADJCOLCO2(JLON,JLAY) * ZABSCO2 &
+         & + P_TAUAERL(JLON,JLAY,7)  
+        PFRAC(JLON,NGS6+IG,JLAY) = 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.
+
+         P_TAU(JLON,ngs6+6,JLAY)=P_TAU(JLON,ngs6+6,JLAY)*0.92_JPRB
+         P_TAU(JLON,ngs6+7,JLAY)=P_TAU(JLON,ngs6+7,JLAY)*0.88_JPRB
+         P_TAU(JLON,ngs6+8,JLAY)=P_TAU(JLON,ngs6+8,JLAY)*1.07_JPRB
+         P_TAU(JLON,ngs6+9,JLAY)=P_TAU(JLON,ngs6+9,JLAY)*1.1_JPRB
+         P_TAU(JLON,ngs6+10,JLAY)=P_TAU(JLON,ngs6+10,JLAY)*0.99_JPRB
+         P_TAU(JLON,ngs6+11,JLAY)=P_TAU(JLON,ngs6+11,JLAY)*0.855_JPRB
+
+
+
+    ENDIF
+  ENDDO
+ENDDO
+
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL7',1,ZHOOK_HANDLE)
+
+END ASSOCIATE
+END SUBROUTINE RRTM_TAUMOL7
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol7.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol7.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol7.intfb.h	(revision 3908)
@@ -0,0 +1,39 @@
+INTERFACE
+SUBROUTINE RRTM_TAUMOL7 (KIDIA,KFDIA,KLEV,P_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLO3,P_COLCO2,P_COLDRY,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC,&
+ & P_RAT_H2OO3, P_RAT_H2OO3_1,PMINORFRAC,KINDMINOR) 
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+USE PARRRTM , ONLY : JPBAND
+USE YOERRTM , ONLY : JPGPT ,NG7 ,NGS6
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLO3(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLDRY(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_RAT_H2OO3(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_RAT_H2OO3_1(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PMINORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KINDMINOR(KIDIA:KFDIA,KLEV)
+END SUBROUTINE RRTM_TAUMOL7
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol8.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol8.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol8.F90	(revision 3908)
@@ -0,0 +1,190 @@
+!*******************************************************************************
+SUBROUTINE RRTM_TAUMOL8 (KIDIA,KFDIA,KLEV,P_TAU,P_WX,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,&
+ & P_COLH2O,P_COLO3,P_COLN2O,P_COLCO2,P_COLDRY,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC, &
+ & PMINORFRAC,KINDMINOR)  
+
+!     BAND 8:  1080-1180 cm-1 (low (i.e.>~300mb) - H2O; high - O3)
+
+!     AUTHOR.
+!     -------
+!      JJMorcrette, ECMWF
+
+!     MODIFICATIONS.
+!     --------------
+!      M.Hamrud      01-Oct-2003 CY28 Cleaning
+!      NEC           25-Oct-2007 Optimisations
+!      JJMorcrette 20110613 flexible number of g-points
+!      ABozzo 201306 updated to rrtmg v4.85
+!     band 8:  1080-1180 cm-1 (low key - h2o; low minor - co2,o3,n2o)
+!                             (high key - o3; high minor - co2, n2o)
+! ---------------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE PARRRTM  , ONLY : JPBAND ,JPXSEC
+USE YOERRTM  , ONLY : JPGPT  ,NG8   ,NGS7
+USE YOERRTWN , ONLY : NSPA   ,NSPB
+USE YOERRTA8 , ONLY : ABSA   ,ABSB   ,FRACREFA, FRACREFB,SELFREF,KA_MCO2 ,KB_MCO2  ,&
+ & KA_MN2O , KB_MN2O,KA_MO3,CFC12  ,CFC22ADJ,FORREF  
+USE YOERRTRF, ONLY : CHI_MLS
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_WX(KIDIA:KFDIA,JPXSEC,KLEV) ! Amount of trace gases
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLO3(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLN2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCO2(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLDRY(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV) 
+
+INTEGER(KIND=JPIM),INTENT(IN)   :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFRAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)   :: PMINORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)   :: KINDMINOR(KIDIA:KFDIA,KLEV)
+
+! ---------------------------------------------------------------------------
+
+INTEGER(KIND=JPIM) :: IND0(KLEV),IND1(KLEV),INDS(KLEV),INDF(KLEV),INDM(KLEV)
+
+INTEGER(KIND=JPIM) :: IG, JLAY
+INTEGER(KIND=JPIM) :: JLON
+
+REAL(KIND=JPRB) :: ZCHI_CO2, ZRATCO2, ZADJFAC, ZADJCOLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZTAUFOR,ZTAUSELF, ZABSO3, ZABSCO2, ZABSN2O
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+! 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.
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL8',0,ZHOOK_HANDLE)
+
+DO JLAY = 1, KLEV
+  DO JLON = KIDIA, KFDIA
+    IF (JLAY <= K_LAYTROP(JLON)) THEN
+! In atmospheres where the amount of CO2 is too great to be considered
+! a minor species, adjust the column amount of CO2 by an empirical factor 
+! to obtain the proper contribution.
+      ZCHI_CO2 = P_COLCO2(JLON,JLAY)/P_COLDRY(JLON,JLAY)
+      ZRATCO2 = 1.E20_JPRB*ZCHI_CO2/CHI_MLS(2,K_JP(JLON,JLAY)+1)
+      IF (ZRATCO2 > 3.0_JPRB) THEN
+         ZADJFAC = 2.0_JPRB+(ZRATCO2-2.0_JPRB)**0.65_JPRB
+         ZADJCOLCO2(JLON,JLAY) = ZADJFAC*CHI_MLS(2,K_JP(JLON,JLAY)+1)*P_COLDRY(JLON,JLAY)*1.E-20_JPRB
+      ELSE
+         ZADJCOLCO2(JLON,JLAY) = P_COLCO2(JLON,JLAY)
+      ENDIF
+
+    
+      IND0(JLAY) = ((K_JP(JLON,JLAY)-1)*5+(K_JT(JLON,JLAY)-1))*NSPA(8) + 1
+      IND1(JLAY) = (K_JP(JLON,JLAY)*5+(K_JT1(JLON,JLAY)-1))*NSPA(8) + 1
+      INDS(JLAY) = K_INDSELF(JLON,JLAY)
+      INDF(JLAY) = K_INDFOR(JLON,JLAY)
+      INDM(JLAY) = KINDMINOR(JLON,JLAY)
+      
+!-- DS_000515
+!CDIR UNROLL=NG8
+      DO IG = 1, NG8
+!-- DS_000515
+         ZTAUSELF = P_SELFFAC(JLON,JLAY)* (SELFREF(INDS(JLAY),IG) + P_SELFFRAC(JLON,JLAY) * &
+           &      (SELFREF(INDS(JLAY)+1,IG) - SELFREF(INDS(JLAY),IG)))
+         ZTAUFOR = P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + P_FORFRAC(JLON,JLAY) * &
+           &      (FORREF(INDF(JLAY)+1,IG) - FORREF(INDF(JLAY),IG))) 
+         ZABSCO2 =  (KA_MCO2(INDM(JLAY),IG) + PMINORFRAC(JLON,JLAY) * &
+           &      (KA_MCO2(INDM(JLAY)+1,IG) - KA_MCO2(INDM(JLAY),IG)))
+         ZABSO3 =  (KA_MO3(INDM(JLAY),IG) + PMINORFRAC(JLON,JLAY) * &
+           &      (KA_MO3(INDM(JLAY)+1,IG) - KA_MO3(INDM(JLAY),IG)))
+         ZABSN2O =  (KA_MN2O(INDM(JLAY),IG) + PMINORFRAC(JLON,JLAY) * &
+           &      (KA_MN2O(INDM(JLAY)+1,IG) - KA_MN2O(INDM(JLAY),IG)))
+
+        P_TAU(JLON,NGS7+IG,JLAY) = P_COLH2O(JLON,JLAY) *&
+         & (P_FAC00(JLON,JLAY) * ABSA(IND0(JLAY)  ,IG) +&
+         & P_FAC10(JLON,JLAY) * ABSA(IND0(JLAY)+1,IG) +&
+         & P_FAC01(JLON,JLAY) * ABSA(IND1(JLAY)  ,IG) +&
+         & P_FAC11(JLON,JLAY) * ABSA(IND1(JLAY)+1,IG)) &
+         & + ZTAUSELF + ZTAUFOR &
+         & + ZADJCOLCO2(JLON,JLAY)*ZABSCO2 &
+         & + P_COLO3(JLON,JLAY)*ZABSO3 &
+         & + P_COLN2O(JLON,JLAY)*ZABSN2O &
+         & + P_WX(JLON,3,JLAY) * CFC12(IG)&
+         & + P_WX(JLON,4,JLAY) * CFC22ADJ(IG)&
+         & + P_TAUAERL(JLON,JLAY,8)  
+        PFRAC(JLON,NGS7+IG,JLAY) = FRACREFA(IG)
+      ENDDO
+    ENDIF
+
+    IF (JLAY > K_LAYTROP(JLON)) THEN
+
+! In atmospheres where the amount of CO2 is too great to be considered
+! a minor species, adjust the column amount of CO2 by an empirical factor 
+! to obtain the proper contribution.
+      ZCHI_CO2 = P_COLCO2(JLON,JLAY)/P_COLDRY(JLON,JLAY)
+      ZRATCO2 = 1.E20_JPRB*ZCHI_CO2/CHI_MLS(2,K_JP(JLON,JLAY)+1)
+      IF (ZRATCO2 > 3.0_JPRB) THEN
+         ZADJFAC = 2.0_JPRB+(ZRATCO2-2.0_JPRB)**0.65_JPRB
+         ZADJCOLCO2(JLON,JLAY) = ZADJFAC*CHI_MLS(2,K_JP(JLON,JLAY)+1)*P_COLDRY(JLON,JLAY)*1.E-20_JPRB
+      ELSE
+         ZADJCOLCO2(JLON,JLAY) = P_COLCO2(JLON,JLAY)
+      ENDIF
+
+
+      IND0(JLAY) = ((K_JP(JLON,JLAY)-13)*5+(K_JT(JLON,JLAY)-1))*NSPB(8) + 1
+      IND1(JLAY) = ((K_JP(JLON,JLAY)-12)*5+(K_JT1(JLON,JLAY)-1))*NSPB(8) + 1
+      INDM(JLAY) = KINDMINOR(JLON,JLAY)
+!-- JJM_000517
+!CDIR UNROLL=NG8
+      DO IG = 1, NG8
+!-- JJM_000517
+        ZABSCO2 =  (KB_MCO2(INDM(JLAY),IG) + PMINORFRAC(JLON,JLAY) * &
+         &        (KB_MCO2(INDM(JLAY)+1,IG) - KB_MCO2(INDM(JLAY),IG)))
+        ZABSN2O =  (KB_MN2O(INDM(JLAY),IG) + PMINORFRAC(JLON,JLAY) * &
+         &        (KB_MN2O(INDM(JLAY)+1,IG) - KB_MN2O(INDM(JLAY),IG)))
+        P_TAU(JLON,NGS7+IG,JLAY) = P_COLO3(JLON,JLAY) *&
+         & (P_FAC00(JLON,JLAY) * ABSB(IND0(JLAY)  ,IG) +&
+         & P_FAC10(JLON,JLAY) * ABSB(IND0(JLAY)+1,IG) +&
+         & P_FAC01(JLON,JLAY) * ABSB(IND1(JLAY)  ,IG) +&
+         & P_FAC11(JLON,JLAY) * ABSB(IND1(JLAY)+1,IG)) &
+         & + ZADJCOLCO2(JLON,JLAY)*ZABSCO2 &
+         & + P_COLN2O(JLON,JLAY)*ZABSN2O &
+         & + P_WX(JLON,3,JLAY) * CFC12(IG)&
+         & + P_WX(JLON,4,JLAY) * CFC22ADJ(IG)&
+         & + P_TAUAERL(JLON,JLAY,8)  
+        PFRAC(JLON,NGS7+IG,JLAY) = FRACREFB(IG)
+      ENDDO
+    ENDIF
+  ENDDO
+ENDDO
+
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL8',1,ZHOOK_HANDLE)
+
+END ASSOCIATE
+END SUBROUTINE RRTM_TAUMOL8
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol8.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol8.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol8.intfb.h	(revision 3908)
@@ -0,0 +1,38 @@
+INTERFACE
+SUBROUTINE RRTM_TAUMOL8 (KIDIA,KFDIA,KLEV,P_TAU,P_WX,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,&
+ & P_COLH2O,P_COLO3,P_COLN2O,P_COLCO2,P_COLDRY,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC,&
+ & PMINORFRAC,KINDMINOR) 
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+USE PARRRTM , ONLY : JPBAND ,JPXSEC
+USE YOERRTM , ONLY : JPGPT ,NG8 ,NGS7
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_WX(KIDIA:KFDIA,JPXSEC,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLO3(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLN2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLDRY(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PMINORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KINDMINOR(KIDIA:KFDIA,KLEV)
+END SUBROUTINE RRTM_TAUMOL8
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol9.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol9.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol9.F90	(revision 3908)
@@ -0,0 +1,341 @@
+!----------------------------------------------------------------------------
+SUBROUTINE RRTM_TAUMOL9 (KIDIA,KFDIA,KLEV,P_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLN2O,P_COLCH4,P_COLDRY,K_LAYTROP,K_LAYSWTCH,K_LAYLOW,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC, &
+ & PRAT_H2OCH4,PRAT_H2OCH4_1,PMINORFRAC,KINDMINOR)  
+
+!     BAND 9:  1180-1390 cm-1 (low - H2O,CH4; high - CH4)
+
+!     AUTHOR.
+!     -------
+!      JJMorcrette, ECMWF
+
+!     MODIFICATIONS.
+!     --------------
+!      M.Hamrud      01-Oct-2003 CY28 Cleaning
+!      NEC           25-Oct-2007 Optimisations
+!      JJMorcrette 20110613 flexible number of g-points
+!      201306 ABozzo updated to rrtmg v4.85
+!     band 9:  1180-1390 cm-1 (low key - h2o,ch4; low minor - n2o)
+!                             (high key - ch4; high minor - n2o)
+! ---------------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE PARRRTM  , ONLY : JPBAND
+USE YOERRTM  , ONLY : JPGPT  ,NG9   ,NGS8
+USE YOERRTWN , ONLY :      NSPA   ,NSPB
+USE YOERRTA9 , ONLY : ABSA   ,ABSB   ,FRACREFA, FRACREFB,SELFREF,FORREF,KA_MN2O, KB_MN2O   
+USE YOERRTRF, ONLY : CHI_MLS
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ONEMINUS
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLN2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCH4(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLDRY(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYSWTCH(KIDIA:KFDIA) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYLOW(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV) 
+
+REAL(KIND=JPRB)   ,INTENT(IN)   :: PRAT_H2OCH4(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)   :: PRAT_H2OCH4_1(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)   :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFRAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)   :: PMINORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)   :: KINDMINOR(KIDIA:KFDIA,KLEV)
+
+
+! ---------------------------------------------------------------------------
+
+INTEGER(KIND=JPIM) :: IND0(KLEV),IND1(KLEV),INDS(KLEV),INDF(KLEV),INDM(KLEV)
+INTEGER(KIND=JPIM) :: IG, JS, JLAY, JS1, JMN2O, JPL
+INTEGER(KIND=JPIM) :: JLON
+
+REAL(KIND=JPRB) :: Z_SPECCOMB(KLEV),Z_SPECCOMB1(KLEV),Z_SPECCOMB_MN2O(KLEV), &
+& Z_SPECCOMB_PLANCK(KLEV)
+REAL(KIND=JPRB) :: ZREFRAT_PLANCK_A, ZREFRAT_M_A
+
+REAL(KIND=JPRB) :: Z_FS, Z_SPECMULT, Z_SPECPARM,  &
+ & Z_FS1, Z_SPECMULT1, Z_SPECPARM1,   &
+ & Z_FMN2O, Z_SPECMULT_MN2O, Z_SPECPARM_MN2O,   &
+ & Z_FPL, Z_SPECMULT_PLANCK, Z_SPECPARM_PLANCK
+
+REAL(KIND=JPRB) :: ZADJFAC,ZADJCOLN2O(KIDIA:KFDIA,KLEV),ZRATN2O,ZCHI_N2O
+REAL(KIND=JPRB) ::  Z_FAC000, Z_FAC100, Z_FAC200,&
+ & Z_FAC010, Z_FAC110, Z_FAC210, &
+ & Z_FAC001, Z_FAC101, Z_FAC201, &
+ & Z_FAC011, Z_FAC111, Z_FAC211
+REAL(KIND=JPRB) :: ZP, ZP4, ZFK0, ZFK1, ZFK2
+REAL(KIND=JPRB) :: ZTAUFOR,ZTAUSELF,ZN2OM1,ZN2OM2,ZABSN2O,ZTAU_MAJOR,ZTAU_MAJOR1
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL9',0,ZHOOK_HANDLE)
+
+! 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
+      ZREFRAT_PLANCK_A = CHI_MLS(1,9)/CHI_MLS(6,9)
+
+! P = 706.272 mb 
+      ZREFRAT_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.  
+
+DO JLAY = 1, KLEV
+  DO JLON = KIDIA, KFDIA
+
+    IF (JLAY <= K_LAYTROP(JLON)) THEN
+      Z_SPECCOMB(JLAY) = P_COLH2O(JLON,JLAY) + PRAT_H2OCH4(JLON,JLAY)*P_COLCH4(JLON,JLAY)
+      Z_SPECPARM = P_COLH2O(JLON,JLAY)/Z_SPECCOMB(JLAY)
+      Z_SPECPARM=MIN(P_ONEMINUS,Z_SPECPARM)
+      Z_SPECMULT = 8._JPRB*(Z_SPECPARM)
+      JS = 1 + INT(Z_SPECMULT)
+      Z_FS = MOD(Z_SPECMULT,1.0_JPRB)
+
+      Z_SPECCOMB1(JLAY) = P_COLH2O(JLON,JLAY) + PRAT_H2OCH4_1(JLON,JLAY)*P_COLCH4(JLON,JLAY)
+      Z_SPECPARM1 = P_COLH2O(JLON,JLAY)/Z_SPECCOMB1(JLAY)
+      IF (Z_SPECPARM1 >= P_ONEMINUS) Z_SPECPARM1 = P_ONEMINUS
+      Z_SPECMULT1 = 8._JPRB*(Z_SPECPARM1)
+      JS1 = 1 + INT(Z_SPECMULT1)
+      Z_FS1 = MOD(Z_SPECMULT1,1.0_JPRB)
+
+      Z_SPECCOMB_MN2O(JLAY) = P_COLH2O(JLON,JLAY) + ZREFRAT_M_A*P_COLCH4(JLON,JLAY)
+      Z_SPECPARM_MN2O = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_MN2O(JLAY)
+      IF (Z_SPECPARM_MN2O >= P_ONEMINUS) Z_SPECPARM_MN2O = P_ONEMINUS
+      Z_SPECMULT_MN2O = 8._JPRB*Z_SPECPARM_MN2O
+      JMN2O = 1 + INT(Z_SPECMULT_MN2O)
+      Z_FMN2O = MOD(Z_SPECMULT_MN2O,1.0_JPRB)
+!  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.
+      ZCHI_N2O = P_COLN2O(JLON,JLAY)/P_COLDRY(JLON,JLAY)
+      ZRATN2O = 1.E20_JPRB*ZCHI_N2O/CHI_MLS(4,K_JP(JLON,JLAY)+1)
+      IF (ZRATN2O > 1.5_JPRB) THEN
+         ZADJFAC = 0.5_JPRB+(ZRATN2O-0.5_JPRB)**0.65_JPRB
+         ZADJCOLN2O(JLON,JLAY) = ZADJFAC*CHI_MLS(4,K_JP(JLON,JLAY)+1)*P_COLDRY(JLON,JLAY)*1.E-20_JPRB
+      ELSE
+         ZADJCOLN2O(JLON,JLAY) = P_COLN2O(JLON,JLAY)
+      ENDIF
+
+      Z_SPECCOMB_PLANCK(JLAY) = P_COLH2O(JLON,JLAY)+ZREFRAT_PLANCK_A*P_COLCH4(JLON,JLAY)
+      Z_SPECPARM_PLANCK = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_PLANCK(JLAY)
+      IF (Z_SPECPARM_PLANCK >= P_ONEMINUS) Z_SPECPARM_PLANCK=P_ONEMINUS
+      Z_SPECMULT_PLANCK = 8._JPRB*Z_SPECPARM_PLANCK
+      JPL= 1 + INT(Z_SPECMULT_PLANCK)
+      Z_FPL = MOD(Z_SPECMULT_PLANCK,1.0_JPRB)
+
+
+      IND0(JLAY) = ((K_JP(JLON,JLAY)-1)*5+(K_JT(JLON,JLAY)-1))*NSPA(9) + JS
+      IND1(JLAY) = (K_JP(JLON,JLAY)*5+(K_JT1(JLON,JLAY)-1))*NSPA(9) + JS1
+      INDS(JLAY) = K_INDSELF(JLON,JLAY)
+      INDF(JLAY) = K_INDFOR(JLON,JLAY)
+      INDM(JLAY) = KINDMINOR(JLON,JLAY)
+
+         IF (Z_SPECPARM < 0.125_JPRB) THEN
+            ZP = Z_FS - 1
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC000 = ZFK0*P_FAC00(JLON,JLAY)
+            Z_FAC100 = ZFK1*P_FAC00(JLON,JLAY)
+            Z_FAC200 = ZFK2*P_FAC00(JLON,JLAY)
+            Z_FAC010 = ZFK0*P_FAC10(JLON,JLAY)
+            Z_FAC110 = ZFK1*P_FAC10(JLON,JLAY)
+            Z_FAC210 = ZFK2*P_FAC10(JLON,JLAY)
+         ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
+            ZP = -Z_FS 
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC000 = ZFK0*P_FAC00(JLON,JLAY)
+            Z_FAC100 = ZFK1*P_FAC00(JLON,JLAY)
+            Z_FAC200 = ZFK2*P_FAC00(JLON,JLAY)
+            Z_FAC010 = ZFK0*P_FAC10(JLON,JLAY)
+            Z_FAC110 = ZFK1*P_FAC10(JLON,JLAY)
+            Z_FAC210 = ZFK2*P_FAC10(JLON,JLAY)
+         ELSE
+            Z_FAC000 = (1._JPRB - Z_FS) * P_FAC00(JLON,JLAY)
+            Z_FAC010 = (1._JPRB - Z_FS) * P_FAC10(JLON,JLAY)
+            Z_FAC100 = Z_FS * P_FAC00(JLON,JLAY)
+            Z_FAC110 = Z_FS * P_FAC10(JLON,JLAY)
+         ENDIF
+         IF (Z_SPECPARM1 < 0.125_JPRB) THEN
+            ZP = Z_FS1 - 1
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC001 = ZFK0*P_FAC01(JLON,JLAY)
+            Z_FAC101 = ZFK1*P_FAC01(JLON,JLAY)
+            Z_FAC201 = ZFK2*P_FAC01(JLON,JLAY)
+            Z_FAC011 = ZFK0*P_FAC11(JLON,JLAY)
+            Z_FAC111 = ZFK1*P_FAC11(JLON,JLAY)
+            Z_FAC211 = ZFK2*P_FAC11(JLON,JLAY)
+         ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
+            ZP = -Z_FS1 
+            ZP4 = ZP**4
+            ZFK0 = ZP4
+            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
+            ZFK2 = ZP + ZP4
+            Z_FAC001 = ZFK0*P_FAC01(JLON,JLAY)
+            Z_FAC101 = ZFK1*P_FAC01(JLON,JLAY)
+            Z_FAC201 = ZFK2*P_FAC01(JLON,JLAY)
+            Z_FAC011 = ZFK0*P_FAC11(JLON,JLAY)
+            Z_FAC111 = ZFK1*P_FAC11(JLON,JLAY)
+            Z_FAC211 = ZFK2*P_FAC11(JLON,JLAY)
+         ELSE
+            Z_FAC001 = (1._JPRB - Z_FS1) * P_FAC01(JLON,JLAY)
+            Z_FAC011 = (1._JPRB - Z_FS1) * P_FAC11(JLON,JLAY)
+            Z_FAC101 = Z_FS1 * P_FAC01(JLON,JLAY)
+            Z_FAC111 = Z_FS1 * P_FAC11(JLON,JLAY)
+         ENDIF
+
+
+
+!-- DS_000515
+!CDIR UNROLL=NG9
+      DO IG = 1, NG9
+!-- DS_000515
+        ZTAUSELF = P_SELFFAC(JLON,JLAY)* (SELFREF(INDS(JLAY),IG) + P_SELFFRAC(JLON,JLAY) * &
+          &      (SELFREF(INDS(JLAY)+1,IG) - SELFREF(INDS(JLAY),IG)))
+        ZTAUFOR = P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + P_FORFRAC(JLON,JLAY) * &
+          &      (FORREF(INDF(JLAY)+1,IG) - FORREF(INDF(JLAY),IG))) 
+        ZN2OM1 = KA_MN2O(JMN2O,INDM(JLAY),IG) + Z_FMN2O * &
+          &      (KA_MN2O(JMN2O+1,INDM(JLAY),IG) - KA_MN2O(JMN2O,INDM(JLAY),IG))
+        ZN2OM2 = KA_MN2O(JMN2O,INDM(JLAY)+1,IG) + Z_FMN2O * &
+          &      (KA_MN2O(JMN2O+1,INDM(JLAY)+1,IG) - KA_MN2O(JMN2O,INDM(JLAY)+1,IG))
+        ZABSN2O = ZN2OM1 + PMINORFRAC(JLON,JLAY) * (ZN2OM2 - ZN2OM1)
+
+   IF (Z_SPECPARM < 0.125_JPRB) THEN
+               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
+                 &  (Z_FAC000 * ABSA(IND0(JLAY),IG) + &
+                 &  Z_FAC100 * ABSA(IND0(JLAY)+1,IG) + &
+                 &  Z_FAC200 * ABSA(IND0(JLAY)+2,IG) + &
+                 &  Z_FAC010 * ABSA(IND0(JLAY)+9,IG) + &
+                 &  Z_FAC110 * ABSA(IND0(JLAY)+10,IG) + &
+                 &  Z_FAC210 * ABSA(IND0(JLAY)+11,IG))
+            ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
+               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
+                 &  (Z_FAC200 * ABSA(IND0(JLAY)-1,IG) + &
+                 &  Z_FAC100 * ABSA(IND0(JLAY),IG) + &
+                 &  Z_FAC000 * ABSA(IND0(JLAY)+1,IG) + &
+                 &  Z_FAC210 * ABSA(IND0(JLAY)+8,IG) + &
+                 &  Z_FAC110 * ABSA(IND0(JLAY)+9,IG) + &
+                 &  Z_FAC010 * ABSA(IND0(JLAY)+10,IG))
+            ELSE
+               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
+                 &  (Z_FAC000 * ABSA(IND0(JLAY),IG) + &
+                 &  Z_FAC100 * ABSA(IND0(JLAY)+1,IG) + &
+                 &  Z_FAC010 * ABSA(IND0(JLAY)+9,IG) + &
+                 &  Z_FAC110 * ABSA(IND0(JLAY)+10,IG))
+            ENDIF
+
+            IF (Z_SPECPARM1 < 0.125_JPRB) THEN
+               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
+                 &  (Z_FAC001 * ABSA(IND1(JLAY),IG) + &
+                 &  Z_FAC101 * ABSA(IND1(JLAY)+1,IG) + &
+                 &  Z_FAC201 * ABSA(IND1(JLAY)+2,IG) + &
+                 &  Z_FAC011 * ABSA(IND1(JLAY)+9,IG) + &
+                 &  Z_FAC111 * ABSA(IND1(JLAY)+10,IG) + &
+                 &  Z_FAC211 * ABSA(IND1(JLAY)+11,IG))
+            ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
+               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
+                 &  (Z_FAC201 * ABSA(IND1(JLAY)-1,IG) + &
+                 &  Z_FAC101 * ABSA(IND1(JLAY),IG) + &
+                 &  Z_FAC001 * ABSA(IND1(JLAY)+1,IG) + &
+                 &  Z_FAC211 * ABSA(IND1(JLAY)+8,IG) + &
+                 &  Z_FAC111 * ABSA(IND1(JLAY)+9,IG) + &
+                 &  Z_FAC011 * ABSA(IND1(JLAY)+10,IG))
+            ELSE
+               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
+                 &  (Z_FAC001 * ABSA(IND1(JLAY),IG) +  &
+                 &  Z_FAC101 * ABSA(IND1(JLAY)+1,IG) + &
+                 &  Z_FAC011 * ABSA(IND1(JLAY)+9,IG) + &
+                 &  Z_FAC111 * ABSA(IND1(JLAY)+10,IG))
+            ENDIF
+
+
+        P_TAU(JLON,NGS8+IG,JLAY) = ZTAU_MAJOR + ZTAU_MAJOR1 &
+         &       + ZTAUSELF + ZTAUFOR &
+         &       + ZADJCOLN2O(JLON,JLAY)*ZABSN2O &
+         & + P_TAUAERL(JLON,JLAY,9)  
+        PFRAC(JLON,NGS8+IG,JLAY) = FRACREFA(IG,JPL) + Z_FPL *&
+         & (FRACREFA(IG,JPL+1) - FRACREFA(IG,JPL)) 
+      ENDDO
+    ENDIF
+
+    IF (JLAY > K_LAYTROP(JLON)) THEN
+
+!  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.
+      ZCHI_N2O = P_COLN2O(JLON,JLAY)/P_COLDRY(JLON,JLAY)
+      ZRATN2O = 1.E20_JPRB*ZCHI_N2O/CHI_MLS(4,K_JP(JLON,JLAY)+1)
+      IF (ZRATN2O > 1.5_JPRB) THEN
+         ZADJFAC = 0.5_JPRB+(ZRATN2O-0.5_JPRB)**0.65_JPRB
+         ZADJCOLN2O(JLON,JLAY) = ZADJFAC*CHI_MLS(4,K_JP(JLON,JLAY)+1)*P_COLDRY(JLON,JLAY)*1.E-20_JPRB
+      ELSE
+         ZADJCOLN2O(JLON,JLAY) = P_COLN2O(JLON,JLAY)
+      ENDIF
+
+      IND0(JLAY) = ((K_JP(JLON,JLAY)-13)*5+(K_JT(JLON,JLAY)-1))*NSPB(9) + 1
+      IND1(JLAY) = ((K_JP(JLON,JLAY)-12)*5+(K_JT1(JLON,JLAY)-1))*NSPB(9) + 1
+      INDM(JLAY) = KINDMINOR(JLON,JLAY)
+
+
+!-- JJM_000517
+!CDIR UNROLL=NG9
+      DO IG = 1, NG9
+        ZABSN2O = KB_MN2O(INDM(JLAY),IG) + PMINORFRAC(JLON,JLAY) * &
+         &       (KB_MN2O(INDM(JLAY)+1,IG) - KB_MN2O(INDM(JLAY),IG))
+
+!-- JJM_000517
+        P_TAU(JLON,NGS8+IG,JLAY) = P_COLCH4(JLON,JLAY) *&
+         & (P_FAC00(JLON,JLAY) * ABSB(IND0(JLAY)  ,IG) +&
+         & P_FAC10(JLON,JLAY) * ABSB(IND0(JLAY)+1,IG) +&
+         & P_FAC01(JLON,JLAY) * ABSB(IND1(JLAY)  ,IG) +&
+         & P_FAC11(JLON,JLAY) * ABSB(IND1(JLAY)+1,IG))&
+         & + ZADJCOLN2O(JLON,JLAY)*ZABSN2O &
+         & + P_TAUAERL(JLON,JLAY,9)  
+        PFRAC(JLON,NGS8+IG,JLAY) = FRACREFB(IG)
+      ENDDO
+    ENDIF
+  ENDDO
+ENDDO
+
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL9',1,ZHOOK_HANDLE)
+
+END ASSOCIATE
+END SUBROUTINE RRTM_TAUMOL9
Index: LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol9.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol9.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/rrtm_taumol9.intfb.h	(revision 3908)
@@ -0,0 +1,41 @@
+INTERFACE
+SUBROUTINE RRTM_TAUMOL9 (KIDIA,KFDIA,KLEV,P_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLN2O,P_COLCH4,P_COLDRY,K_LAYTROP,K_LAYSWTCH,K_LAYLOW,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC,&
+ & PRAT_H2OCH4,PRAT_H2OCH4_1,PMINORFRAC,KINDMINOR) 
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+USE PARRRTM , ONLY : JPBAND
+USE YOERRTM , ONLY : JPGPT ,NG9 ,NGS8
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLN2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCH4(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLDRY(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYSWTCH(KIDIA:KFDIA)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYLOW(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRAT_H2OCH4(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRAT_H2OCH4_1(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PMINORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KINDMINOR(KIDIA:KFDIA,KLEV)
+END SUBROUTINE RRTM_TAUMOL9
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb16.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb16.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb16.F90	(revision 3908)
@@ -0,0 +1,105 @@
+SUBROUTINE SRTM_CMBGB16
+
+
+!  Original version:       Michael J. Iacono; July, 1998
+!  Revision for RRTM_SW:   Michael J. Iacono; November, 2002
+!  Revision for RRTMG_SW:  Michael J. Iacono; December, 2003
+
+!  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 PARKIND1  ,ONLY : JPIM , JPRB
+USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK
+
+USE YOESRTM  , ONLY : NGN
+USE YOESRTWN , ONLY : NGC, RWGT
+!USE YOESRTWN , ONLY : NGC, NGN, RWGT
+USE YOESRTA16, ONLY : KA, KB, SELFREF, FORREF, SFLUXREF, &
+                    & KAC, KBC, SELFREFC, FORREFC, SFLUXREFC
+
+IMPLICIT NONE
+
+! Local variables
+INTEGER(KIND=JPIM) :: JN, JT, JP, IGC, IPR, IPRSM
+REAL(KIND=JPRB)    :: ZSUMK, ZSUMF
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!     ------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB16',0,ZHOOK_HANDLE)
+
+DO JN = 1,9
+  DO JT = 1,5
+    DO JP = 1,13
+      IPRSM = 0
+      DO IGC = 1,NGC(1)
+        ZSUMK = 0.
+        DO IPR = 1, NGN(IGC)
+          IPRSM = IPRSM + 1
+          ZSUMK = ZSUMK + KA(JN,JT,JP,IPRSM)*RWGT(IPRSM)
+        ENDDO
+        KAC(JN,JT,JP,IGC) = ZSUMK
+      ENDDO
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JT = 1,5
+  DO JP = 13,59
+    IPRSM = 0
+    DO IGC = 1,NGC(1)
+      ZSUMK = 0.
+      DO IPR = 1, NGN(IGC)
+        IPRSM = IPRSM + 1
+        ZSUMK = ZSUMK + KB(JT,JP,IPRSM)*RWGT(IPRSM)
+      ENDDO
+      KBC(JT,JP,IGC) = ZSUMK
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JT = 1,10
+  IPRSM = 0
+  DO IGC = 1,NGC(1)
+    ZSUMK = 0.
+    DO IPR = 1, NGN(IGC)
+      IPRSM = IPRSM + 1
+      ZSUMK = ZSUMK + SELFREF(JT,IPRSM)*RWGT(IPRSM)
+    ENDDO
+    SELFREFC(JT,IGC) = ZSUMK
+  ENDDO
+ENDDO
+
+DO JT = 1,3
+  IPRSM = 0
+  DO IGC = 1,NGC(1)
+    ZSUMK = 0.
+    DO IPR = 1, NGN(IGC)
+      IPRSM = IPRSM + 1
+      ZSUMK = ZSUMK + FORREF(JT,IPRSM)*RWGT(IPRSM)
+    ENDDO
+    FORREFC(JT,IGC) = ZSUMK
+  ENDDO
+ENDDO
+
+IPRSM = 0
+DO IGC = 1,NGC(1)
+  ZSUMF = 0.
+  DO IPR = 1, NGN(IGC)
+    IPRSM = IPRSM + 1
+    ZSUMF = ZSUMF + SFLUXREF(IPRSM)
+  ENDDO
+  SFLUXREFC(IGC) = ZSUMF
+ENDDO
+
+!     -----------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB16',1,ZHOOK_HANDLE)
+END SUBROUTINE SRTM_CMBGB16
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb16.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb16.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb16.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SRTM_CMBGB16
+END SUBROUTINE SRTM_CMBGB16
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb17.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb17.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb17.F90	(revision 3908)
@@ -0,0 +1,96 @@
+SUBROUTINE SRTM_CMBGB17
+
+!     BAND 17:  3250-4000 cm-1 (low - H2O,CO2; high - H2O,CO2)
+!-----------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM , JPRB
+USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK
+
+USE YOESRTM  , ONLY : NGN
+USE YOESRTWN , ONLY : NGC, NGS, RWGT
+!USE YOESRTWN , ONLY : NGC, NGS, NGN, RWGT
+USE YOESRTA17, ONLY : KA, KB, SELFREF, FORREF, SFLUXREF, &
+                    & KAC, KBC, SELFREFC, FORREFC, SFLUXREFC
+
+IMPLICIT NONE
+
+! Local variables
+INTEGER(KIND=JPIM) :: JN, JT, JP, IGC, IPR, IPRSM
+REAL(KIND=JPRB)    :: ZSUMK, ZSUMF
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!     ------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB17',0,ZHOOK_HANDLE)
+
+DO JN = 1,9
+  DO JT = 1,5
+    DO JP = 1,13
+      IPRSM = 0
+      DO IGC = 1,NGC(2)
+        ZSUMK = 0.
+        DO IPR = 1, NGN(NGS(1)+IGC)
+          IPRSM = IPRSM + 1
+          ZSUMK = ZSUMK + KA(JN,JT,JP,IPRSM)*RWGT(IPRSM+16)
+        ENDDO
+        KAC(JN,JT,JP,IGC) = ZSUMK
+      ENDDO
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JN = 1,5
+  DO JT = 1,5
+    DO JP = 13,59
+      IPRSM = 0
+      DO IGC = 1,NGC(2)
+        ZSUMK = 0.
+        DO IPR = 1, NGN(NGS(1)+IGC)
+          IPRSM = IPRSM + 1
+          ZSUMK = ZSUMK + KB(JN,JT,JP,IPRSM)*RWGT(IPRSM+16)
+        ENDDO
+        KBC(JN,JT,JP,IGC) = ZSUMK
+      ENDDO
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JT = 1,10
+  IPRSM = 0
+  DO IGC = 1,NGC(2)
+    ZSUMK = 0.
+    DO IPR = 1, NGN(NGS(1)+IGC)
+      IPRSM = IPRSM + 1
+      ZSUMK = ZSUMK + SELFREF(JT,IPRSM)*RWGT(IPRSM+16)
+    ENDDO
+    SELFREFC(JT,IGC) = ZSUMK
+  ENDDO
+ENDDO
+
+DO JT = 1,4
+  IPRSM = 0
+  DO IGC = 1,NGC(2)
+    ZSUMK = 0.
+    DO IPR = 1, NGN(NGS(1)+IGC)
+      IPRSM = IPRSM + 1
+      ZSUMK = ZSUMK + FORREF(JT,IPRSM)*RWGT(IPRSM+16)
+    ENDDO
+    FORREFC(JT,IGC) = ZSUMK
+  ENDDO
+ENDDO
+
+DO JP = 1,5
+  IPRSM = 0
+  DO IGC = 1,NGC(2)
+    ZSUMF = 0.
+    DO IPR = 1, NGN(NGS(1)+IGC)
+      IPRSM = IPRSM + 1
+      ZSUMF = ZSUMF + SFLUXREF(IPRSM,JP)
+    ENDDO
+    SFLUXREFC(IGC,JP) = ZSUMF
+  ENDDO
+ENDDO
+
+!     -----------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB17',1,ZHOOK_HANDLE)
+END SUBROUTINE SRTM_CMBGB17
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb17.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb17.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb17.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SRTM_CMBGB17
+END SUBROUTINE SRTM_CMBGB17
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb18.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb18.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb18.F90	(revision 3908)
@@ -0,0 +1,94 @@
+SUBROUTINE SRTM_CMBGB18
+
+!     BAND 18:  4000-4650 cm-1 (low - H2O,CH4; high - CH4)
+!-----------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM , JPRB
+USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK
+
+USE YOESRTM  , ONLY : NGN
+USE YOESRTWN , ONLY : NGC, NGS, RWGT
+!USE YOESRTWN , ONLY : NGC, NGS, NGN, RWGT
+USE YOESRTA18, ONLY : KA, KB, SELFREF, FORREF, SFLUXREF, &
+                    & KAC, KBC, SELFREFC, FORREFC, SFLUXREFC
+
+IMPLICIT NONE
+
+! Local variables
+INTEGER(KIND=JPIM) :: JN, JT, JP, IGC, IPR, IPRSM
+REAL(KIND=JPRB)    :: ZSUMK, ZSUMF
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!     ------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB18',0,ZHOOK_HANDLE)
+
+DO JN = 1,9
+  DO JT = 1,5
+    DO JP = 1,13
+      IPRSM = 0
+      DO IGC = 1,NGC(3)
+        ZSUMK = 0.
+        DO IPR = 1, NGN(NGS(2)+IGC)
+          IPRSM = IPRSM + 1
+          ZSUMK = ZSUMK + KA(JN,JT,JP,IPRSM)*RWGT(IPRSM+32)
+        ENDDO
+        KAC(JN,JT,JP,IGC) = ZSUMK
+      ENDDO
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JT = 1,5
+  DO JP = 13,59
+    IPRSM = 0
+    DO IGC = 1,NGC(3)
+      ZSUMK = 0.
+      DO IPR = 1, NGN(NGS(2)+IGC)
+        IPRSM = IPRSM + 1
+        ZSUMK = ZSUMK + KB(JT,JP,IPRSM)*RWGT(IPRSM+32)
+      ENDDO
+      KBC(JT,JP,IGC) = ZSUMK
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JT = 1,10
+  IPRSM = 0
+  DO IGC = 1,NGC(3)
+    ZSUMK = 0.
+    DO IPR = 1, NGN(NGS(2)+IGC)
+      IPRSM = IPRSM + 1
+      ZSUMK = ZSUMK + SELFREF(JT,IPRSM)*RWGT(IPRSM+32)
+    ENDDO
+    SELFREFC(JT,IGC) = ZSUMK
+  ENDDO
+ENDDO
+
+DO JT = 1,3
+  IPRSM = 0
+  DO IGC = 1,NGC(3)
+    ZSUMK = 0.
+    DO IPR = 1, NGN(NGS(2)+IGC)
+      IPRSM = IPRSM + 1
+      ZSUMK = ZSUMK + FORREF(JT,IPRSM)*RWGT(IPRSM+32)
+    ENDDO
+    FORREFC(JT,IGC) = ZSUMK
+  ENDDO
+ENDDO
+
+DO JP = 1,9
+  IPRSM = 0
+  DO IGC = 1,NGC(3)
+    ZSUMF = 0.
+    DO IPR = 1, NGN(NGS(2)+IGC)
+      IPRSM = IPRSM + 1
+      ZSUMF = ZSUMF + SFLUXREF(IPRSM,JP)
+    ENDDO
+    SFLUXREFC(IGC,JP) = ZSUMF
+  ENDDO
+ENDDO
+
+!     -----------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB18',1,ZHOOK_HANDLE)
+END SUBROUTINE SRTM_CMBGB18
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb18.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb18.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb18.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SRTM_CMBGB18
+END SUBROUTINE SRTM_CMBGB18
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb19.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb19.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb19.F90	(revision 3908)
@@ -0,0 +1,94 @@
+SUBROUTINE SRTM_CMBGB19
+
+!     BAND 19:  4650-5150 cm-1 (low - H2O,CO2; high - CO2)
+!-----------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM , JPRB
+USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK
+
+USE YOESRTM  , ONLY : NGN
+USE YOESRTWN , ONLY : NGC, NGS, RWGT
+!USE YOESRTWN , ONLY : NGC, NGS, NGN, RWGT
+USE YOESRTA19, ONLY : KA, KB, SELFREF, FORREF, SFLUXREF, &
+                    & KAC, KBC, SELFREFC, FORREFC, SFLUXREFC
+
+IMPLICIT NONE
+
+! Local variables
+INTEGER(KIND=JPIM) :: JN, JT, JP, IGC, IPR, IPRSM
+REAL(KIND=JPRB)    :: ZSUMK, ZSUMF
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!     ------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB19',0,ZHOOK_HANDLE)
+
+DO JN = 1,9
+  DO JT = 1,5
+    DO JP = 1,13
+      IPRSM = 0
+      DO IGC = 1,NGC(4)
+        ZSUMK = 0.
+        DO IPR = 1, NGN(NGS(3)+IGC)
+          IPRSM = IPRSM + 1
+          ZSUMK = ZSUMK + KA(JN,JT,JP,IPRSM)*RWGT(IPRSM+48)
+        ENDDO
+        KAC(JN,JT,JP,IGC) = ZSUMK
+      ENDDO
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JT = 1,5
+  DO JP = 13,59
+    IPRSM = 0
+    DO IGC = 1,NGC(4)
+      ZSUMK = 0.
+      DO IPR = 1, NGN(NGS(3)+IGC)
+        IPRSM = IPRSM + 1
+        ZSUMK = ZSUMK + KB(JT,JP,IPRSM)*RWGT(IPRSM+48)
+      ENDDO
+      KBC(JT,JP,IGC) = ZSUMK
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JT = 1,10
+  IPRSM = 0
+  DO IGC = 1,NGC(4)
+    ZSUMK = 0.
+    DO IPR = 1, NGN(NGS(3)+IGC)
+      IPRSM = IPRSM + 1
+      ZSUMK = ZSUMK + SELFREF(JT,IPRSM)*RWGT(IPRSM+48)
+    ENDDO
+    SELFREFC(JT,IGC) = ZSUMK
+  ENDDO
+ENDDO
+
+DO JT = 1,3
+  IPRSM = 0
+  DO IGC = 1,NGC(4)
+    ZSUMK = 0.
+    DO IPR = 1, NGN(NGS(3)+IGC)
+      IPRSM = IPRSM + 1
+      ZSUMK = ZSUMK + FORREF(JT,IPRSM)*RWGT(IPRSM+48)
+    ENDDO
+    FORREFC(JT,IGC) = ZSUMK
+  ENDDO
+ENDDO
+
+DO JP = 1,9
+  IPRSM = 0
+  DO IGC = 1,NGC(4)
+    ZSUMF = 0.
+    DO IPR = 1, NGN(NGS(3)+IGC)
+      IPRSM = IPRSM + 1
+      ZSUMF = ZSUMF + SFLUXREF(IPRSM,JP)
+    ENDDO
+    SFLUXREFC(IGC,JP) = ZSUMF
+  ENDDO
+ENDDO
+
+!     -----------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB19',1,ZHOOK_HANDLE)
+END SUBROUTINE SRTM_CMBGB19
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb19.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb19.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb19.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SRTM_CMBGB19
+END SUBROUTINE SRTM_CMBGB19
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb20.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb20.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb20.F90	(revision 3908)
@@ -0,0 +1,91 @@
+SUBROUTINE SRTM_CMBGB20
+
+!     BAND 20:  5150-6150 cm-1 (low - H2O; high - H2O)
+!-----------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM , JPRB
+USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK
+
+USE YOESRTM  , ONLY : NGN
+USE YOESRTWN , ONLY : NGC, NGS, RWGT
+!USE YOESRTWN , ONLY : NGC, NGS, NGN, RWGT
+USE YOESRTA20, ONLY : KA, KB, SELFREF, FORREF, ABSCH4, SFLUXREF, &
+                    & KAC, KBC, SELFREFC, FORREFC, ABSCH4C, SFLUXREFC
+
+IMPLICIT NONE
+
+! Local variables
+INTEGER(KIND=JPIM) :: JT, JP, IGC, IPR, IPRSM
+REAL(KIND=JPRB)    :: ZSUMK, ZSUMF1, ZSUMF2
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!     ------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB20',0,ZHOOK_HANDLE)
+
+DO JT = 1,5
+  DO JP = 1,13
+    IPRSM = 0
+    DO IGC = 1,NGC(5)
+      ZSUMK = 0.
+      DO IPR = 1, NGN(NGS(4)+IGC)
+        IPRSM = IPRSM + 1
+        ZSUMK = ZSUMK + KA(JT,JP,IPRSM)*RWGT(IPRSM+64)
+      ENDDO
+      KAC(JT,JP,IGC) = ZSUMK
+    ENDDO
+  ENDDO
+
+  DO JP = 13,59
+    IPRSM = 0
+    DO IGC = 1,NGC(5)
+      ZSUMK = 0.
+      DO IPR = 1, NGN(NGS(4)+IGC)
+        IPRSM = IPRSM + 1
+        ZSUMK = ZSUMK + KB(JT,JP,IPRSM)*RWGT(IPRSM+64)
+      ENDDO
+      KBC(JT,JP,IGC) = ZSUMK
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JT = 1,10
+  IPRSM = 0
+  DO IGC = 1,NGC(5)
+    ZSUMK = 0.
+    DO IPR = 1, NGN(NGS(4)+IGC)
+      IPRSM = IPRSM + 1
+      ZSUMK = ZSUMK + SELFREF(JT,IPRSM)*RWGT(IPRSM+64)
+    ENDDO
+    SELFREFC(JT,IGC) = ZSUMK
+  ENDDO
+ENDDO
+
+DO JT = 1,4
+  IPRSM = 0
+  DO IGC = 1,NGC(5)
+    ZSUMK = 0.
+    DO IPR = 1, NGN(NGS(4)+IGC)
+      IPRSM = IPRSM + 1
+      ZSUMK = ZSUMK + FORREF(JT,IPRSM)*RWGT(IPRSM+64)
+    ENDDO
+    FORREFC(JT,IGC) = ZSUMK
+  ENDDO
+ENDDO
+
+IPRSM = 0
+DO IGC = 1,NGC(5)
+  ZSUMF1 = 0.
+  ZSUMF2 = 0.
+  DO IPR = 1, NGN(NGS(4)+IGC)
+    IPRSM = IPRSM + 1
+    ZSUMF1 = ZSUMF1 + SFLUXREF(IPRSM)
+    ZSUMF2 = ZSUMF2 + ABSCH4(IPRSM)*RWGT(IPRSM+64)
+  ENDDO
+  SFLUXREFC(IGC) = ZSUMF1
+  ABSCH4C(IGC) = ZSUMF2
+ENDDO
+
+!     -----------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB20',1,ZHOOK_HANDLE)
+END SUBROUTINE SRTM_CMBGB20
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb20.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb20.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb20.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SRTM_CMBGB20
+END SUBROUTINE SRTM_CMBGB20
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb21.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb21.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb21.F90	(revision 3908)
@@ -0,0 +1,96 @@
+SUBROUTINE SRTM_CMBGB21
+
+!     BAND 21:  6150-7700 cm-1 (low - H2O,CO2; high - H2O,CO2)
+!-----------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM , JPRB
+USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK
+
+USE YOESRTM  , ONLY : NGN
+USE YOESRTWN , ONLY : NGC, NGS, RWGT
+!USE YOESRTWN , ONLY : NGC, NGS, NGN, RWGT
+USE YOESRTA21, ONLY : KA, KB, SELFREF, FORREF, SFLUXREF, &
+                    & KAC, KBC, SELFREFC, FORREFC, SFLUXREFC
+
+IMPLICIT NONE
+
+! Local variables
+INTEGER(KIND=JPIM) :: JN, JT, JP, IGC, IPR, IPRSM
+REAL(KIND=JPRB)    :: ZSUMK, ZSUMF
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!     ------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB21',0,ZHOOK_HANDLE)
+
+DO JN = 1,9
+  DO JT = 1,5
+    DO JP = 1,13
+      IPRSM = 0
+      DO IGC = 1,NGC(6)
+        ZSUMK = 0.
+        DO IPR = 1, NGN(NGS(5)+IGC)
+          IPRSM = IPRSM + 1
+          ZSUMK = ZSUMK + KA(JN,JT,JP,IPRSM)*RWGT(IPRSM+80)
+        ENDDO
+        KAC(JN,JT,JP,IGC) = ZSUMK
+      ENDDO
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JN = 1,5
+  DO JT = 1,5
+    DO JP = 13,59
+      IPRSM = 0
+      DO IGC = 1,NGC(6)
+        ZSUMK = 0.
+        DO IPR = 1, NGN(NGS(5)+IGC)
+          IPRSM = IPRSM + 1
+          ZSUMK = ZSUMK + KB(JN,JT,JP,IPRSM)*RWGT(IPRSM+80)
+        ENDDO
+        KBC(JN,JT,JP,IGC) = ZSUMK
+      ENDDO
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JT = 1,10
+  IPRSM = 0
+  DO IGC = 1,NGC(6)
+    ZSUMK = 0.
+    DO IPR = 1, NGN(NGS(5)+IGC)
+      IPRSM = IPRSM + 1
+      ZSUMK = ZSUMK + SELFREF(JT,IPRSM)*RWGT(IPRSM+80)
+    ENDDO
+    SELFREFC(JT,IGC) = ZSUMK
+  ENDDO
+ENDDO
+
+DO JT = 1,4
+  IPRSM = 0
+  DO IGC = 1,NGC(6)
+    ZSUMK = 0.
+    DO IPR = 1, NGN(NGS(5)+IGC)
+      IPRSM = IPRSM + 1
+      ZSUMK = ZSUMK + FORREF(JT,IPRSM)*RWGT(IPRSM+80)
+    ENDDO
+    FORREFC(JT,IGC) = ZSUMK
+  ENDDO
+ENDDO
+
+DO JP = 1,9
+  IPRSM = 0
+  DO IGC = 1,NGC(6)
+    ZSUMF = 0.
+    DO IPR = 1, NGN(NGS(5)+IGC)
+      IPRSM = IPRSM + 1
+      ZSUMF = ZSUMF + SFLUXREF(IPRSM,JP)
+    ENDDO
+    SFLUXREFC(IGC,JP) = ZSUMF
+  ENDDO
+ENDDO
+
+!     -----------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB21',1,ZHOOK_HANDLE)
+END SUBROUTINE SRTM_CMBGB21
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb21.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb21.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb21.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SRTM_CMBGB21
+END SUBROUTINE SRTM_CMBGB21
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb22.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb22.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb22.F90	(revision 3908)
@@ -0,0 +1,94 @@
+SUBROUTINE SRTM_CMBGB22
+
+!     BAND 22:  7700-8050 cm-1 (low - H2O,O2; high - O2)
+!-----------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM , JPRB
+USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK
+
+USE YOESRTM  , ONLY : NGN
+USE YOESRTWN , ONLY : NGC, NGS, RWGT
+!USE YOESRTWN , ONLY : NGC, NGS, NGN, RWGT
+USE YOESRTA22, ONLY : KA, KB, SELFREF, FORREF, SFLUXREF, &
+                    & KAC, KBC, SELFREFC, FORREFC, SFLUXREFC
+
+IMPLICIT NONE
+
+! Local variables
+INTEGER(KIND=JPIM) :: JN, JT, JP, IGC, IPR, IPRSM
+REAL(KIND=JPRB)    :: ZSUMK, ZSUMF
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!     ------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB22',0,ZHOOK_HANDLE)
+
+DO JN = 1,9
+  DO JT = 1,5
+    DO JP = 1,13
+      IPRSM = 0
+      DO IGC = 1,NGC(7)
+        ZSUMK = 0.
+        DO IPR = 1, NGN(NGS(6)+IGC)
+          IPRSM = IPRSM + 1
+          ZSUMK = ZSUMK + KA(JN,JT,JP,IPRSM)*RWGT(IPRSM+96)
+        ENDDO
+        KAC(JN,JT,JP,IGC) = ZSUMK
+      ENDDO
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JT = 1,5
+  DO JP = 13,59
+    IPRSM = 0
+    DO IGC = 1,NGC(7)
+      ZSUMK = 0.
+      DO IPR = 1, NGN(NGS(6)+IGC)
+        IPRSM = IPRSM + 1
+        ZSUMK = ZSUMK + KB(JT,JP,IPRSM)*RWGT(IPRSM+96)
+      ENDDO
+      KBC(JT,JP,IGC) = ZSUMK
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JT = 1,10
+  IPRSM = 0
+  DO IGC = 1,NGC(7)
+    ZSUMK = 0.
+    DO IPR = 1, NGN(NGS(6)+IGC)
+      IPRSM = IPRSM + 1
+      ZSUMK = ZSUMK + SELFREF(JT,IPRSM)*RWGT(IPRSM+96)
+    ENDDO
+    SELFREFC(JT,IGC) = ZSUMK
+  ENDDO
+ENDDO
+
+DO JT = 1,3
+  IPRSM = 0
+  DO IGC = 1,NGC(7)
+    ZSUMK = 0.
+    DO IPR = 1, NGN(NGS(6)+IGC)
+      IPRSM = IPRSM + 1
+      ZSUMK = ZSUMK + FORREF(JT,IPRSM)*RWGT(IPRSM+96)
+    ENDDO
+    FORREFC(JT,IGC) = ZSUMK
+  ENDDO
+ENDDO
+
+DO JP = 1,9
+  IPRSM = 0
+  DO IGC = 1,NGC(7)
+    ZSUMF = 0.
+    DO IPR = 1, NGN(NGS(6)+IGC)
+      IPRSM = IPRSM + 1
+      ZSUMF = ZSUMF + SFLUXREF(IPRSM,JP)
+    ENDDO
+    SFLUXREFC(IGC,JP) = ZSUMF
+  ENDDO
+ENDDO
+
+!     -----------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB22',1,ZHOOK_HANDLE)
+END SUBROUTINE SRTM_CMBGB22
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb22.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb22.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb22.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SRTM_CMBGB22
+END SUBROUTINE SRTM_CMBGB22
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb23.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb23.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb23.F90	(revision 3908)
@@ -0,0 +1,79 @@
+SUBROUTINE SRTM_CMBGB23
+
+!     BAND 23:  8050-12850 cm-1 (low - H2O; high - nothing)
+!-----------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM , JPRB
+USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK
+
+USE YOESRTM  , ONLY : NGN
+USE YOESRTWN , ONLY : NGC, NGS, RWGT
+!USE YOESRTWN , ONLY : NGC, NGS, NGN, RWGT
+USE YOESRTA23, ONLY : KA, SELFREF, FORREF, SFLUXREF, RAYL, &
+                    & KAC, SELFREFC, FORREFC, SFLUXREFC, RAYLC
+
+IMPLICIT NONE
+
+! Local variables
+INTEGER(KIND=JPIM) :: JT, JP, IGC, IPR, IPRSM
+REAL(KIND=JPRB)    :: ZSUMK, ZSUMF1, ZSUMF2
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!     ------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB23',0,ZHOOK_HANDLE)
+
+DO JT = 1,5
+  DO JP = 1,13
+    IPRSM = 0
+    DO IGC = 1,NGC(8)
+      ZSUMK = 0.
+      DO IPR = 1, NGN(NGS(7)+IGC)
+        IPRSM = IPRSM + 1
+        ZSUMK = ZSUMK + KA(JT,JP,IPRSM)*RWGT(IPRSM+112)
+      ENDDO
+      KAC(JT,JP,IGC) = ZSUMK
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JT = 1,10
+  IPRSM = 0
+  DO IGC = 1,NGC(8)
+    ZSUMK = 0.
+    DO IPR = 1, NGN(NGS(7)+IGC)
+      IPRSM = IPRSM + 1
+      ZSUMK = ZSUMK + SELFREF(JT,IPRSM)*RWGT(IPRSM+112)
+    ENDDO
+    SELFREFC(JT,IGC) = ZSUMK
+  ENDDO
+ENDDO
+
+DO JT = 1,3
+  IPRSM = 0
+  DO IGC = 1,NGC(8)
+    ZSUMK = 0.
+    DO IPR = 1, NGN(NGS(7)+IGC)
+      IPRSM = IPRSM + 1
+      ZSUMK = ZSUMK + FORREF(JT,IPRSM)*RWGT(IPRSM+112)
+    ENDDO
+    FORREFC(JT,IGC) = ZSUMK
+  ENDDO
+ENDDO
+
+IPRSM = 0
+DO IGC = 1,NGC(8)
+  ZSUMF1 = 0.
+  ZSUMF2 = 0.
+  DO IPR = 1, NGN(NGS(7)+IGC)
+    IPRSM = IPRSM + 1
+    ZSUMF1 = ZSUMF1 + SFLUXREF(IPRSM)
+    ZSUMF2 = ZSUMF2 + RAYL(IPRSM)*RWGT(IPRSM+112)
+  ENDDO
+  SFLUXREFC(IGC) = ZSUMF1
+  RAYLC(IGC) = ZSUMF2
+ENDDO
+
+!     -----------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB23',1,ZHOOK_HANDLE)
+END SUBROUTINE SRTM_CMBGB23
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb23.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb23.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb23.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SRTM_CMBGB23
+END SUBROUTINE SRTM_CMBGB23
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb24.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb24.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb24.F90	(revision 3908)
@@ -0,0 +1,115 @@
+SUBROUTINE SRTM_CMBGB24
+
+!     BAND 24:  12850-16000 cm-1 (low - H2O,O2; high - O2)
+!-----------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM , JPRB
+USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK
+
+USE YOESRTM  , ONLY : NGN
+USE YOESRTWN , ONLY : NGC, NGS, RWGT
+!USE YOESRTWN , ONLY : NGC, NGS, NGN, RWGT
+USE YOESRTA24, ONLY : KA, KB, SELFREF, FORREF, SFLUXREF, &
+                    & ABSO3A, ABSO3B, RAYLA, RAYLB, &
+                    & KAC, KBC, SELFREFC, FORREFC, SFLUXREFC, &
+                    & ABSO3AC, ABSO3BC, RAYLAC, RAYLBC
+
+IMPLICIT NONE
+
+! Local variables
+INTEGER(KIND=JPIM) :: JN, JT, JP, IGC, IPR, IPRSM
+REAL(KIND=JPRB)    :: ZSUMK, ZSUMF1, ZSUMF2, ZSUMF3
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!     ------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB24',0,ZHOOK_HANDLE)
+
+DO JN = 1,9
+  DO JT = 1,5
+    DO JP = 1,13
+      IPRSM = 0
+      DO IGC = 1,NGC(9)
+        ZSUMK = 0.
+        DO IPR = 1, NGN(NGS(8)+IGC)
+          IPRSM = IPRSM + 1
+          ZSUMK = ZSUMK + KA(JN,JT,JP,IPRSM)*RWGT(IPRSM+128)
+        ENDDO
+        KAC(JN,JT,JP,IGC) = ZSUMK
+      ENDDO
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JT = 1,5
+  DO JP = 13,59
+    IPRSM = 0
+    DO IGC = 1,NGC(9)
+      ZSUMK = 0.
+      DO IPR = 1, NGN(NGS(8)+IGC)
+        IPRSM = IPRSM + 1
+        ZSUMK = ZSUMK + KB(JT,JP,IPRSM)*RWGT(IPRSM+128)
+      ENDDO
+      KBC(JT,JP,IGC) = ZSUMK
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JT = 1,10
+  IPRSM = 0
+  DO IGC = 1,NGC(9)
+    ZSUMK = 0.
+    DO IPR = 1, NGN(NGS(8)+IGC)
+      IPRSM = IPRSM + 1
+      ZSUMK = ZSUMK + SELFREF(JT,IPRSM)*RWGT(IPRSM+128)
+    ENDDO
+    SELFREFC(JT,IGC) = ZSUMK
+  ENDDO
+ENDDO
+
+DO JT = 1,3
+  IPRSM = 0
+  DO IGC = 1,NGC(9)
+    ZSUMK = 0.
+    DO IPR = 1, NGN(NGS(8)+IGC)
+      IPRSM = IPRSM + 1
+      ZSUMK = ZSUMK + FORREF(JT,IPRSM)*RWGT(IPRSM+128)
+    ENDDO
+    FORREFC(JT,IGC) = ZSUMK
+  ENDDO
+ENDDO
+
+IPRSM = 0
+DO IGC = 1,NGC(9)
+  ZSUMF1 = 0.
+  ZSUMF2 = 0.
+  ZSUMF3 = 0.
+  DO IPR = 1, NGN(NGS(8)+IGC)
+    IPRSM = IPRSM + 1
+    ZSUMF1 = ZSUMF1 + RAYLB(IPRSM)*RWGT(IPRSM+128)
+    ZSUMF2 = ZSUMF2 + ABSO3A(IPRSM)*RWGT(IPRSM+128)
+    ZSUMF3 = ZSUMF3 + ABSO3B(IPRSM)*RWGT(IPRSM+128)
+  ENDDO
+  RAYLBC(IGC) = ZSUMF1
+  ABSO3AC(IGC) = ZSUMF2
+  ABSO3BC(IGC) = ZSUMF3
+ENDDO
+
+DO JP = 1,9
+  IPRSM = 0
+  DO IGC = 1,NGC(9)
+    ZSUMF1 = 0.
+    ZSUMF2 = 0.
+    DO IPR = 1, NGN(NGS(8)+IGC)
+      IPRSM = IPRSM + 1
+      ZSUMF1 = ZSUMF1 + SFLUXREF(IPRSM,JP)
+      ZSUMF2 = ZSUMF2 + RAYLA(IPRSM,JP)*RWGT(IPRSM+128)
+    ENDDO
+    SFLUXREFC(IGC,JP) = ZSUMF1
+    RAYLAC(IGC,JP) = ZSUMF2
+  ENDDO
+ENDDO
+
+!     -----------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB24',1,ZHOOK_HANDLE)
+END SUBROUTINE SRTM_CMBGB24
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb24.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb24.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb24.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SRTM_CMBGB24
+END SUBROUTINE SRTM_CMBGB24
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb25.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb25.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb25.F90	(revision 3908)
@@ -0,0 +1,61 @@
+SUBROUTINE SRTM_CMBGB25
+
+!     BAND 25:  16000-22650 cm-1 (low - H2O; high - nothing)
+!-----------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM , JPRB
+USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK
+
+USE YOESRTM  , ONLY : NGN
+USE YOESRTWN , ONLY : NGC, NGS, RWGT
+!USE YOESRTWN , ONLY : NGC, NGS, NGN, RWGT
+USE YOESRTA25, ONLY : KA, SFLUXREF, ABSO3A, ABSO3B, RAYL, &
+                    & KAC, SFLUXREFC, ABSO3AC, ABSO3BC, RAYLC
+
+IMPLICIT NONE
+
+! Local variables
+INTEGER(KIND=JPIM) :: JT, JP, IGC, IPR, IPRSM
+REAL(KIND=JPRB)    :: ZSUMK, ZSUMF1, ZSUMF2, ZSUMF3, ZSUMF4
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!     ------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB25',0,ZHOOK_HANDLE)
+
+DO JT = 1,5
+  DO JP = 1,13
+    IPRSM = 0
+    DO IGC = 1,NGC(10)
+      ZSUMK = 0.
+      DO IPR = 1, NGN(NGS(9)+IGC)
+        IPRSM = IPRSM + 1
+        ZSUMK = ZSUMK + KA(JT,JP,IPRSM)*RWGT(IPRSM+144)
+      ENDDO
+      KAC(JT,JP,IGC) = ZSUMK
+    ENDDO
+  ENDDO
+ENDDO
+
+IPRSM = 0
+DO IGC = 1,NGC(10)
+  ZSUMF1 = 0.
+  ZSUMF2 = 0.
+  ZSUMF3 = 0.
+  ZSUMF4 = 0.
+  DO IPR = 1, NGN(NGS(9)+IGC)
+    IPRSM = IPRSM + 1
+    ZSUMF1 = ZSUMF1 + SFLUXREF(IPRSM)
+    ZSUMF2 = ZSUMF2 + ABSO3A(IPRSM)*RWGT(IPRSM+144)
+    ZSUMF3 = ZSUMF3 + ABSO3B(IPRSM)*RWGT(IPRSM+144)
+    ZSUMF4 = ZSUMF4 + RAYL(IPRSM)*RWGT(IPRSM+144)
+  ENDDO
+  SFLUXREFC(IGC) = ZSUMF1
+  ABSO3AC(IGC) = ZSUMF2
+  ABSO3BC(IGC) = ZSUMF3
+  RAYLC(IGC) = ZSUMF4
+ENDDO
+
+!     -----------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB25',1,ZHOOK_HANDLE)
+END SUBROUTINE SRTM_CMBGB25
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb25.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb25.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb25.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SRTM_CMBGB25
+END SUBROUTINE SRTM_CMBGB25
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb26.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb26.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb26.F90	(revision 3908)
@@ -0,0 +1,41 @@
+SUBROUTINE SRTM_CMBGB26
+
+!     BAND 26:  22650-29000 cm-1 (low - nothing; high - nothing)
+!-----------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM , JPRB
+USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK
+
+USE YOESRTM  , ONLY : NGN
+USE YOESRTWN , ONLY : NGC, NGS, RWGT
+!USE YOESRTWN , ONLY : NGC, NGS, NGN, RWGT
+USE YOESRTA26, ONLY : SFLUXREF, RAYL, &
+                    & SFLUXREFC, RAYLC
+
+IMPLICIT NONE
+
+! Local variables
+INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM
+REAL(KIND=JPRB)    :: ZSUMF1, ZSUMF2
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!     ------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB26',0,ZHOOK_HANDLE)
+
+IPRSM = 0
+DO IGC = 1,NGC(11)
+  ZSUMF1 = 0.
+  ZSUMF2 = 0.
+  DO IPR = 1, NGN(NGS(10)+IGC)
+    IPRSM = IPRSM + 1
+    ZSUMF1 = ZSUMF1 + RAYL(IPRSM)*RWGT(IPRSM+160)
+    ZSUMF2 = ZSUMF2 + SFLUXREF(IPRSM)
+  ENDDO
+  RAYLC(IGC) = ZSUMF1
+  SFLUXREFC(IGC) = ZSUMF2
+ENDDO
+
+!     -----------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB26',1,ZHOOK_HANDLE)
+END SUBROUTINE SRTM_CMBGB26
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb26.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb26.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb26.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SRTM_CMBGB26
+END SUBROUTINE SRTM_CMBGB26
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb27.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb27.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb27.F90	(revision 3908)
@@ -0,0 +1,67 @@
+SUBROUTINE SRTM_CMBGB27
+
+!     BAND 27:  29000-38000 cm-1 (low - O3; high - O3)
+!-----------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM , JPRB
+USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK
+
+USE YOESRTM  , ONLY : NGN
+USE YOESRTWN , ONLY : NGC, NGS, RWGT
+!USE YOESRTWN , ONLY : NGC, NGS, NGN, RWGT
+USE YOESRTA27, ONLY : KA, KB, SFLUXREF, RAYL, &
+                    & KAC, KBC, SFLUXREFC, RAYLC
+
+IMPLICIT NONE
+
+! Local variables
+INTEGER(KIND=JPIM) :: JT, JP, IGC, IPR, IPRSM
+REAL(KIND=JPRB)    :: ZSUMK, ZSUMF1, ZSUMF2
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!     ------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB27',0,ZHOOK_HANDLE)
+
+DO JT = 1,5
+  DO JP = 1,13
+    IPRSM = 0
+    DO IGC = 1,NGC(12)
+      ZSUMK = 0.
+      DO IPR = 1, NGN(NGS(11)+IGC)
+        IPRSM = IPRSM + 1
+        ZSUMK = ZSUMK + KA(JT,JP,IPRSM)*RWGT(IPRSM+176)
+      ENDDO
+      KAC(JT,JP,IGC) = ZSUMK
+    ENDDO
+  ENDDO
+
+  DO JP = 13,59
+    IPRSM = 0
+    DO IGC = 1,NGC(12)
+      ZSUMK = 0.
+      DO IPR = 1, NGN(NGS(11)+IGC)
+        IPRSM = IPRSM + 1
+        ZSUMK = ZSUMK + KB(JT,JP,IPRSM)*RWGT(IPRSM+176)
+      ENDDO
+      KBC(JT,JP,IGC) = ZSUMK
+    ENDDO
+  ENDDO
+ENDDO
+
+IPRSM = 0
+DO IGC = 1,NGC(12)
+  ZSUMF1 = 0.
+  ZSUMF2 = 0.
+  DO IPR = 1, NGN(NGS(11)+IGC)
+    IPRSM = IPRSM + 1
+    ZSUMF1 = ZSUMF1 + SFLUXREF(IPRSM)
+    ZSUMF2 = ZSUMF2 + RAYL(IPRSM)*RWGT(IPRSM+176)
+  ENDDO
+  SFLUXREFC(IGC) = ZSUMF1
+  RAYLC(IGC) = ZSUMF2
+ENDDO
+
+!     -----------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB27',1,ZHOOK_HANDLE)
+END SUBROUTINE SRTM_CMBGB27
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb27.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb27.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb27.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SRTM_CMBGB27
+END SUBROUTINE SRTM_CMBGB27
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb28.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb28.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb28.F90	(revision 3908)
@@ -0,0 +1,72 @@
+SUBROUTINE SRTM_CMBGB28
+
+!     BAND 28:  38000-50000 cm-1 (low - O3,O2; high - O3,O2)
+!-----------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM , JPRB
+USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK
+
+USE YOESRTM  , ONLY : NGN
+USE YOESRTWN , ONLY : NGC, NGS, RWGT
+!USE YOESRTWN , ONLY : NGC, NGS, NGN, RWGT
+USE YOESRTA28, ONLY : KA, KB, SFLUXREF, &
+                    & KAC, KBC, SFLUXREFC
+
+IMPLICIT NONE
+
+! Local variables
+INTEGER(KIND=JPIM) :: JN, JT, JP, IGC, IPR, IPRSM
+REAL(KIND=JPRB)    :: ZSUMK, ZSUMF
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!     ------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB28',0,ZHOOK_HANDLE)
+
+DO JN = 1,9
+  DO JT = 1,5
+    DO JP = 1,13
+      IPRSM = 0
+      DO IGC = 1,NGC(13)
+        ZSUMK = 0.
+        DO IPR = 1, NGN(NGS(12)+IGC)
+          IPRSM = IPRSM + 1
+          ZSUMK = ZSUMK + KA(JN,JT,JP,IPRSM)*RWGT(IPRSM+192)
+        ENDDO
+        KAC(JN,JT,JP,IGC) = ZSUMK
+      ENDDO
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JN = 1,5
+  DO JT = 1,5
+    DO JP = 13,59
+      IPRSM = 0
+      DO IGC = 1,NGC(13)
+        ZSUMK = 0.
+        DO IPR = 1, NGN(NGS(12)+IGC)
+          IPRSM = IPRSM + 1
+          ZSUMK = ZSUMK + KB(JN,JT,JP,IPRSM)*RWGT(IPRSM+192)
+        ENDDO
+        KBC(JN,JT,JP,IGC) = ZSUMK
+      ENDDO
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JP = 1,5
+  IPRSM = 0
+  DO IGC = 1,NGC(13)
+    ZSUMF = 0.
+    DO IPR = 1, NGN(NGS(12)+IGC)
+      IPRSM = IPRSM + 1
+      ZSUMF = ZSUMF + SFLUXREF(IPRSM,JP)
+    ENDDO
+    SFLUXREFC(IGC,JP) = ZSUMF
+  ENDDO
+ENDDO
+
+!     -----------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB28',1,ZHOOK_HANDLE)
+END SUBROUTINE SRTM_CMBGB28
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb28.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb28.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb28.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SRTM_CMBGB28
+END SUBROUTINE SRTM_CMBGB28
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb29.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb29.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb29.F90	(revision 3908)
@@ -0,0 +1,96 @@
+SUBROUTINE SRTM_CMBGB29
+
+!     BAND 29:  820-2600 cm-1 (low - H2O; high - CO2)
+!-----------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM , JPRB
+USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK
+
+USE YOESRTM  , ONLY : NGN
+USE YOESRTWN , ONLY : NGC, NGS, RWGT
+!USE YOESRTWN , ONLY : NGC, NGS, NGN, RWGT
+USE YOESRTA29, ONLY : KA, KB, SELFREF, FORREF, SFLUXREF, &
+                    & ABSH2O, ABSCO2, &
+                    & KAC, KBC, SELFREFC, FORREFC, SFLUXREFC, &
+                    & ABSH2OC, ABSCO2C
+
+IMPLICIT NONE
+
+! Local variables
+INTEGER(KIND=JPIM) :: JT, JP, IGC, IPR, IPRSM
+REAL(KIND=JPRB)    :: ZSUMK, ZSUMF1, ZSUMF2, ZSUMF3
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!     ------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB29',0,ZHOOK_HANDLE)
+
+DO JT = 1,5
+  DO JP = 1,13
+    IPRSM = 0
+    DO IGC = 1,NGC(14)
+      ZSUMK = 0.
+      DO IPR = 1, NGN(NGS(13)+IGC)
+        IPRSM = IPRSM + 1
+        ZSUMK = ZSUMK + KA(JT,JP,IPRSM)*RWGT(IPRSM+208)
+      ENDDO
+      KAC(JT,JP,IGC) = ZSUMK
+    ENDDO
+  ENDDO
+
+  DO JP = 13,59
+    IPRSM = 0
+    DO IGC = 1,NGC(14)
+      ZSUMK = 0.
+      DO IPR = 1, NGN(NGS(13)+IGC)
+        IPRSM = IPRSM + 1
+        ZSUMK = ZSUMK + KB(JT,JP,IPRSM)*RWGT(IPRSM+208)
+      ENDDO
+      KBC(JT,JP,IGC) = ZSUMK
+    ENDDO
+  ENDDO
+ENDDO
+
+DO JT = 1,10
+  IPRSM = 0
+  DO IGC = 1,NGC(14)
+    ZSUMK = 0.
+    DO IPR = 1, NGN(NGS(13)+IGC)
+      IPRSM = IPRSM + 1
+      ZSUMK = ZSUMK + SELFREF(JT,IPRSM)*RWGT(IPRSM+208)
+    ENDDO
+    SELFREFC(JT,IGC) = ZSUMK
+  ENDDO
+ENDDO
+
+DO JT = 1,4
+  IPRSM = 0
+  DO IGC = 1,NGC(14)
+    ZSUMK = 0.
+    DO IPR = 1, NGN(NGS(13)+IGC)
+      IPRSM = IPRSM + 1
+      ZSUMK = ZSUMK + FORREF(JT,IPRSM)*RWGT(IPRSM+208)
+    ENDDO
+    FORREFC(JT,IGC) = ZSUMK
+  ENDDO
+ENDDO
+
+IPRSM = 0
+DO IGC = 1,NGC(14)
+  ZSUMF1 = 0.
+  ZSUMF2 = 0.
+  ZSUMF3 = 0.
+  DO IPR = 1, NGN(NGS(13)+IGC)
+    IPRSM = IPRSM + 1
+    ZSUMF1 = ZSUMF1 + SFLUXREF(IPRSM)
+    ZSUMF2 = ZSUMF2 + ABSCO2(IPRSM)*RWGT(IPRSM+208)
+    ZSUMF3 = ZSUMF3 + ABSH2O(IPRSM)*RWGT(IPRSM+208)
+  ENDDO
+  SFLUXREFC(IGC) = ZSUMF1
+  ABSCO2C(IGC) = ZSUMF2
+  ABSH2OC(IGC) = ZSUMF3
+ENDDO
+
+!     -----------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB29',1,ZHOOK_HANDLE)
+END SUBROUTINE SRTM_CMBGB29
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb29.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb29.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_cmbgb29.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SRTM_CMBGB29
+END SUBROUTINE SRTM_CMBGB29
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_gas_optical_depth.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_gas_optical_depth.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_gas_optical_depth.F90	(revision 3908)
@@ -0,0 +1,334 @@
+#ifdef RS6K
+@PROCESS HOT(NOVECTOR) NOSTRICT
+#endif
+SUBROUTINE SRTM_GAS_OPTICAL_DEPTH &
+ & ( KIDIA   , KFDIA   , KLEV    , PONEMINUS, &
+ &   PRMU0, &
+ &   KLAYTROP,&
+ &   PCOLCH4  , PCOLCO2 , PCOLH2O , PCOLMOL  , PCOLO2 , PCOLO3 ,&
+ &   PFORFAC , PFORFRAC , KINDFOR , PSELFFAC, PSELFFRAC, KINDSELF ,&
+ &   PFAC00  , PFAC01   , PFAC10  , PFAC11 ,&
+ &   KJP     , KJT      , KJT1 ,&
+ !-- output arrays 
+ &   POD, PSSA, PINCSOL)
+
+
+!**** *SRTM_GAS_OPTICAL_DEPTH* - SPECTRAL LOOP TO COMPUTE THE SHORTWAVE RADIATION FLUXES.
+
+!     PURPOSE.
+!     --------
+
+!          COMPUTE THE GAS OPTICAL DEPTH AT EACH SHORTWAVE G POINT
+
+!**   INTERFACE.
+!     ----------
+
+!          *SRTM_GAS_OPTICAL_DEPTH* IS CALLED FROM THE NEW RADIATION SCHEME
+
+!        IMPLICIT ARGUMENTS :
+!        --------------------
+
+!     ==== INPUTS ===
+!     ==== OUTPUTS ===
+
+!     METHOD.
+!     -------
+
+!     EXTERNALS.
+!     ----------
+
+!     REFERENCE.
+!     ----------
+
+!        SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
+!        DOCUMENTATION
+!     AUTHOR.
+!     -------
+!        ADAPTED FROM SRTM_SPCVRT_MCICA (BY JEAN-JACQUES MORCRETTE) BY
+!        ROBIN HOGAN
+!
+!     MODIFICATIONS.
+!     --------------
+!        ORIGINAL : 2015-07-16
+
+!     ------------------------------------------------------------------
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
+USE PARSRTM  , ONLY : JPB1, JPB2
+USE YOESRTM  , ONLY : JPGPT
+USE YOESRTWN , ONLY : NGC
+
+IMPLICIT NONE
+
+!     ------------------------------------------------------------------
+
+!*       0.1   ARGUMENTS
+!              ---------
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA, KFDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PONEMINUS(KIDIA:KFDIA)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KIDIA:KFDIA)
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLCH4(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLMOL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLO3(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PFORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PFORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)    :: KINDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PSELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PSELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)    :: KINDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)    :: KJP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)    :: KJT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)    :: KJT1(KIDIA:KFDIA,KLEV)
+
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: POD(KIDIA:KFDIA,KLEV,JPGPT) ! Optical depth
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSSA(KIDIA:KFDIA,KLEV,JPGPT) ! Single scattering albedo
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PINCSOL(KIDIA:KFDIA,JPGPT) ! Incoming solar flux
+
+
+!     ------------------------------------------------------------------
+
+INTEGER(KIND=JPIM) :: IB1, IB2, IBM, IGT, IW(KIDIA:KFDIA), JB, JG, JK, JL, IC, ICOUNT
+
+INTEGER(KIND=JPIM) :: IND(KFDIA-KIDIA+1)
+
+
+!-- Output of SRTM_TAUMOLn routines
+REAL(KIND=JPRB) :: ZTAUG(KIDIA:KFDIA,KLEV,16) ! Absorption optical depth
+REAL(KIND=JPRB) :: ZTAUR(KIDIA:KFDIA,KLEV,16) ! Rayleigh optical depth
+REAL(KIND=JPRB) :: ZSFLXZEN(KIDIA:KFDIA,16) ! Incoming solar flux
+
+
+REAL(KIND=JPRB) :: ZTAU, ZPAO, ZPTO
+REAL(KIND=JPRB) :: ZPAOJ(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZPTOJ(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZRMU0D(KIDIA:KFDIA) 
+ 
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+
+#include "srtm_taumol16.intfb.h"
+#include "srtm_taumol17.intfb.h"
+#include "srtm_taumol18.intfb.h"
+#include "srtm_taumol19.intfb.h"
+#include "srtm_taumol20.intfb.h"
+#include "srtm_taumol21.intfb.h"
+#include "srtm_taumol22.intfb.h"
+#include "srtm_taumol23.intfb.h"
+#include "srtm_taumol24.intfb.h"
+#include "srtm_taumol25.intfb.h"
+#include "srtm_taumol26.intfb.h"
+#include "srtm_taumol27.intfb.h"
+#include "srtm_taumol28.intfb.h"
+#include "srtm_taumol29.intfb.h"
+
+!     ------------------------------------------------------------------
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('SRTM_GAS_OPTICAL_DEPTH',0,ZHOOK_HANDLE)
+
+IB1=JPB1
+IB2=JPB2
+
+IC=0
+DO JL = KIDIA, KFDIA
+  IF (PRMU0(JL) > 0.0_JPRB) THEN
+    IC=IC+1
+    IND(IC)=JL
+    IW(JL)=0
+  ENDIF
+ENDDO
+ICOUNT=IC
+IF(ICOUNT==0)THEN
+  IF (LHOOK) CALL DR_HOOK('SRTM_SPCVRT_MCICA',1,ZHOOK_HANDLE)
+  RETURN
+ENDIF
+
+JB=IB1-1
+DO JB = IB1, IB2
+  DO IC=1,ICOUNT
+    JL=IND(IC)
+    IBM = JB-15
+    IGT = NGC(IBM)
+  ENDDO
+
+  !-- for each band, computes the gaseous and Rayleigh optical thickness 
+  !  for all g-points within the band
+
+  IF (JB == 16) THEN
+    CALL SRTM_TAUMOL16 &
+     & ( KIDIA   , KFDIA    , KLEV    ,&
+     &   PFAC00  , PFAC01   , PFAC10   , PFAC11   ,&
+     &   KJP     , KJT      , KJT1     , PONEMINUS,&
+     &   PCOLH2O , PCOLCH4  , PCOLMOL  ,&
+     &   KLAYTROP, PSELFFAC , PSELFFRAC, KINDSELF, PFORFAC  , PFORFRAC, KINDFOR ,&
+     &   ZSFLXZEN, ZTAUG    , ZTAUR    , PRMU0     &
+     & )  
+
+  ELSEIF (JB == 17) THEN
+    CALL SRTM_TAUMOL17 &
+     & ( KIDIA   , KFDIA   , KLEV    ,&
+     &   PFAC00  , PFAC01  , PFAC10   , PFAC11 ,&
+     &   KJP     , KJT     , KJT1     , PONEMINUS ,&
+     &   PCOLH2O , PCOLCO2 , PCOLMOL  ,&
+     &   KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF  , PFORFAC, PFORFRAC, KINDFOR ,&
+     &   ZSFLXZEN, ZTAUG   , ZTAUR    , PRMU0     &
+     & )  
+
+  ELSEIF (JB == 18) THEN
+    CALL SRTM_TAUMOL18 &
+     & ( KIDIA   , KFDIA   , KLEV    ,&
+     &   PFAC00  , PFAC01  , PFAC10   , PFAC11 ,&
+     &   KJP     , KJT     , KJT1     , PONEMINUS ,&
+     &   PCOLH2O , PCOLCH4 , PCOLMOL  ,&
+     &   KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF  , PFORFAC, PFORFRAC, KINDFOR ,&
+     &   ZSFLXZEN, ZTAUG   , ZTAUR    , PRMU0     &
+     & )  
+
+  ELSEIF (JB == 19) THEN
+    CALL SRTM_TAUMOL19 &
+     & ( KIDIA   , KFDIA   , KLEV    ,&
+     &   PFAC00  , PFAC01  , PFAC10   , PFAC11 ,&
+     &   KJP     , KJT     , KJT1     , PONEMINUS ,&
+     &   PCOLH2O , PCOLCO2 , PCOLMOL  ,&
+     &   KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF  , PFORFAC, PFORFRAC, KINDFOR ,&
+     &   ZSFLXZEN, ZTAUG   , ZTAUR    , PRMU0     &
+     & )  
+
+  ELSEIF (JB == 20) THEN
+    CALL SRTM_TAUMOL20 &
+     & ( KIDIA   , KFDIA   , KLEV    ,&
+     &   PFAC00  , PFAC01  , PFAC10   , PFAC11 ,&
+     &   KJP     , KJT     , KJT1     ,&
+     &   PCOLH2O , PCOLCH4 , PCOLMOL  ,&
+     &   KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF  , PFORFAC, PFORFRAC, KINDFOR ,&
+     &   ZSFLXZEN, ZTAUG   , ZTAUR    , PRMU0     &
+     & )  
+
+  ELSEIF (JB == 21) THEN
+    CALL SRTM_TAUMOL21 &
+     & ( KIDIA   , KFDIA   , KLEV    ,&
+     &   PFAC00  , PFAC01  , PFAC10   , PFAC11 ,&
+     &   KJP     , KJT     , KJT1     , PONEMINUS ,&
+     &   PCOLH2O , PCOLCO2 , PCOLMOL  ,&
+     &   KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF  , PFORFAC, PFORFRAC, KINDFOR ,&
+     &   ZSFLXZEN, ZTAUG   , ZTAUR    , PRMU0     &
+     & )  
+
+  ELSEIF (JB == 22) THEN
+    CALL SRTM_TAUMOL22 &
+     & ( KIDIA   , KFDIA   , KLEV    ,&
+     &   PFAC00  , PFAC01  , PFAC10   , PFAC11 ,&
+     &   KJP     , KJT     , KJT1     , PONEMINUS ,&
+     &   PCOLH2O , PCOLMOL , PCOLO2   ,&
+     &   KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF  , PFORFAC, PFORFRAC, KINDFOR ,&
+     &   ZSFLXZEN, ZTAUG   , ZTAUR    , PRMU0     &
+     & )  
+
+  ELSEIF (JB == 23) THEN
+    CALL SRTM_TAUMOL23 &
+     & ( KIDIA   , KFDIA   , KLEV    ,&
+     &   PFAC00  , PFAC01  , PFAC10   , PFAC11 ,&
+     &   KJP     , KJT     , KJT1     ,&
+     &   PCOLH2O , PCOLMOL ,&
+     &   KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF  , PFORFAC, PFORFRAC, KINDFOR ,&
+     &   ZSFLXZEN, ZTAUG   , ZTAUR    , PRMU0     &
+     & )  
+
+  ELSEIF (JB == 24) THEN
+    CALL SRTM_TAUMOL24 &
+     & ( KIDIA   , KFDIA   , KLEV    ,&
+     &   PFAC00  , PFAC01  , PFAC10   , PFAC11 ,&
+     &   KJP     , KJT     , KJT1     , PONEMINUS ,&
+     &   PCOLH2O , PCOLMOL , PCOLO2   , PCOLO3 ,&
+     &   KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF  , PFORFAC, PFORFRAC, KINDFOR ,&
+     &   ZSFLXZEN, ZTAUG   , ZTAUR    , PRMU0     &
+     & )  
+
+  ELSEIF (JB == 25) THEN
+    !--- visible 16000-22650 cm-1   0.4415 - 0.6250 um
+    CALL SRTM_TAUMOL25 &
+     & ( KIDIA    , KFDIA   , KLEV     ,&
+     &   PFAC00   , PFAC01  , PFAC10 , PFAC11 ,&
+     &   KJP      , KJT     , KJT1   ,&
+     &   PCOLH2O  , PCOLMOL , PCOLO3 ,&
+     &   KLAYTROP ,&
+     &   ZSFLXZEN, ZTAUG   , ZTAUR   , PRMU0     &
+     & )  
+
+  ELSEIF (JB == 26) THEN
+    !--- UV-A 22650-29000 cm-1   0.3448 - 0.4415 um
+    CALL SRTM_TAUMOL26 &
+     & ( KIDIA   , KFDIA   , KLEV    ,&
+     &   PCOLMOL ,KLAYTROP,&
+     &   ZSFLXZEN, ZTAUG   , ZTAUR    , PRMU0     &
+     & )  
+
+  ELSEIF (JB == 27) THEN
+    !--- UV-B 29000-38000 cm-1   0.2632 - 0.3448 um
+    CALL SRTM_TAUMOL27 &
+     & ( KIDIA   , KFDIA   , KLEV    ,&
+     &   PFAC00  , PFAC01  , PFAC10   , PFAC11 ,&
+     &   KJP     , KJT     , KJT1     ,&
+     &   PCOLMOL , PCOLO3 ,&
+     &   KLAYTROP ,&
+     &   ZSFLXZEN, ZTAUG   , ZTAUR    , PRMU0     &
+     & )  
+
+  ELSEIF (JB == 28) THEN
+    !--- UV-C 38000-50000 cm-1   0.2000 - 0.2632 um
+    CALL SRTM_TAUMOL28 &
+     & ( KIDIA   , KFDIA   , KLEV    ,&
+     &   PFAC00  , PFAC01  , PFAC10 , PFAC11 ,&
+     &   KJP     , KJT     , KJT1   , PONEMINUS ,&
+     &   PCOLMOL , PCOLO2  , PCOLO3 ,&
+     &   KLAYTROP ,&
+     &   ZSFLXZEN, ZTAUG   , ZTAUR  , PRMU0     &
+     & )  
+
+  ELSEIF (JB == 29) THEN
+    CALL SRTM_TAUMOL29 &
+     & ( KIDIA    , KFDIA   , KLEV     ,&
+     &   PFAC00   , PFAC01  , PFAC10   , PFAC11 ,&
+     &   KJP      , KJT     , KJT1     ,&
+     &   PCOLH2O  , PCOLCO2 , PCOLMOL  ,&
+     &   KLAYTROP , PSELFFAC, PSELFFRAC, KINDSELF  , PFORFAC, PFORFRAC, KINDFOR ,&
+     &   ZSFLXZEN , ZTAUG   , ZTAUR    , PRMU0     &
+     & )  
+
+  ENDIF
+   
+  DO JG=1,IGT
+    DO IC=1,ICOUNT
+      JL=IND(IC)
+      IW(JL)=IW(JL)+1
+
+      ! Incoming solar flux into plane perp to incoming radiation
+      PINCSOL(JL,IW(JL)) = ZSFLXZEN(JL,JG)
+    ENDDO
+
+    DO JK=1,KLEV
+      DO IC=1,ICOUNT
+        JL=IND(IC)
+        POD (JL,JK,IW(JL)) = ZTAUR(JL,JK,JG) + ZTAUG(JL,JK,JG)
+        PSSA(JL,JK,IW(JL)) = ZTAUR(JL,JK,JG) / POD(JL,JK,IW(JL))
+      ENDDO
+    ENDDO
+
+  ENDDO   !-- end loop on JG (g point)
+
+ENDDO     !-- end loop on JB (band)
+
+!     ------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_GAS_OPTICAL_DEPTH',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE SRTM_GAS_OPTICAL_DEPTH
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_gas_optical_depth.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_gas_optical_depth.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_gas_optical_depth.intfb.h	(revision 3908)
@@ -0,0 +1,41 @@
+INTERFACE
+SUBROUTINE SRTM_GAS_OPTICAL_DEPTH&
+ & ( KIDIA , KFDIA , KLEV , PONEMINUS,&
+ & PRMU0,&
+ & KLAYTROP,&
+ & PCOLCH4 , PCOLCO2 , PCOLH2O , PCOLMOL , PCOLO2 , PCOLO3 ,&
+ & PFORFAC , PFORFRAC , KINDFOR , PSELFFAC, PSELFFRAC, KINDSELF ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 ,&
+ & POD, PSSA, PINCSOL) 
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOESRTM , ONLY : JPGPT
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA, KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(IN) :: PONEMINUS(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KIDIA:KFDIA)
+INTEGER(KIND=JPIM),INTENT(IN) :: KLAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLCH4(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLMOL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLO3(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KINDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PSELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PSELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KINDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KJP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KJT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KJT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: POD(KIDIA:KFDIA,KLEV,JPGPT)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PSSA(KIDIA:KFDIA,KLEV,JPGPT)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PINCSOL(KIDIA:KFDIA,JPGPT)
+END SUBROUTINE SRTM_GAS_OPTICAL_DEPTH
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_init.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_init.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_init.F90	(revision 3908)
@@ -0,0 +1,158 @@
+SUBROUTINE SRTM_INIT(DIRECTORY)
+
+!-- read in the basic coefficients to configure RRTM_SW
+!- creates module YOESRTWN with BG, NSPA, NSPB, WAVENUM1, WAVENUM2,
+!  DELWAVE, PREF, PREFLOG, TREF
+
+USE PARKIND1  ,ONLY : JPIM , JPRB
+USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK
+
+USE PARSRTM  , ONLY : JPG, JPSW
+USE YOESRTM  , ONLY : NGN
+USE YOESRTWN , ONLY : NG, NGM, WT, NGC, RWGT, WTSM
+!USE YOESRTWN , ONLY : NG, NGM, WT, NGC, NGN, RWGT, WTSM
+!USE YOMLUN   , ONLY : NULOUT
+
+IMPLICIT NONE
+
+CHARACTER(LEN=*), INTENT(IN) :: DIRECTORY
+
+! Local variables
+INTEGER(KIND=JPIM) :: IGC, IGCSM, IBND, IG, IND, IPR, IPRSM
+REAL(KIND=JPRB)    :: ZWTSUM
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+!#include "susrtmcf.intfb.h"
+#include "susrtm.intfb.h"
+#include "srtm_kgb16.intfb.h"
+#include "srtm_kgb17.intfb.h"
+#include "srtm_kgb18.intfb.h"
+#include "srtm_kgb19.intfb.h"
+#include "srtm_kgb20.intfb.h"
+#include "srtm_kgb21.intfb.h"
+#include "srtm_kgb22.intfb.h"
+#include "srtm_kgb23.intfb.h"
+#include "srtm_kgb24.intfb.h"
+#include "srtm_kgb25.intfb.h"
+#include "srtm_kgb26.intfb.h"
+#include "srtm_kgb27.intfb.h"
+#include "srtm_kgb28.intfb.h"
+#include "srtm_kgb29.intfb.h"
+!#include "susrtop.intfb.h"
+
+#include "srtm_cmbgb16.intfb.h"
+#include "srtm_cmbgb17.intfb.h"
+#include "srtm_cmbgb18.intfb.h"
+#include "srtm_cmbgb19.intfb.h"
+#include "srtm_cmbgb20.intfb.h"
+#include "srtm_cmbgb21.intfb.h"
+#include "srtm_cmbgb22.intfb.h"
+#include "srtm_cmbgb23.intfb.h"
+#include "srtm_cmbgb24.intfb.h"
+#include "srtm_cmbgb25.intfb.h"
+#include "srtm_cmbgb26.intfb.h"
+#include "srtm_cmbgb27.intfb.h"
+#include "srtm_cmbgb28.intfb.h"
+#include "srtm_cmbgb29.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('SRTM_INIT',0,ZHOOK_HANDLE)
+
+!CALL SUSRTMCF
+CALL SUSRTM
+
+!-- read in the molecular absorption coefficients
+
+CALL SRTM_KGB16(DIRECTORY)
+CALL SRTM_KGB17
+CALL SRTM_KGB18
+CALL SRTM_KGB19
+CALL SRTM_KGB20
+CALL SRTM_KGB21
+CALL SRTM_KGB22
+CALL SRTM_KGB23
+CALL SRTM_KGB24
+CALL SRTM_KGB25
+CALL SRTM_KGB26
+CALL SRTM_KGB27
+CALL SRTM_KGB28
+CALL SRTM_KGB29
+
+!-- read in the cloud optical properties
+!- creates module YOESRTOP with EXTLIQ1, SSALIQ1, ASYLIQ1, 
+!  EXTICE3, SSAICE3, ASYICE3, FDLICE3  
+
+!-- RRTM_SW cloud optical properties are not used
+!   SRTM_CLDPROP is not called
+!   no need to call SUSRTOP
+
+!CALL SUSRTOP ( -1 )
+
+
+!Mike Iacono 20050804
+!-- 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
+!WRITE(NULOUT,9001) JPSW,JPG
+9001 format(1x,'srtm_init JPSW=',I3,' JPG=',I3)
+DO IBND = 1,JPSW
+  IPRSM = 0
+!  WRITE(NULOUT,9002) IBND,NGC(IBND)
+9002 format(1x,'srtm_init NGC(',I3,')=',I3)
+  IF (NGC(IBND) < JPG) THEN
+    DO IGC = 1,NGC(IBND)
+      IGCSM = IGCSM + 1
+      ZWTSUM = 0.
+!      WRITE(NULOUT,9003) IGC,IGCSM,NGN(IGCSM)
+9003  format(1x,'srtm_init IGC=',I3,' NGN(',I3,')=',I3)
+      DO IPR = 1, NGN(IGCSM)
+        IPRSM = IPRSM + 1
+!        WRITE(NULOUT,9004) IPR,IPRSM,WT(IPRSM)
+9004    format(1x,'srtm_init IPR=',I3,' WT(',I3,')=',E14.7)
+        ZWTSUM = ZWTSUM + WT(IPRSM)
+      ENDDO
+!      WRITE(NULOUT,9005) IGC,ZWTSUM
+9005  format(1x,'srtm_init WTSM(',I3,')=',E14.7)
+      WTSM(IGC) = ZWTSUM
+    ENDDO
+
+!    WRITE(NULOUT,9006) IBND+15,NG(IBND+15)
+9006 format(1x,'srtm_init NG(',I3,')=',I3)
+    DO IG = 1,NG(IBND+15)
+      IND = (IBND-1)*JPG + IG
+!!      WRITE(NULOUT,9007) IND,NGM(IND), IG,WT(IG), WTSM(NGM(IND)), IND,RWGT(IND)
+9007 format(1x,'srtm_init NGM(',I3,')=',I3,' WT(',I3,')=',E13.7,' WTSM=',E13.7,' RWGT(',I3,')=',E13.7)
+      RWGT(IND) = WT(IG)/WTSM(NGM(IND))
+!      WRITE(NULOUT,9007) IND,NGM(IND),IG,WT(IG),WTSM(NGM(IND)),IND,RWGT(IND)
+    ENDDO
+  ELSE
+    DO IG = 1,NG(IBND+15)
+      IGCSM = IGCSM + 1
+      IND = (IBND-1)*JPG + IG
+      RWGT(IND) = 1.0
+    ENDDO
+  ENDIF
+ENDDO
+
+CALL SRTM_CMBGB16
+CALL SRTM_CMBGB17
+CALL SRTM_CMBGB18
+CALL SRTM_CMBGB19
+CALL SRTM_CMBGB20
+CALL SRTM_CMBGB21
+CALL SRTM_CMBGB22
+CALL SRTM_CMBGB23
+CALL SRTM_CMBGB24
+CALL SRTM_CMBGB25
+CALL SRTM_CMBGB26
+CALL SRTM_CMBGB27
+CALL SRTM_CMBGB28
+CALL SRTM_CMBGB29
+
+!-----------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_INIT',1,ZHOOK_HANDLE)
+END SUBROUTINE SRTM_INIT
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_init.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_init.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_init.intfb.h	(revision 3908)
@@ -0,0 +1,5 @@
+INTERFACE
+SUBROUTINE SRTM_INIT(DIRECTORY)
+CHARACTER(LEN=*), INTENT(IN) :: DIRECTORY
+END SUBROUTINE SRTM_INIT
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb16.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb16.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb16.F90	(revision 3908)
@@ -0,0 +1,181 @@
+SUBROUTINE SRTM_KGB16(DIRECTORY)
+
+!     Originally by J.Delamere, Atmospheric & Environmental Research.
+!     Revision: 2.4
+!     BAND 16:  2600-3000 cm-1 (low - H2O,CH4; high - nothing)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+!     G.Mozdzynski March 2011 read constants from files
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  , ONLY : JPRB
+USE YOMHOOK   , ONLY : LHOOK, DR_HOOK
+USE YOMLUN    , ONLY : NULRAD
+USE YOMMP0    , ONLY : NPROC, MYPROC
+USE MPL_MODULE, ONLY : MPL_BROADCAST
+USE YOMTAG    , ONLY : MTAGRAD
+USE YOESRTA16 , ONLY : KA, KB, KA_D, KB_D, SELFREF, FORREF, SFLUXREF, RAYL, STRRAT1, LAYREFFR
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+
+CHARACTER(LEN=*), INTENT(IN) :: DIRECTORY
+
+! KURUCZ
+!CHARACTER(LEN = 80) :: CLZZZ
+CHARACTER(LEN = 255) :: CLF1
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB16',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+  !CALL GETENV("DATA",CLZZZ)
+  !IF(CLZZZ /= " ") THEN
+  !  CLF1=TRIM(CLZZZ)//"/RADSRTM"
+  CLF1 = DIRECTORY // "/RADSRTM"
+  WRITE(0,'(A,A)') 'Reading ',TRIM(CLF1)
+  OPEN(NULRAD,FILE=TRIM(CLF1),FORM="UNFORMATTED",ACTION="READ",ERR=1000,convert='big_endian')
+  !ELSE
+  !  OPEN(NULRAD,FILE='RADSRTM',FORM="UNFORMATTED",ACTION="READ",ERR=1000)
+  !ENDIF
+ READ(NULRAD,ERR=1001) KA_D,KB_D
+  KA = REAL(KA_D,JPRB)
+  KB = REAL(KB_D,JPRB) 
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KA,MTAGRAD,1,CDSTRING='SRTM_KGB16:')
+  CALL MPL_BROADCAST (KB,MTAGRAD,1,CDSTRING='SRTM_KGB16:')
+ENDIF
+
+SFLUXREF = (/ &
+ & 1.92269_JPRB    , 1.72844_JPRB    , 1.64326_JPRB    , 1.58451_JPRB     &
+ & , 1.44031_JPRB    , 1.25108_JPRB    , 1.02724_JPRB    , 0.776759_JPRB    &
+ & , 0.534444_JPRB   , 5.87755E-02_JPRB, 4.86706E-02_JPRB, 3.87989E-02_JPRB &
+ & , 2.84532E-02_JPRB, 1.82431E-02_JPRB, 6.92320E-03_JPRB, 9.70770E-04_JPRB /)  
+
+!     Rayleigh extinction coefficient at v = 2925 cm-1.
+RAYL = 2.91E-10_JPRB
+
+STRRAT1 = 252.131_JPRB
+
+LAYREFFR = 18
+
+!     ------------------------------------------------------------------
+
+!     The array KA contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels> ~100mb, temperatures, and binary
+!     species parameters (see taumol.f for definition).  The first 
+!     index in the array, JS, runs from 1 to 9, and corresponds to 
+!     different values of the binary species parameter.  For instance, 
+!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
+!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
+!     in the array, JT, which runs from 1 to 5, corresponds to different
+!     temperatures.  More specifically, JT = 3 means that the data are for
+!     the reference temperature TREF for this  pressure level, JT = 2 refers
+!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
+!     to the JPth reference pressure level (see taumol.f for these levels
+!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
+!     which g-interval the absorption coefficients are for.
+!     -----------------------------------------------------------------
+
+!     -----------------------------------------------------------------
+!     The array KB contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels < ~100mb and temperatures. The first 
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the reference temperature TREF for this pressure 
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
+!     The second index, JP, runs from 13 to 59 and refers to the JPth
+!     reference pressure level (see taumol.f for the value of these
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
+!     and tells us which g-interval the absorption coefficients are for.
+!     -----------------------------------------------------------------
+
+FORREF(:, 1) = (/ 0.525585E-05_JPRB, 0.527618E-05_JPRB, 0.746929E-04_JPRB /)
+FORREF(:, 2) = (/ 0.794660E-05_JPRB, 0.136902E-04_JPRB, 0.849878E-04_JPRB /)
+FORREF(:, 3) = (/ 0.197099E-04_JPRB, 0.733094E-04_JPRB, 0.121687E-03_JPRB /)
+FORREF(:, 4) = (/ 0.148274E-03_JPRB, 0.169776E-03_JPRB, 0.164848E-03_JPRB /)
+FORREF(:, 5) = (/ 0.230296E-03_JPRB, 0.210384E-03_JPRB, 0.182028E-03_JPRB /)
+FORREF(:, 6) = (/ 0.280575E-03_JPRB, 0.259217E-03_JPRB, 0.196080E-03_JPRB /)
+FORREF(:, 7) = (/ 0.329034E-03_JPRB, 0.291575E-03_JPRB, 0.207044E-03_JPRB /)
+FORREF(:, 8) = (/ 0.349989E-03_JPRB, 0.323471E-03_JPRB, 0.225712E-03_JPRB /)
+FORREF(:, 9) = (/ 0.366097E-03_JPRB, 0.321519E-03_JPRB, 0.253150E-03_JPRB /)
+FORREF(:,10) = (/ 0.383589E-03_JPRB, 0.355314E-03_JPRB, 0.262555E-03_JPRB /)
+FORREF(:,11) = (/ 0.375933E-03_JPRB, 0.372443E-03_JPRB, 0.261313E-03_JPRB /)
+FORREF(:,12) = (/ 0.370652E-03_JPRB, 0.382366E-03_JPRB, 0.250070E-03_JPRB /)
+FORREF(:,13) = (/ 0.375092E-03_JPRB, 0.379542E-03_JPRB, 0.265794E-03_JPRB /)
+FORREF(:,14) = (/ 0.389705E-03_JPRB, 0.384274E-03_JPRB, 0.322135E-03_JPRB /)
+FORREF(:,15) = (/ 0.372084E-03_JPRB, 0.390422E-03_JPRB, 0.370035E-03_JPRB /)
+FORREF(:,16) = (/ 0.437802E-03_JPRB, 0.373406E-03_JPRB, 0.373222E-03_JPRB /)
+
+!     -----------------------------------------------------------------
+!     The array SELFREF contains the coefficient of the water vapor
+!     self-continuum (including the energy term).  The first index
+!     refers to temperature in 7.2 degree increments.  For instance,
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+!     etc.  The second index runs over the g-channel (1 to 16).
+
+SELFREF(:, 1) = (/ &
+ & 0.126758E-02_JPRB, 0.105253E-02_JPRB, 0.873963E-03_JPRB, 0.725690E-03_JPRB, 0.602573E-03_JPRB, &
+ & 0.500344E-03_JPRB, 0.415458E-03_JPRB, 0.344973E-03_JPRB, 0.286447E-03_JPRB, 0.237849E-03_JPRB /)  
+SELFREF(:, 2) = (/ &
+ & 0.144006E-02_JPRB, 0.118514E-02_JPRB, 0.975351E-03_JPRB, 0.802697E-03_JPRB, 0.660606E-03_JPRB, &
+ & 0.543667E-03_JPRB, 0.447429E-03_JPRB, 0.368226E-03_JPRB, 0.303044E-03_JPRB, 0.249400E-03_JPRB /)  
+SELFREF(:, 3) = (/ &
+ & 0.294018E-02_JPRB, 0.227428E-02_JPRB, 0.175920E-02_JPRB, 0.136077E-02_JPRB, 0.105258E-02_JPRB, &
+ & 0.814189E-03_JPRB, 0.629789E-03_JPRB, 0.487153E-03_JPRB, 0.376821E-03_JPRB, 0.291478E-03_JPRB /)  
+SELFREF(:, 4) = (/ &
+ & 0.395290E-02_JPRB, 0.348405E-02_JPRB, 0.307081E-02_JPRB, 0.270658E-02_JPRB, 0.238556E-02_JPRB, &
+ & 0.210261E-02_JPRB, 0.185322E-02_JPRB, 0.163341E-02_JPRB, 0.143967E-02_JPRB, 0.126891E-02_JPRB /)  
+SELFREF(:, 5) = (/ &
+ & 0.419122E-02_JPRB, 0.385638E-02_JPRB, 0.354829E-02_JPRB, 0.326481E-02_JPRB, 0.300398E-02_JPRB, &
+ & 0.276399E-02_JPRB, 0.254317E-02_JPRB, 0.234000E-02_JPRB, 0.215305E-02_JPRB, 0.198104E-02_JPRB /)  
+SELFREF(:, 6) = (/ &
+ & 0.495659E-02_JPRB, 0.456777E-02_JPRB, 0.420945E-02_JPRB, 0.387924E-02_JPRB, 0.357494E-02_JPRB, &
+ & 0.329450E-02_JPRB, 0.303606E-02_JPRB, 0.279790E-02_JPRB, 0.257842E-02_JPRB, 0.237615E-02_JPRB /)  
+SELFREF(:, 7) = (/ &
+ & 0.526981E-02_JPRB, 0.490687E-02_JPRB, 0.456893E-02_JPRB, 0.425426E-02_JPRB, 0.396126E-02_JPRB, &
+ & 0.368844E-02_JPRB, 0.343441E-02_JPRB, 0.319788E-02_JPRB, 0.297764E-02_JPRB, 0.277256E-02_JPRB /)  
+SELFREF(:, 8) = (/ &
+ & 0.575426E-02_JPRB, 0.531597E-02_JPRB, 0.491106E-02_JPRB, 0.453699E-02_JPRB, 0.419141E-02_JPRB, &
+ & 0.387216E-02_JPRB, 0.357722E-02_JPRB, 0.330475E-02_JPRB, 0.305303E-02_JPRB, 0.282048E-02_JPRB /)  
+SELFREF(:, 9) = (/ &
+ & 0.549881E-02_JPRB, 0.514328E-02_JPRB, 0.481074E-02_JPRB, 0.449970E-02_JPRB, 0.420877E-02_JPRB, &
+ & 0.393665E-02_JPRB, 0.368213E-02_JPRB, 0.344406E-02_JPRB, 0.322138E-02_JPRB, 0.301310E-02_JPRB /)  
+SELFREF(:,10) = (/ &
+ & 0.605357E-02_JPRB, 0.561246E-02_JPRB, 0.520349E-02_JPRB, 0.482432E-02_JPRB, 0.447278E-02_JPRB, &
+ & 0.414686E-02_JPRB, 0.384469E-02_JPRB, 0.356453E-02_JPRB, 0.330479E-02_JPRB, 0.306398E-02_JPRB /)  
+SELFREF(:,11) = (/ &
+ & 0.640504E-02_JPRB, 0.587858E-02_JPRB, 0.539540E-02_JPRB, 0.495194E-02_JPRB, 0.454492E-02_JPRB, &
+ & 0.417136E-02_JPRB, 0.382850E-02_JPRB, 0.351382E-02_JPRB, 0.322501E-02_JPRB, 0.295993E-02_JPRB /)  
+SELFREF(:,12) = (/ &
+ & 0.677803E-02_JPRB, 0.615625E-02_JPRB, 0.559152E-02_JPRB, 0.507859E-02_JPRB, 0.461271E-02_JPRB, &
+ & 0.418957E-02_JPRB, 0.380524E-02_JPRB, 0.345617E-02_JPRB, 0.313913E-02_JPRB, 0.285116E-02_JPRB /)  
+SELFREF(:,13) = (/ &
+ & 0.690347E-02_JPRB, 0.627003E-02_JPRB, 0.569472E-02_JPRB, 0.517219E-02_JPRB, 0.469761E-02_JPRB, &
+ & 0.426658E-02_JPRB, 0.387509E-02_JPRB, 0.351953E-02_JPRB, 0.319659E-02_JPRB, 0.290328E-02_JPRB /)  
+SELFREF(:,14) = (/ &
+ & 0.692680E-02_JPRB, 0.632795E-02_JPRB, 0.578087E-02_JPRB, 0.528109E-02_JPRB, 0.482452E-02_JPRB, &
+ & 0.440742E-02_JPRB, 0.402638E-02_JPRB, 0.367828E-02_JPRB, 0.336028E-02_JPRB, 0.306977E-02_JPRB /)  
+SELFREF(:,15) = (/ &
+ & 0.754894E-02_JPRB, 0.681481E-02_JPRB, 0.615207E-02_JPRB, 0.555378E-02_JPRB, 0.501367E-02_JPRB, &
+ & 0.452609E-02_JPRB, 0.408593E-02_JPRB, 0.368857E-02_JPRB, 0.332986E-02_JPRB, 0.300603E-02_JPRB /)  
+SELFREF(:,16) = (/ &
+ & 0.760689E-02_JPRB, 0.709755E-02_JPRB, 0.662232E-02_JPRB, 0.617891E-02_JPRB, 0.576519E-02_JPRB, &
+ & 0.537917E-02_JPRB, 0.501899E-02_JPRB, 0.468293E-02_JPRB, 0.436938E-02_JPRB, 0.407682E-02_JPRB /)  
+
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB16',1,ZHOOK_HANDLE)
+RETURN
+
+1000 CONTINUE
+CALL ABOR1("SRTM_KGB16:ERROR OPENING FILE RADSRTM")
+1001 CONTINUE
+CALL ABOR1("SRTM_KGB16:ERROR READING FILE RADSRTM")
+
+END SUBROUTINE SRTM_KGB16
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb16.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb16.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb16.intfb.h	(revision 3908)
@@ -0,0 +1,5 @@
+INTERFACE
+SUBROUTINE SRTM_KGB16(DIRECTORY)
+CHARACTER(LEN=*), INTENT(IN) :: DIRECTORY
+END SUBROUTINE SRTM_KGB16
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb17.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb17.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb17.F90	(revision 3908)
@@ -0,0 +1,191 @@
+SUBROUTINE SRTM_KGB17
+
+!     Originally by J.Delamere, Atmospheric & Environmental Research.
+!     Revision: 2.4
+!     BAND 17:  3250-4000 cm-1 (low - H2O,CO2; high - H2O, CO2)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+!     G.Mozdzynski March 2011 read constants from files
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  , ONLY : JPRB
+USE YOMHOOK   , ONLY : LHOOK, DR_HOOK
+USE YOMLUN    , ONLY : NULRAD
+USE YOMMP0    , ONLY : NPROC, MYPROC
+USE MPL_MODULE, ONLY : MPL_BROADCAST
+USE YOMTAG    , ONLY : MTAGRAD
+USE YOESRTA17 , ONLY : KA, KB, KA_D, KB_D, SELFREF, FORREF, SFLUXREF, RAYL, STRRAT, LAYREFFR
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+
+! KURUCZ
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB17',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+ READ(NULRAD,ERR=1001) KA_D,KB_D
+  KA = REAL(KA_D,JPRB)
+  KB = REAL(KB_D,JPRB) 
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KA,MTAGRAD,1,CDSTRING='SRTM_KGB17:')
+  CALL MPL_BROADCAST (KB,MTAGRAD,1,CDSTRING='SRTM_KGB17:')
+ENDIF
+
+SFLUXREF(:,1) = (/ &
+ & 3.15613_JPRB  ,  3.03449_JPRB  ,  2.92069_JPRB  ,  2.63874_JPRB   , &
+ & 2.34581_JPRB  ,  2.06999_JPRB  ,  1.70906_JPRB  ,  1.29085_JPRB   , &
+ & 0.874851_JPRB ,  0.0955392_JPRB,  0.0787813_JPRB,  0.0621951_JPRB , &
+ & 0.0459076_JPRB,  0.0294129_JPRB,  0.0110387_JPRB,  0.00159668_JPRB /)  
+  
+SFLUXREF(:,2) = (/ &
+ & 2.83147_JPRB  ,  2.95919_JPRB  ,  2.96674_JPRB  ,  2.77677_JPRB   , &
+ & 2.46826_JPRB  ,  2.11481_JPRB  ,  1.73243_JPRB  ,  1.30279_JPRB   , &
+ & 0.882714_JPRB ,  0.0962350_JPRB,  0.0802122_JPRB,  0.0636194_JPRB , &
+ & 0.0472620_JPRB,  0.0299051_JPRB,  0.0110785_JPRB,  0.00159668_JPRB /)  
+  
+SFLUXREF(:,3) = (/ &
+ & 2.82300_JPRB  ,  2.94845_JPRB  ,  2.95887_JPRB  ,  2.77593_JPRB   , &
+ & 2.47096_JPRB  ,  2.12596_JPRB  ,  1.73847_JPRB  ,  1.30796_JPRB   , &
+ & 0.884395_JPRB ,  0.0966936_JPRB,  0.0801996_JPRB,  0.0640199_JPRB , &
+ & 0.0472803_JPRB,  0.0300515_JPRB,  0.0112366_JPRB,  0.00160814_JPRB /)  
+  
+SFLUXREF(:,4) = (/ &
+ & 2.81715_JPRB  ,  2.93789_JPRB  ,  2.95091_JPRB  ,  2.77046_JPRB   , &
+ & 2.47716_JPRB  ,  2.13591_JPRB  ,  1.74365_JPRB  ,  1.31277_JPRB   , &
+ & 0.887443_JPRB ,  0.0967016_JPRB,  0.0803391_JPRB,  0.0642442_JPRB , &
+ & 0.0472909_JPRB,  0.0300720_JPRB,  0.0114817_JPRB,  0.00161875_JPRB /)  
+  
+SFLUXREF(:,5) = (/ &
+ & 2.82335_JPRB  ,  2.93168_JPRB  ,  2.91455_JPRB  ,  2.75213_JPRB   , &
+ & 2.49168_JPRB  ,  2.14408_JPRB  ,  1.75726_JPRB  ,  1.32401_JPRB   , &
+ & 0.893644_JPRB ,  0.0969523_JPRB,  0.0805197_JPRB,  0.0639936_JPRB , &
+ & 0.0475099_JPRB,  0.0305667_JPRB,  0.0115372_JPRB,  0.00161875_JPRB /)  
+     
+!     Rayleigh extinction coefficient at v = 3625 cm-1.
+RAYL = 6.86E-10_JPRB
+
+STRRAT = 0.364641_JPRB
+
+LAYREFFR = 30
+
+!     ------------------------------------------------------------------
+
+!     The array KA contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels> ~100mb, temperatures, and binary
+!     species parameters (see taumol.f for definition).  The first 
+!     index in the array, JS, runs from 1 to 9, and corresponds to 
+!     different values of the binary species parameter.  For instance, 
+!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
+!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
+!     in the array, JT, which runs from 1 to 5, corresponds to different
+!     temperatures.  More specifically, JT = 3 means that the data are for
+!     the reference temperature TREF for this  pressure level, JT = 2 refers
+!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
+!     to the JPth reference pressure level (see taumol.f for these levels
+!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
+!     which g-interval the absorption coefficients are for.
+!     -----------------------------------------------------------------
+
+!     -----------------------------------------------------------------
+!     The array KB contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels < ~100mb and temperatures. The first 
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the reference temperature TREF for this pressure 
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
+!     The second index, JP, runs from 13 to 59 and refers to the JPth
+!     reference pressure level (see taumol.f for the value of these
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
+!     and tells us which g-interval the absorption coefficients are for.
+!     -----------------------------------------------------------------
+
+
+FORREF(:, 1) = (/ 0.553258E-03_JPRB, 0.555486E-03_JPRB, 0.601339E-03_JPRB, 0.708280E-03_JPRB /)
+FORREF(:, 2) = (/ 0.158558E-02_JPRB, 0.162957E-02_JPRB, 0.204991E-02_JPRB, 0.475881E-02_JPRB /)
+FORREF(:, 3) = (/ 0.772542E-02_JPRB, 0.784562E-02_JPRB, 0.111979E-01_JPRB, 0.229016E-01_JPRB /)
+FORREF(:, 4) = (/ 0.255097E-01_JPRB, 0.256272E-01_JPRB, 0.270691E-01_JPRB, 0.259505E-01_JPRB /)
+FORREF(:, 5) = (/ 0.323263E-01_JPRB, 0.324495E-01_JPRB, 0.305535E-01_JPRB, 0.263993E-01_JPRB /)
+FORREF(:, 6) = (/ 0.346920E-01_JPRB, 0.348255E-01_JPRB, 0.323586E-01_JPRB, 0.276357E-01_JPRB /)
+FORREF(:, 7) = (/ 0.366509E-01_JPRB, 0.366412E-01_JPRB, 0.344434E-01_JPRB, 0.319223E-01_JPRB /)
+FORREF(:, 8) = (/ 0.378451E-01_JPRB, 0.375341E-01_JPRB, 0.374369E-01_JPRB, 0.320334E-01_JPRB /)
+FORREF(:, 9) = (/ 0.407348E-01_JPRB, 0.396203E-01_JPRB, 0.393988E-01_JPRB, 0.318343E-01_JPRB /)
+FORREF(:,10) = (/ 0.433035E-01_JPRB, 0.426488E-01_JPRB, 0.408085E-01_JPRB, 0.332749E-01_JPRB /)
+FORREF(:,11) = (/ 0.428254E-01_JPRB, 0.441151E-01_JPRB, 0.408887E-01_JPRB, 0.327077E-01_JPRB /)
+FORREF(:,12) = (/ 0.443226E-01_JPRB, 0.446690E-01_JPRB, 0.404676E-01_JPRB, 0.350492E-01_JPRB /)
+FORREF(:,13) = (/ 0.466103E-01_JPRB, 0.460809E-01_JPRB, 0.401286E-01_JPRB, 0.370427E-01_JPRB /)
+FORREF(:,14) = (/ 0.483928E-01_JPRB, 0.477284E-01_JPRB, 0.380684E-01_JPRB, 0.387940E-01_JPRB /)
+FORREF(:,15) = (/ 0.506987E-01_JPRB, 0.490016E-01_JPRB, 0.467069E-01_JPRB, 0.368998E-01_JPRB /)
+FORREF(:,16) = (/ 0.510836E-01_JPRB, 0.522771E-01_JPRB, 0.500130E-01_JPRB, 0.483406E-01_JPRB /)
+
+!     -----------------------------------------------------------------
+!     The array SELFREF contains the coefficient of the water vapor
+!     self-continuum (including the energy term).  The first index
+!     refers to temperature in 7.2 degree increments.  For instance,
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+!     etc.  The second index runs over the g-channel (1 to 16).
+
+SELFREF(:, 1) = (/ &
+ & 0.160537E-01_JPRB, 0.149038E-01_JPRB, 0.138363E-01_JPRB, 0.128452E-01_JPRB, 0.119251E-01_JPRB, &
+ & 0.110709E-01_JPRB, 0.102779E-01_JPRB, 0.954175E-02_JPRB, 0.885829E-02_JPRB, 0.822379E-02_JPRB /)  
+SELFREF(:, 2) = (/ &
+ & 0.365753E-01_JPRB, 0.342267E-01_JPRB, 0.320288E-01_JPRB, 0.299720E-01_JPRB, 0.280474E-01_JPRB, &
+ & 0.262463E-01_JPRB, 0.245609E-01_JPRB, 0.229837E-01_JPRB, 0.215078E-01_JPRB, 0.201267E-01_JPRB /)  
+SELFREF(:, 3) = (/ &
+ & 0.127419E+00_JPRB, 0.118553E+00_JPRB, 0.110304E+00_JPRB, 0.102629E+00_JPRB, 0.954883E-01_JPRB, &
+ & 0.888442E-01_JPRB, 0.826624E-01_JPRB, 0.769107E-01_JPRB, 0.715593E-01_JPRB, 0.665802E-01_JPRB /)  
+SELFREF(:, 4) = (/ &
+ & 0.378687E+00_JPRB, 0.348961E+00_JPRB, 0.321568E+00_JPRB, 0.296325E+00_JPRB, 0.273064E+00_JPRB, &
+ & 0.251629E+00_JPRB, 0.231876E+00_JPRB, 0.213674E+00_JPRB, 0.196901E+00_JPRB, 0.181444E+00_JPRB /)  
+SELFREF(:, 5) = (/ &
+ & 0.472822E+00_JPRB, 0.435018E+00_JPRB, 0.400236E+00_JPRB, 0.368236E+00_JPRB, 0.338794E+00_JPRB, &
+ & 0.311706E+00_JPRB, 0.286783E+00_JPRB, 0.263854E+00_JPRB, 0.242757E+00_JPRB, 0.223348E+00_JPRB /)  
+SELFREF(:, 6) = (/ &
+ & 0.505620E+00_JPRB, 0.465050E+00_JPRB, 0.427736E+00_JPRB, 0.393416E+00_JPRB, 0.361849E+00_JPRB, &
+ & 0.332815E+00_JPRB, 0.306111E+00_JPRB, 0.281550E+00_JPRB, 0.258959E+00_JPRB, 0.238181E+00_JPRB /)  
+SELFREF(:, 7) = (/ &
+ & 0.530488E+00_JPRB, 0.487993E+00_JPRB, 0.448902E+00_JPRB, 0.412943E+00_JPRB, 0.379864E+00_JPRB, &
+ & 0.349434E+00_JPRB, 0.321443E+00_JPRB, 0.295694E+00_JPRB, 0.272007E+00_JPRB, 0.250218E+00_JPRB /)  
+SELFREF(:, 8) = (/ &
+ & 0.540222E+00_JPRB, 0.497746E+00_JPRB, 0.458610E+00_JPRB, 0.422551E+00_JPRB, 0.389327E+00_JPRB, &
+ & 0.358716E+00_JPRB, 0.330511E+00_JPRB, 0.304524E+00_JPRB, 0.280580E+00_JPRB, 0.258519E+00_JPRB /)  
+SELFREF(:, 9) = (/ &
+ & 0.565727E+00_JPRB, 0.522899E+00_JPRB, 0.483313E+00_JPRB, 0.446724E+00_JPRB, 0.412905E+00_JPRB, &
+ & 0.381646E+00_JPRB, 0.352753E+00_JPRB, 0.326048E+00_JPRB, 0.301365E+00_JPRB, 0.278550E+00_JPRB /)  
+SELFREF(:,10) = (/ &
+ & 0.610122E+00_JPRB, 0.562337E+00_JPRB, 0.518295E+00_JPRB, 0.477702E+00_JPRB, 0.440289E+00_JPRB, &
+ & 0.405806E+00_JPRB, 0.374023E+00_JPRB, 0.344730E+00_JPRB, 0.317730E+00_JPRB, 0.292846E+00_JPRB /)  
+SELFREF(:,11) = (/ &
+ & 0.645176E+00_JPRB, 0.588957E+00_JPRB, 0.537636E+00_JPRB, 0.490788E+00_JPRB, 0.448022E+00_JPRB, &
+ & 0.408982E+00_JPRB, 0.373344E+00_JPRB, 0.340812E+00_JPRB, 0.311114E+00_JPRB, 0.284004E+00_JPRB /)  
+SELFREF(:,12) = (/ &
+ & 0.651737E+00_JPRB, 0.596547E+00_JPRB, 0.546031E+00_JPRB, 0.499792E+00_JPRB, 0.457469E+00_JPRB, &
+ & 0.418730E+00_JPRB, 0.383272E+00_JPRB, 0.350816E+00_JPRB, 0.321108E+00_JPRB, 0.293916E+00_JPRB /)  
+SELFREF(:,13) = (/ &
+ & 0.661086E+00_JPRB, 0.607954E+00_JPRB, 0.559093E+00_JPRB, 0.514159E+00_JPRB, 0.472836E+00_JPRB, &
+ & 0.434834E+00_JPRB, 0.399886E+00_JPRB, 0.367747E+00_JPRB, 0.338191E+00_JPRB, 0.311011E+00_JPRB /)  
+SELFREF(:,14) = (/ &
+ & 0.692554E+00_JPRB, 0.635574E+00_JPRB, 0.583282E+00_JPRB, 0.535293E+00_JPRB, 0.491251E+00_JPRB, &
+ & 0.450834E+00_JPRB, 0.413741E+00_JPRB, 0.379701E+00_JPRB, 0.348461E+00_JPRB, 0.319791E+00_JPRB /)  
+SELFREF(:,15) = (/ &
+ & 0.714646E+00_JPRB, 0.657179E+00_JPRB, 0.604334E+00_JPRB, 0.555737E+00_JPRB, 0.511049E+00_JPRB, &
+ & 0.469954E+00_JPRB, 0.432164E+00_JPRB, 0.397412E+00_JPRB, 0.365455E+00_JPRB, 0.336068E+00_JPRB /)  
+SELFREF(:,16) = (/ &
+ & 0.782126E+00_JPRB, 0.710682E+00_JPRB, 0.645764E+00_JPRB, 0.586776E+00_JPRB, 0.533177E+00_JPRB, &
+ & 0.484473E+00_JPRB, 0.440219E+00_JPRB, 0.400007E+00_JPRB, 0.363468E+00_JPRB, 0.330266E+00_JPRB /)  
+
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB17',1,ZHOOK_HANDLE)
+RETURN
+
+1001 CONTINUE
+CALL ABOR1("SRTM_KGB17:ERROR READING FILE RADSRTM")
+
+END SUBROUTINE SRTM_KGB17
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb17.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb17.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb17.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SRTM_KGB17
+END SUBROUTINE SRTM_KGB17
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb18.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb18.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb18.F90	(revision 3908)
@@ -0,0 +1,207 @@
+SUBROUTINE SRTM_KGB18
+
+!     Originally by J.Delamere, Atmospheric & Environmental Research.
+!     Revision: 2.4
+!     BAND 18:  4000-4650 cm-1 (low - H2O,CH4; high - CH4)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+!     G.Mozdzynski March 2011 read constants from files
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  , ONLY : JPRB
+USE YOMHOOK   , ONLY : LHOOK, DR_HOOK
+USE YOMLUN    , ONLY : NULRAD
+USE YOMMP0    , ONLY : NPROC, MYPROC
+USE MPL_MODULE, ONLY : MPL_BROADCAST
+USE YOMTAG    , ONLY : MTAGRAD
+USE YOESRTA18 , ONLY : KA, KB, KA_D, KB_D, SELFREF, FORREF, SFLUXREF, RAYL, STRRAT, LAYREFFR  
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+
+! KURUCZ
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB18',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+ READ(NULRAD,ERR=1001) KA_D,KB_D
+  KA = REAL(KA_D,JPRB)
+  KB = REAL(KB_D,JPRB) 
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KA,MTAGRAD,1,CDSTRING='SRTM_KGB18:')
+  CALL MPL_BROADCAST (KB,MTAGRAD,1,CDSTRING='SRTM_KGB18:')
+ENDIF
+
+SFLUXREF(:,1) = (/ &
+ & 3.65840_JPRB    , 3.54375_JPRB    , 3.34481_JPRB    , 3.10534_JPRB    , &
+ & 2.79879_JPRB    , 2.42841_JPRB    , 1.98748_JPRB    , 1.49377_JPRB    , &
+ & 1.00196_JPRB    , 0.108342_JPRB   , 8.95099E-02_JPRB, 7.05199E-02_JPRB, &
+ & 5.16432E-02_JPRB, 3.27635E-02_JPRB, 1.25133E-02_JPRB, 1.73001E-03_JPRB /)    
+SFLUXREF(:,2) = (/ &
+ & 3.86372_JPRB    , 3.48521_JPRB    , 3.30790_JPRB    , 3.08103_JPRB    , &
+ & 2.77552_JPRB    , 2.40722_JPRB    , 1.97307_JPRB    , 1.48023_JPRB    , &
+ & 0.993055_JPRB   , 0.107691_JPRB   , 8.84430E-02_JPRB, 6.99354E-02_JPRB, &
+ & 5.07881E-02_JPRB, 3.24121E-02_JPRB, 1.19442E-02_JPRB, 1.57612E-03_JPRB /)  
+SFLUXREF(:,3) = (/ &
+ & 3.90370_JPRB    , 3.50657_JPRB    , 3.30629_JPRB    , 3.06046_JPRB    , &
+ & 2.76982_JPRB    , 2.39907_JPRB    , 1.96358_JPRB    , 1.47458_JPRB    , &
+ & 0.988475_JPRB   , 0.106698_JPRB   , 8.75242E-02_JPRB, 6.85898E-02_JPRB, &
+ & 5.04798E-02_JPRB, 3.13718E-02_JPRB, 1.09533E-02_JPRB, 1.57612E-03_JPRB /)  
+SFLUXREF(:,4) = (/ &
+ & 3.93165_JPRB    , 3.52058_JPRB    , 3.31346_JPRB    , 3.04944_JPRB    , &
+ & 2.76074_JPRB    , 2.39433_JPRB    , 1.95556_JPRB    , 1.46712_JPRB    , &
+ & 0.984056_JPRB   , 0.105885_JPRB   , 8.73062E-02_JPRB, 6.84054E-02_JPRB, &
+ & 4.87443E-02_JPRB, 2.99295E-02_JPRB, 1.09533E-02_JPRB, 1.57612E-03_JPRB /)  
+SFLUXREF(:,5) = (/ &
+ & 3.94082_JPRB    , 3.55221_JPRB    , 3.31863_JPRB    , 3.04730_JPRB    , &
+ & 2.74918_JPRB    , 2.38328_JPRB    , 1.95212_JPRB    , 1.45889_JPRB    , &
+ & 0.978888_JPRB   , 0.105102_JPRB   , 8.65732E-02_JPRB, 6.74563E-02_JPRB, &
+ & 4.76592E-02_JPRB, 2.91017E-02_JPRB, 1.09533E-02_JPRB, 1.57612E-03_JPRB /)  
+SFLUXREF(:,6) = (/ &
+ & 3.94198_JPRB    , 3.58743_JPRB    , 3.32106_JPRB    , 3.05866_JPRB    , &
+ & 2.74115_JPRB    , 2.36939_JPRB    , 1.94305_JPRB    , 1.45180_JPRB    , &
+ & 0.971784_JPRB   , 1.04045E-01_JPRB, 8.53731E-02_JPRB, 6.60654E-02_JPRB, &
+ & 4.63228E-02_JPRB, 2.91016E-02_JPRB, 1.09552E-02_JPRB, 1.57612E-03_JPRB /)  
+SFLUXREF(:,7) = (/ &
+ & 3.93596_JPRB    , 3.63366_JPRB    , 3.33144_JPRB    , 3.06252_JPRB    , &
+ & 2.74054_JPRB    , 2.35492_JPRB    , 1.92769_JPRB    , 1.44300_JPRB    , &
+ & 0.961809_JPRB   , 1.02867E-01_JPRB, 8.34164E-02_JPRB, 6.41005E-02_JPRB, &
+ & 4.61826E-02_JPRB, 2.91006E-02_JPRB, 1.09553E-02_JPRB, 1.57612E-03_JPRB /)  
+SFLUXREF(:,8) = (/ &
+ & 3.92520_JPRB    , 3.69078_JPRB    , 3.35656_JPRB    , 3.07055_JPRB    , &
+ & 2.73862_JPRB    , 2.34430_JPRB    , 1.90187_JPRB    , 1.42242_JPRB    , &
+ & 0.946676_JPRB   , 9.96302E-02_JPRB, 8.14421E-02_JPRB, 6.38622E-02_JPRB, &
+ & 4.61794E-02_JPRB, 2.91017E-02_JPRB, 1.09553E-02_JPRB, 1.57612E-03_JPRB /)  
+SFLUXREF(:,9) = (/ &
+ & 3.80721_JPRB    , 3.74437_JPRB    , 3.50205_JPRB    , 3.18009_JPRB    , &
+ & 2.75757_JPRB    , 2.29188_JPRB    , 1.84382_JPRB    , 1.35694_JPRB    , &
+ & 0.914040_JPRB   , 9.86811E-02_JPRB, 8.14321E-02_JPRB, 6.38541E-02_JPRB, &
+ & 4.61795E-02_JPRB, 2.90960E-02_JPRB, 1.09613E-02_JPRB, 1.57612E-03_JPRB /)  
+
+!     Rayleigh extinction coefficient at v = 4325 cm-1.
+RAYL = 1.39E-09_JPRB
+
+STRRAT = 38.9589_JPRB
+
+LAYREFFR = 6
+
+!     ------------------------------------------------------------------
+
+!     The array KA contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels> ~100mb, temperatures, and binary
+!     species parameters (see taumol.f for definition).  The first 
+!     index in the array, JS, runs from 1 to 9, and corresponds to 
+!     different values of the binary species parameter.  For instance, 
+!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
+!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
+!     in the array, JT, which runs from 1 to 5, corresponds to different
+!     temperatures.  More specifically, JT = 3 means that the data are for
+!     the reference temperature TREF for this  pressure level, JT = 2 refers
+!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
+!     to the JPth reference pressure level (see taumol.f for these levels
+!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
+!     which g-interval the absorption coefficients are for.
+!     -----------------------------------------------------------------
+
+!     -----------------------------------------------------------------
+!     The array KB contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels < ~100mb and temperatures. The first 
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the reference temperature TREF for this pressure 
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
+!     The second index, JP, runs from 13 to 59 and refers to the JPth
+!     reference pressure level (see taumol.f for the value of these
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
+!     and tells us which g-interval the absorption coefficients are for.
+!     -----------------------------------------------------------------
+
+  
+FORREF(:, 1) = (/ 0.860560E-06_JPRB, 0.130439E-05_JPRB, 0.382378E-05_JPRB /)
+FORREF(:, 2) = (/ 0.817926E-06_JPRB, 0.158599E-05_JPRB, 0.658771E-04_JPRB /)
+FORREF(:, 3) = (/ 0.129369E-05_JPRB, 0.824406E-05_JPRB, 0.952778E-04_JPRB /)
+FORREF(:, 4) = (/ 0.438918E-05_JPRB, 0.375356E-04_JPRB, 0.119111E-03_JPRB /)
+FORREF(:, 5) = (/ 0.306057E-04_JPRB, 0.622798E-04_JPRB, 0.100740E-03_JPRB /)
+FORREF(:, 6) = (/ 0.891934E-04_JPRB, 0.856393E-04_JPRB, 0.635583E-04_JPRB /)
+FORREF(:, 7) = (/ 0.171959E-03_JPRB, 0.173431E-03_JPRB, 0.611721E-04_JPRB /)
+FORREF(:, 8) = (/ 0.357795E-03_JPRB, 0.247261E-03_JPRB, 0.488864E-04_JPRB /)
+FORREF(:, 9) = (/ 0.326623E-03_JPRB, 0.289471E-03_JPRB, 0.548834E-04_JPRB /)
+FORREF(:,10) = (/ 0.345103E-03_JPRB, 0.320898E-03_JPRB, 0.633214E-04_JPRB /)
+FORREF(:,11) = (/ 0.392567E-03_JPRB, 0.325153E-03_JPRB, 0.744479E-04_JPRB /)
+FORREF(:,12) = (/ 0.349277E-03_JPRB, 0.345610E-03_JPRB, 0.916479E-04_JPRB /)
+FORREF(:,13) = (/ 0.425161E-03_JPRB, 0.348452E-03_JPRB, 0.125788E-03_JPRB /)
+FORREF(:,14) = (/ 0.407594E-03_JPRB, 0.435836E-03_JPRB, 0.287583E-03_JPRB /)
+FORREF(:,15) = (/ 0.521605E-03_JPRB, 0.486596E-03_JPRB, 0.483511E-03_JPRB /)
+FORREF(:,16) = (/ 0.773790E-03_JPRB, 0.737247E-03_JPRB, 0.665939E-03_JPRB /)
+
+!     -----------------------------------------------------------------
+!     The array SELFREF contains the coefficient of the water vapor
+!     self-continuum (including the energy term).  The first index
+!     refers to temperature in 7.2 degree increments.  For instance,
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+!     etc.  The second index runs over the g-channel (1 to 16).
+     
+SELFREF(:, 1) = (/ &
+ & 0.750370E-03_JPRB, 0.644938E-03_JPRB, 0.554321E-03_JPRB, 0.476436E-03_JPRB, 0.409494E-03_JPRB, &
+ & 0.351957E-03_JPRB, 0.302505E-03_JPRB, 0.260002E-03_JPRB, 0.223470E-03_JPRB, 0.192071E-03_JPRB /)  
+SELFREF(:, 2) = (/ &
+ & 0.136135E-02_JPRB, 0.113187E-02_JPRB, 0.941076E-03_JPRB, 0.782440E-03_JPRB, 0.650546E-03_JPRB, &
+ & 0.540885E-03_JPRB, 0.449709E-03_JPRB, 0.373902E-03_JPRB, 0.310874E-03_JPRB, 0.258471E-03_JPRB /)  
+SELFREF(:, 3) = (/ &
+ & 0.333950E-02_JPRB, 0.256391E-02_JPRB, 0.196845E-02_JPRB, 0.151129E-02_JPRB, 0.116030E-02_JPRB, &
+ & 0.890824E-03_JPRB, 0.683934E-03_JPRB, 0.525093E-03_JPRB, 0.403143E-03_JPRB, 0.309515E-03_JPRB /)  
+SELFREF(:, 4) = (/ &
+ & 0.793392E-02_JPRB, 0.589865E-02_JPRB, 0.438548E-02_JPRB, 0.326048E-02_JPRB, 0.242408E-02_JPRB, &
+ & 0.180223E-02_JPRB, 0.133991E-02_JPRB, 0.996186E-03_JPRB, 0.740636E-03_JPRB, 0.550642E-03_JPRB /)  
+SELFREF(:, 5) = (/ &
+ & 0.828169E-02_JPRB, 0.703139E-02_JPRB, 0.596984E-02_JPRB, 0.506856E-02_JPRB, 0.430335E-02_JPRB, &
+ & 0.365366E-02_JPRB, 0.310206E-02_JPRB, 0.263374E-02_JPRB, 0.223612E-02_JPRB, 0.189852E-02_JPRB /)  
+SELFREF(:, 6) = (/ &
+ & 0.834190E-02_JPRB, 0.780225E-02_JPRB, 0.729750E-02_JPRB, 0.682541E-02_JPRB, 0.638386E-02_JPRB, &
+ & 0.597087E-02_JPRB, 0.558460E-02_JPRB, 0.522332E-02_JPRB, 0.488541E-02_JPRB, 0.456936E-02_JPRB /)  
+SELFREF(:, 7) = (/ &
+ & 0.119082E-01_JPRB, 0.112566E-01_JPRB, 0.106406E-01_JPRB, 0.100583E-01_JPRB, 0.950785E-02_JPRB, &
+ & 0.898755E-02_JPRB, 0.849571E-02_JPRB, 0.803080E-02_JPRB, 0.759132E-02_JPRB, 0.717590E-02_JPRB /)  
+SELFREF(:, 8) = (/ &
+ & 0.144004E-01_JPRB, 0.141762E-01_JPRB, 0.139554E-01_JPRB, 0.137381E-01_JPRB, 0.135241E-01_JPRB, &
+ & 0.133135E-01_JPRB, 0.131062E-01_JPRB, 0.129021E-01_JPRB, 0.127011E-01_JPRB, 0.125033E-01_JPRB /)  
+SELFREF(:, 9) = (/ &
+ & 0.186171E-01_JPRB, 0.175281E-01_JPRB, 0.165027E-01_JPRB, 0.155373E-01_JPRB, 0.146284E-01_JPRB, &
+ & 0.137726E-01_JPRB, 0.129670E-01_JPRB, 0.122084E-01_JPRB, 0.114942E-01_JPRB, 0.108218E-01_JPRB /)  
+SELFREF(:,10) = (/ &
+ & 0.209396E-01_JPRB, 0.195077E-01_JPRB, 0.181737E-01_JPRB, 0.169309E-01_JPRB, 0.157731E-01_JPRB, &
+ & 0.146945E-01_JPRB, 0.136897E-01_JPRB, 0.127535E-01_JPRB, 0.118814E-01_JPRB, 0.110689E-01_JPRB /)  
+SELFREF(:,11) = (/ &
+ & 0.203661E-01_JPRB, 0.193311E-01_JPRB, 0.183487E-01_JPRB, 0.174163E-01_JPRB, 0.165312E-01_JPRB, &
+ & 0.156911E-01_JPRB, 0.148937E-01_JPRB, 0.141368E-01_JPRB, 0.134184E-01_JPRB, 0.127365E-01_JPRB /)  
+SELFREF(:,12) = (/ &
+ & 0.226784E-01_JPRB, 0.210210E-01_JPRB, 0.194848E-01_JPRB, 0.180608E-01_JPRB, 0.167409E-01_JPRB, &
+ & 0.155174E-01_JPRB, 0.143834E-01_JPRB, 0.133322E-01_JPRB, 0.123579E-01_JPRB, 0.114547E-01_JPRB /)  
+SELFREF(:,13) = (/ &
+ & 0.221773E-01_JPRB, 0.210306E-01_JPRB, 0.199433E-01_JPRB, 0.189122E-01_JPRB, 0.179344E-01_JPRB, &
+ & 0.170071E-01_JPRB, 0.161278E-01_JPRB, 0.152939E-01_JPRB, 0.145032E-01_JPRB, 0.137533E-01_JPRB /)  
+SELFREF(:,14) = (/ &
+ & 0.275920E-01_JPRB, 0.252595E-01_JPRB, 0.231241E-01_JPRB, 0.211693E-01_JPRB, 0.193797E-01_JPRB, &
+ & 0.177415E-01_JPRB, 0.162417E-01_JPRB, 0.148687E-01_JPRB, 0.136117E-01_JPRB, 0.124610E-01_JPRB /)  
+SELFREF(:,15) = (/ &
+ & 0.288687E-01_JPRB, 0.269968E-01_JPRB, 0.252462E-01_JPRB, 0.236092E-01_JPRB, 0.220783E-01_JPRB, &
+ & 0.206466E-01_JPRB, 0.193078E-01_JPRB, 0.180559E-01_JPRB, 0.168851E-01_JPRB, 0.157902E-01_JPRB /)  
+SELFREF(:,16) = (/ &
+ & 0.371842E-01_JPRB, 0.347595E-01_JPRB, 0.324929E-01_JPRB, 0.303741E-01_JPRB, 0.283934E-01_JPRB, &
+ & 0.265419E-01_JPRB, 0.248112E-01_JPRB, 0.231933E-01_JPRB, 0.216809E-01_JPRB, 0.202671E-01_JPRB /)  
+
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB18',1,ZHOOK_HANDLE)
+RETURN
+
+1001 CONTINUE
+CALL ABOR1("SRTM_KGB18:ERROR READING FILE RADSRTM")
+
+END SUBROUTINE SRTM_KGB18
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb18.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb18.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb18.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SRTM_KGB18
+END SUBROUTINE SRTM_KGB18
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb19.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb19.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb19.F90	(revision 3908)
@@ -0,0 +1,207 @@
+SUBROUTINE SRTM_KGB19
+
+!     Originally by J.Delamere, Atmospheric & Environmental Research.
+!     Revision: 2.4
+!     BAND 16:  4650-5150 cm-1 (low - H2O,CO2; high - CO2)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+!     G.Mozdzynski March 2011 read constants from files
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  , ONLY : JPRB
+USE YOMHOOK   , ONLY : LHOOK, DR_HOOK
+USE YOMLUN    , ONLY : NULRAD
+USE YOMMP0    , ONLY : NPROC, MYPROC
+USE MPL_MODULE, ONLY : MPL_BROADCAST
+USE YOMTAG    , ONLY : MTAGRAD
+USE YOESRTA19 , ONLY : KA, KB, KA_D, KB_D, SELFREF, FORREF, SFLUXREF, RAYL, STRRAT, LAYREFFR
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+
+! KURUCZ
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB19',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+ READ(NULRAD,ERR=1001) KA_D,KB_D
+  KA = REAL(KA_D,JPRB)
+  KB = REAL(KB_D,JPRB) 
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KA,MTAGRAD,1,CDSTRING='SRTM_KGB19:')
+  CALL MPL_BROADCAST (KB,MTAGRAD,1,CDSTRING='SRTM_KGB19:')
+ENDIF
+
+SFLUXREF(:,1) = (/ &
+ & 3.25791_JPRB    , 3.29697_JPRB    , 3.16031_JPRB    , 2.96115_JPRB    , &
+ & 2.69238_JPRB    , 2.33819_JPRB    , 1.92760_JPRB    , 1.44918_JPRB    , &
+ & 0.979764_JPRB   , 0.107336_JPRB   , 8.94523E-02_JPRB, 6.98325E-02_JPRB, &
+ & 5.12051E-02_JPRB, 3.23645E-02_JPRB, 1.23401E-02_JPRB, 1.71339E-03_JPRB /)  
+SFLUXREF(:,2) = (/ &
+ & 3.22769_JPRB    , 3.28817_JPRB    , 3.16687_JPRB    , 2.97662_JPRB    , &
+ & 2.69495_JPRB    , 2.34392_JPRB    , 1.92900_JPRB    , 1.45391_JPRB    , &
+ & 0.982522_JPRB   , 0.107638_JPRB   , 8.92458E-02_JPRB, 6.99885E-02_JPRB, &
+ & 5.09679E-02_JPRB, 3.23789E-02_JPRB, 1.22673E-02_JPRB, 1.56040E-03_JPRB /)  
+SFLUXREF(:,3) = (/ &
+ & 3.22294_JPRB    , 3.27780_JPRB    , 3.17424_JPRB    , 2.97143_JPRB    , &
+ & 2.69785_JPRB    , 2.34993_JPRB    , 1.93155_JPRB    , 1.45196_JPRB    , &
+ & 0.985329_JPRB   , 0.108027_JPRB   , 8.93552E-02_JPRB, 6.99937E-02_JPRB, &
+ & 5.11678E-02_JPRB, 3.24846E-02_JPRB, 1.20636E-02_JPRB, 1.56040E-03_JPRB /)  
+SFLUXREF(:,4) = (/ &
+ & 3.22445_JPRB    , 3.26113_JPRB    , 3.18438_JPRB    , 2.96921_JPRB    , &
+ & 2.69579_JPRB    , 2.35586_JPRB    , 1.93454_JPRB    , 1.44949_JPRB    , &
+ & 0.987347_JPRB   , 0.108611_JPRB   , 8.91643E-02_JPRB, 7.02236E-02_JPRB, &
+ & 5.12980E-02_JPRB, 3.25282E-02_JPRB, 1.21189E-02_JPRB, 1.56040E-03_JPRB /)  
+SFLUXREF(:,5) = (/ &
+ & 3.22497_JPRB    , 3.25109_JPRB    , 3.18741_JPRB    , 2.96970_JPRB    , &
+ & 2.69460_JPRB    , 2.36020_JPRB    , 1.93301_JPRB    , 1.45224_JPRB    , &
+ & 0.988564_JPRB   , 0.108255_JPRB   , 8.93830E-02_JPRB, 7.03655E-02_JPRB, &
+ & 5.13017E-02_JPRB, 3.29414E-02_JPRB, 1.21189E-02_JPRB, 1.56040E-03_JPRB /)  
+SFLUXREF(:,6) = (/ &
+ & 3.22632_JPRB    , 3.24174_JPRB    , 3.18524_JPRB    , 2.97402_JPRB    , &
+ & 2.69807_JPRB    , 2.35742_JPRB    , 1.93377_JPRB    , 1.45621_JPRB    , &
+ & 0.988132_JPRB   , 0.108344_JPRB   , 8.93188E-02_JPRB, 7.04907E-02_JPRB, &
+ & 5.17938E-02_JPRB, 3.31465E-02_JPRB, 1.21155E-02_JPRB, 1.56040E-03_JPRB /)  
+SFLUXREF(:,7) = (/ &
+ & 3.22793_JPRB    , 3.23589_JPRB    , 3.17720_JPRB    , 2.97869_JPRB    , &
+ & 2.70293_JPRB    , 2.35436_JPRB    , 1.93557_JPRB    , 1.45868_JPRB    , &
+ & 0.988654_JPRB   , 0.108198_JPRB   , 8.93375E-02_JPRB, 7.09790E-02_JPRB, &
+ & 5.24733E-02_JPRB, 3.31298E-02_JPRB, 1.21126E-02_JPRB, 1.56040E-03_JPRB /)  
+SFLUXREF(:,8) = (/ &
+ & 3.22966_JPRB    , 3.24087_JPRB    , 3.15676_JPRB    , 2.98171_JPRB    , &
+ & 2.70894_JPRB    , 2.34975_JPRB    , 1.93855_JPRB    , 1.46354_JPRB    , &
+ & 0.988544_JPRB   , 0.108574_JPRB   , 9.02522E-02_JPRB, 7.12908E-02_JPRB, &
+ & 5.24844E-02_JPRB, 3.31084E-02_JPRB, 1.21060E-02_JPRB, 1.56040E-03_JPRB /)  
+SFLUXREF(:,9) = (/ &
+ & 3.27240_JPRB    , 3.24666_JPRB    , 3.13886_JPRB    , 2.95238_JPRB    , &
+ & 2.70190_JPRB    , 2.34460_JPRB    , 1.93948_JPRB    , 1.47111_JPRB    , &
+ & 0.990821_JPRB   , 0.108730_JPRB   , 9.01625E-02_JPRB, 7.13261E-02_JPRB, &
+ & 5.24813E-02_JPRB, 3.31083E-02_JPRB, 1.21126E-02_JPRB, 1.56040E-03_JPRB /)  
+
+!     Rayleigh extinction coefficient at v = 4900 cm-1.
+RAYL = 2.29E-09_JPRB
+
+STRRAT = 5.49281_JPRB
+
+LAYREFFR = 3
+
+!     ------------------------------------------------------------------
+
+!     The array KA contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels> ~100mb, temperatures, and binary
+!     species parameters (see taumol.f for definition).  The first 
+!     index in the array, JS, runs from 1 to 9, and corresponds to 
+!     different values of the binary species parameter.  For instance, 
+!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
+!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
+!     in the array, JT, which runs from 1 to 5, corresponds to different
+!     temperatures.  More specifically, JT = 3 means that the data are for
+!     the reference temperature TREF for this  pressure level, JT = 2 refers
+!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
+!     to the JPth reference pressure level (see taumol.f for these levels
+!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
+!     which g-interval the absorption coefficients are for.
+!     -----------------------------------------------------------------
+
+!     -----------------------------------------------------------------
+!     The array KB contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels < ~100mb and temperatures. The first 
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the reference temperature TREF for this pressure 
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
+!     The second index, JP, runs from 13 to 59 and refers to the JPth
+!     reference pressure level (see taumol.f for the value of these
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
+!     and tells us which g-interval the absorption coefficients are for.
+!     -----------------------------------------------------------------
+
+  
+FORREF(:, 1) = (/ 0.106275E-05_JPRB, 0.104185E-05_JPRB, 0.420154E-05_JPRB /)
+FORREF(:, 2) = (/ 0.154343E-05_JPRB, 0.653193E-05_JPRB, 0.174596E-04_JPRB /)
+FORREF(:, 3) = (/ 0.348917E-05_JPRB, 0.108420E-04_JPRB, 0.540849E-04_JPRB /)
+FORREF(:, 4) = (/ 0.145822E-04_JPRB, 0.156027E-04_JPRB, 0.881263E-04_JPRB /)
+FORREF(:, 5) = (/ 0.220204E-04_JPRB, 0.819892E-04_JPRB, 0.817937E-04_JPRB /)
+FORREF(:, 6) = (/ 0.447840E-04_JPRB, 0.121116E-03_JPRB, 0.932635E-04_JPRB /)
+FORREF(:, 7) = (/ 0.166516E-03_JPRB, 0.147640E-03_JPRB, 0.754029E-04_JPRB /)
+FORREF(:, 8) = (/ 0.234756E-03_JPRB, 0.145934E-03_JPRB, 0.771734E-04_JPRB /)
+FORREF(:, 9) = (/ 0.289207E-03_JPRB, 0.146768E-03_JPRB, 0.677806E-04_JPRB /)
+FORREF(:,10) = (/ 0.334959E-03_JPRB, 0.125513E-03_JPRB, 0.636648E-04_JPRB /)
+FORREF(:,11) = (/ 0.333755E-03_JPRB, 0.136575E-03_JPRB, 0.593651E-04_JPRB /)
+FORREF(:,12) = (/ 0.340042E-03_JPRB, 0.116259E-03_JPRB, 0.595192E-04_JPRB /)
+FORREF(:,13) = (/ 0.422470E-03_JPRB, 0.148691E-03_JPRB, 0.630266E-04_JPRB /)
+FORREF(:,14) = (/ 0.440655E-03_JPRB, 0.461917E-04_JPRB, 0.108222E-04_JPRB /)
+FORREF(:,15) = (/ 0.486207E-03_JPRB, 0.428458E-03_JPRB, 0.108086E-04_JPRB /)
+FORREF(:,16) = (/ 0.657463E-03_JPRB, 0.657446E-03_JPRB, 0.126190E-04_JPRB /)
+
+!     -----------------------------------------------------------------
+!     The array SELFREF contains the coefficient of the water vapor
+!     self-continuum (including the energy term).  The first index
+!     refers to temperature in 7.2 degree increments.  For instance,
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+!     etc.  The second index runs over the g-channel (1 to 16).
+     
+SELFREF(:, 1) = (/ &
+ & 0.331728E-03_JPRB, 0.287480E-03_JPRB, 0.249135E-03_JPRB, 0.215904E-03_JPRB, 0.187106E-03_JPRB, &
+ & 0.162149E-03_JPRB, 0.140520E-03_JPRB, 0.121777E-03_JPRB, 0.105534E-03_JPRB, 0.914573E-04_JPRB /)  
+SELFREF(:, 2) = (/ &
+ & 0.882628E-03_JPRB, 0.698914E-03_JPRB, 0.553439E-03_JPRB, 0.438244E-03_JPRB, 0.347026E-03_JPRB, &
+ & 0.274795E-03_JPRB, 0.217598E-03_JPRB, 0.172306E-03_JPRB, 0.136442E-03_JPRB, 0.108042E-03_JPRB /)  
+SELFREF(:, 3) = (/ &
+ & 0.115461E-02_JPRB, 0.937203E-03_JPRB, 0.760730E-03_JPRB, 0.617486E-03_JPRB, 0.501215E-03_JPRB, &
+ & 0.406837E-03_JPRB, 0.330231E-03_JPRB, 0.268049E-03_JPRB, 0.217576E-03_JPRB, 0.176607E-03_JPRB /)  
+SELFREF(:, 4) = (/ &
+ & 0.103450E-02_JPRB, 0.960268E-03_JPRB, 0.891360E-03_JPRB, 0.827397E-03_JPRB, 0.768024E-03_JPRB, &
+ & 0.712911E-03_JPRB, 0.661754E-03_JPRB, 0.614267E-03_JPRB, 0.570188E-03_JPRB, 0.529272E-03_JPRB /)  
+SELFREF(:, 5) = (/ &
+ & 0.289040E-02_JPRB, 0.240129E-02_JPRB, 0.199495E-02_JPRB, 0.165737E-02_JPRB, 0.137692E-02_JPRB, &
+ & 0.114392E-02_JPRB, 0.950351E-03_JPRB, 0.789535E-03_JPRB, 0.655933E-03_JPRB, 0.544938E-03_JPRB /)  
+SELFREF(:, 6) = (/ &
+ & 0.361772E-02_JPRB, 0.306611E-02_JPRB, 0.259861E-02_JPRB, 0.220239E-02_JPRB, 0.186659E-02_JPRB, &
+ & 0.158198E-02_JPRB, 0.134077E-02_JPRB, 0.113634E-02_JPRB, 0.963078E-03_JPRB, 0.816234E-03_JPRB /)  
+SELFREF(:, 7) = (/ &
+ & 0.329878E-02_JPRB, 0.318245E-02_JPRB, 0.307021E-02_JPRB, 0.296194E-02_JPRB, 0.285749E-02_JPRB, &
+ & 0.275671E-02_JPRB, 0.265950E-02_JPRB, 0.256571E-02_JPRB, 0.247522E-02_JPRB, 0.238793E-02_JPRB /)  
+SELFREF(:, 8) = (/ &
+ & 0.293562E-02_JPRB, 0.300077E-02_JPRB, 0.306737E-02_JPRB, 0.313544E-02_JPRB, 0.320503E-02_JPRB, &
+ & 0.327615E-02_JPRB, 0.334886E-02_JPRB, 0.342318E-02_JPRB, 0.349915E-02_JPRB, 0.357680E-02_JPRB /)  
+SELFREF(:, 9) = (/ &
+ & 0.281453E-02_JPRB, 0.295894E-02_JPRB, 0.311076E-02_JPRB, 0.327038E-02_JPRB, 0.343818E-02_JPRB, &
+ & 0.361459E-02_JPRB, 0.380006E-02_JPRB, 0.399504E-02_JPRB, 0.420002E-02_JPRB, 0.441553E-02_JPRB /)  
+SELFREF(:,10) = (/ &
+ & 0.239488E-02_JPRB, 0.262487E-02_JPRB, 0.287696E-02_JPRB, 0.315325E-02_JPRB, 0.345607E-02_JPRB, &
+ & 0.378798E-02_JPRB, 0.415176E-02_JPRB, 0.455048E-02_JPRB, 0.498749E-02_JPRB, 0.546647E-02_JPRB /)  
+SELFREF(:,11) = (/ &
+ & 0.271001E-02_JPRB, 0.292235E-02_JPRB, 0.315134E-02_JPRB, 0.339826E-02_JPRB, 0.366453E-02_JPRB, &
+ & 0.395167E-02_JPRB, 0.426131E-02_JPRB, 0.459521E-02_JPRB, 0.495527E-02_JPRB, 0.534354E-02_JPRB /)  
+SELFREF(:,12) = (/ &
+ & 0.206702E-02_JPRB, 0.232254E-02_JPRB, 0.260966E-02_JPRB, 0.293226E-02_JPRB, 0.329475E-02_JPRB, &
+ & 0.370204E-02_JPRB, 0.415969E-02_JPRB, 0.467391E-02_JPRB, 0.525169E-02_JPRB, 0.590090E-02_JPRB /)  
+SELFREF(:,13) = (/ &
+ & 0.227023E-02_JPRB, 0.257331E-02_JPRB, 0.291685E-02_JPRB, 0.330626E-02_JPRB, 0.374766E-02_JPRB, &
+ & 0.424799E-02_JPRB, 0.481511E-02_JPRB, 0.545794E-02_JPRB, 0.618660E-02_JPRB, 0.701253E-02_JPRB /)  
+SELFREF(:,14) = (/ &
+ & 0.851078E-03_JPRB, 0.111512E-02_JPRB, 0.146109E-02_JPRB, 0.191439E-02_JPRB, 0.250832E-02_JPRB, &
+ & 0.328653E-02_JPRB, 0.430617E-02_JPRB, 0.564215E-02_JPRB, 0.739261E-02_JPRB, 0.968616E-02_JPRB /)  
+SELFREF(:,15) = (/ &
+ & 0.742711E-02_JPRB, 0.721347E-02_JPRB, 0.700598E-02_JPRB, 0.680446E-02_JPRB, 0.660873E-02_JPRB, &
+ & 0.641863E-02_JPRB, 0.623400E-02_JPRB, 0.605468E-02_JPRB, 0.588052E-02_JPRB, 0.571137E-02_JPRB /)  
+SELFREF(:,16) = (/ &
+ & 0.107170E-01_JPRB, 0.101913E-01_JPRB, 0.969138E-02_JPRB, 0.921599E-02_JPRB, 0.876392E-02_JPRB, &
+ & 0.833402E-02_JPRB, 0.792521E-02_JPRB, 0.753646E-02_JPRB, 0.716677E-02_JPRB, 0.681522E-02_JPRB /)  
+
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB19',1,ZHOOK_HANDLE)
+RETURN
+
+1001 CONTINUE
+CALL ABOR1("SRTM_KGB19:ERROR READING FILE RADSRTM")
+
+END SUBROUTINE SRTM_KGB19
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb19.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb19.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb19.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SRTM_KGB19
+END SUBROUTINE SRTM_KGB19
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb20.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb20.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb20.F90	(revision 3908)
@@ -0,0 +1,171 @@
+SUBROUTINE SRTM_KGB20
+
+!     Originally by J.Delamere, Atmospheric & Environmental Research.
+!     Revision: 2.4
+!     BAND 20:  5150-6150 cm-1 (low - H2O; high - H2O)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     G.Mozdzynski March 2011 read constants from files
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  , ONLY : JPRB
+USE YOMHOOK   , ONLY : LHOOK, DR_HOOK
+USE YOMLUN    , ONLY : NULRAD
+USE YOMMP0    , ONLY : NPROC, MYPROC
+USE MPL_MODULE, ONLY : MPL_BROADCAST
+USE YOMTAG    , ONLY : MTAGRAD
+USE YOESRTA20 , ONLY : KA, KB, KA_D, KB_D, SELFREF, FORREF, SFLUXREF, RAYL, ABSCH4, LAYREFFR  
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+
+! KURUCZ
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB20',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+  READ(NULRAD,ERR=1001) KA_D,KB_D
+  KA = REAL(KA_D,JPRB)
+  KB = REAL(KB_D,JPRB)
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KA,MTAGRAD,1,CDSTRING='SRTM_KGB20:')
+  CALL MPL_BROADCAST (KB,MTAGRAD,1,CDSTRING='SRTM_KGB20:')
+ENDIF
+
+SFLUXREF = (/ &
+ & 9.34081_JPRB , 8.93720_JPRB    , 8.19346_JPRB    , 7.39196_JPRB    , &
+ & 6.12127_JPRB , 5.23956_JPRB    , 4.24941_JPRB    , 3.20013_JPRB    , &
+ & 2.16047_JPRB , 0.234509_JPRB   , 0.194593_JPRB   , 0.151512_JPRB   , &
+ & 0.110315_JPRB, 7.09959E-02_JPRB, 2.70573E-02_JPRB, 3.36042E-03_JPRB /)  
+  
+ABSCH4 = (/   &
+ & 1.01381E-03_JPRB,6.33692E-03_JPRB,1.94185E-02_JPRB,4.83210E-02_JPRB, &
+ & 2.36574E-03_JPRB,6.61973E-04_JPRB,5.64552E-04_JPRB,2.83183E-04_JPRB, &
+ & 7.43623E-05_JPRB,8.90159E-07_JPRB,6.98728E-07_JPRB,6.51832E-08_JPRB, &
+ & 2.96619E-08_JPRB,         0._JPRB,         0._JPRB,         0._JPRB /)  
+
+!     Rayleigh extinction coefficient at v = 5670 cm-1.
+RAYL = 4.12E-09_JPRB
+
+LAYREFFR = 3
+
+!     ------------------------------------------------------------------
+
+!     The array KA contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels> ~100mb, temperatures, and binary
+!     species parameters (see taumol.f for definition).  The first 
+!     index in the array, JS, runs from 1 to 9, and corresponds to 
+!     different values of the binary species parameter.  For instance, 
+!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
+!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
+!     in the array, JT, which runs from 1 to 5, corresponds to different
+!     temperatures.  More specifically, JT = 3 means that the data are for
+!     the reference temperature TREF for this  pressure level, JT = 2 refers
+!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
+!     to the JPth reference pressure level (see taumol.f for these levels
+!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
+!     which g-interval the absorption coefficients are for.
+!     -----------------------------------------------------------------
+
+!     -----------------------------------------------------------------
+!     The array KB contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels < ~100mb and temperatures. The first 
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the reference temperature TREF for this pressure 
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
+!     The second index, JP, runs from 13 to 59 and refers to the JPth
+!     reference pressure level (see taumol.f for the value of these
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
+!     and tells us which g-interval the absorption coefficients are for.
+!     -----------------------------------------------------------------
+
+
+FORREF(:, 1) = (/ 0.214504E-06_JPRB, 0.460418E-06_JPRB, 0.357608E-05_JPRB, 0.192037E-05_JPRB /)
+FORREF(:, 2) = (/ 0.142576E-05_JPRB, 0.364463E-05_JPRB, 0.117033E-04_JPRB, 0.112085E-04_JPRB /)
+FORREF(:, 3) = (/ 0.101536E-04_JPRB, 0.124096E-04_JPRB, 0.509190E-04_JPRB, 0.565282E-04_JPRB /)
+FORREF(:, 4) = (/ 0.143394E-03_JPRB, 0.154700E-03_JPRB, 0.466498E-03_JPRB, 0.918829E-03_JPRB /)
+FORREF(:, 5) = (/ 0.251631E-02_JPRB, 0.241729E-02_JPRB, 0.240057E-02_JPRB, 0.350408E-02_JPRB /)
+FORREF(:, 6) = (/ 0.410309E-02_JPRB, 0.416851E-02_JPRB, 0.390925E-02_JPRB, 0.383694E-02_JPRB /)
+FORREF(:, 7) = (/ 0.445387E-02_JPRB, 0.448657E-02_JPRB, 0.432310E-02_JPRB, 0.370739E-02_JPRB /)
+FORREF(:, 8) = (/ 0.458150E-02_JPRB, 0.460014E-02_JPRB, 0.450245E-02_JPRB, 0.336718E-02_JPRB /)
+FORREF(:, 9) = (/ 0.465423E-02_JPRB, 0.465595E-02_JPRB, 0.467006E-02_JPRB, 0.368061E-02_JPRB /)
+FORREF(:,10) = (/ 0.493955E-02_JPRB, 0.490181E-02_JPRB, 0.481941E-02_JPRB, 0.367577E-02_JPRB /)
+FORREF(:,11) = (/ 0.511876E-02_JPRB, 0.490981E-02_JPRB, 0.493303E-02_JPRB, 0.357423E-02_JPRB /)
+FORREF(:,12) = (/ 0.509845E-02_JPRB, 0.511556E-02_JPRB, 0.504031E-02_JPRB, 0.355915E-02_JPRB /)
+FORREF(:,13) = (/ 0.523822E-02_JPRB, 0.530473E-02_JPRB, 0.523811E-02_JPRB, 0.414259E-02_JPRB /)
+FORREF(:,14) = (/ 0.551133E-02_JPRB, 0.535831E-02_JPRB, 0.546702E-02_JPRB, 0.473875E-02_JPRB /)
+FORREF(:,15) = (/ 0.609781E-02_JPRB, 0.589859E-02_JPRB, 0.561187E-02_JPRB, 0.528981E-02_JPRB /)
+FORREF(:,16) = (/ 0.644958E-02_JPRB, 0.631718E-02_JPRB, 0.625201E-02_JPRB, 0.600448E-02_JPRB /)
+
+!     -----------------------------------------------------------------
+!     The array SELFREF contains the coefficient of the water vapor
+!     self-continuum (including the energy term).  The first index
+!     refers to temperature in 7.2 degree increments.  For instance,
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+!     etc.  The second index runs over the g-channel (1 to 16).
+
+SELFREF(:, 1) = (/ &
+ & 0.217058E-03_JPRB, 0.176391E-03_JPRB, 0.143342E-03_JPRB, 0.116486E-03_JPRB, 0.946614E-04_JPRB, &
+ & 0.769257E-04_JPRB, 0.625131E-04_JPRB, 0.508007E-04_JPRB, 0.412828E-04_JPRB, 0.335481E-04_JPRB /)  
+SELFREF(:, 2) = (/ &
+ & 0.598055E-03_JPRB, 0.484805E-03_JPRB, 0.393000E-03_JPRB, 0.318580E-03_JPRB, 0.258252E-03_JPRB, &
+ & 0.209348E-03_JPRB, 0.169705E-03_JPRB, 0.137569E-03_JPRB, 0.111518E-03_JPRB, 0.904008E-04_JPRB /)  
+SELFREF(:, 3) = (/ &
+ & 0.102691E-02_JPRB, 0.930281E-03_JPRB, 0.842740E-03_JPRB, 0.763437E-03_JPRB, 0.691596E-03_JPRB, &
+ & 0.626516E-03_JPRB, 0.567560E-03_JPRB, 0.514152E-03_JPRB, 0.465769E-03_JPRB, 0.421940E-03_JPRB /)  
+SELFREF(:, 4) = (/ &
+ & 0.388569E-02_JPRB, 0.365098E-02_JPRB, 0.343045E-02_JPRB, 0.322324E-02_JPRB, 0.302854E-02_JPRB, &
+ & 0.284561E-02_JPRB, 0.267372E-02_JPRB, 0.251222E-02_JPRB, 0.236047E-02_JPRB, 0.221789E-02_JPRB /)  
+SELFREF(:, 5) = (/ &
+ & 0.349845E-01_JPRB, 0.326678E-01_JPRB, 0.305045E-01_JPRB, 0.284845E-01_JPRB, 0.265982E-01_JPRB, &
+ & 0.248369E-01_JPRB, 0.231921E-01_JPRB, 0.216563E-01_JPRB, 0.202222E-01_JPRB, 0.188831E-01_JPRB /)  
+SELFREF(:, 6) = (/ &
+ & 0.613705E-01_JPRB, 0.562676E-01_JPRB, 0.515890E-01_JPRB, 0.472994E-01_JPRB, 0.433665E-01_JPRB, &
+ & 0.397606E-01_JPRB, 0.364545E-01_JPRB, 0.334233E-01_JPRB, 0.306442E-01_JPRB, 0.280961E-01_JPRB /)  
+SELFREF(:, 7) = (/ &
+ & 0.656981E-01_JPRB, 0.602660E-01_JPRB, 0.552830E-01_JPRB, 0.507120E-01_JPRB, 0.465190E-01_JPRB, &
+ & 0.426726E-01_JPRB, 0.391443E-01_JPRB, 0.359077E-01_JPRB, 0.329387E-01_JPRB, 0.302153E-01_JPRB /)  
+SELFREF(:, 8) = (/ &
+ & 0.671782E-01_JPRB, 0.616461E-01_JPRB, 0.565695E-01_JPRB, 0.519110E-01_JPRB, 0.476361E-01_JPRB, &
+ & 0.437132E-01_JPRB, 0.401134E-01_JPRB, 0.368100E-01_JPRB, 0.337787E-01_JPRB, 0.309970E-01_JPRB /)  
+SELFREF(:, 9) = (/ &
+ & 0.675902E-01_JPRB, 0.620888E-01_JPRB, 0.570351E-01_JPRB, 0.523928E-01_JPRB, 0.481284E-01_JPRB, &
+ & 0.442110E-01_JPRB, 0.406125E-01_JPRB, 0.373069E-01_JPRB, 0.342703E-01_JPRB, 0.314809E-01_JPRB /)  
+SELFREF(:,10) = (/ &
+ & 0.708308E-01_JPRB, 0.651419E-01_JPRB, 0.599099E-01_JPRB, 0.550981E-01_JPRB, 0.506728E-01_JPRB, &
+ & 0.466030E-01_JPRB, 0.428600E-01_JPRB, 0.394176E-01_JPRB, 0.362517E-01_JPRB, 0.333401E-01_JPRB /)  
+SELFREF(:,11) = (/ &
+ & 0.698445E-01_JPRB, 0.646584E-01_JPRB, 0.598573E-01_JPRB, 0.554128E-01_JPRB, 0.512982E-01_JPRB, &
+ & 0.474892E-01_JPRB, 0.439630E-01_JPRB, 0.406986E-01_JPRB, 0.376766E-01_JPRB, 0.348791E-01_JPRB /)  
+SELFREF(:,12) = (/ &
+ & 0.743921E-01_JPRB, 0.682057E-01_JPRB, 0.625337E-01_JPRB, 0.573334E-01_JPRB, 0.525655E-01_JPRB, &
+ & 0.481942E-01_JPRB, 0.441863E-01_JPRB, 0.405118E-01_JPRB, 0.371428E-01_JPRB, 0.340540E-01_JPRB /)  
+SELFREF(:,13) = (/ &
+ & 0.775758E-01_JPRB, 0.709818E-01_JPRB, 0.649484E-01_JPRB, 0.594277E-01_JPRB, 0.543764E-01_JPRB, &
+ & 0.497544E-01_JPRB, 0.455253E-01_JPRB, 0.416556E-01_JPRB, 0.381149E-01_JPRB, 0.348751E-01_JPRB /)  
+SELFREF(:,14) = (/ &
+ & 0.776545E-01_JPRB, 0.714761E-01_JPRB, 0.657894E-01_JPRB, 0.605550E-01_JPRB, 0.557372E-01_JPRB, &
+ & 0.513026E-01_JPRB, 0.472209E-01_JPRB, 0.434639E-01_JPRB, 0.400058E-01_JPRB, 0.368229E-01_JPRB /)  
+SELFREF(:,15) = (/ &
+ & 0.855675E-01_JPRB, 0.787337E-01_JPRB, 0.724456E-01_JPRB, 0.666598E-01_JPRB, 0.613360E-01_JPRB, &
+ & 0.564374E-01_JPRB, 0.519301E-01_JPRB, 0.477827E-01_JPRB, 0.439666E-01_JPRB, 0.404552E-01_JPRB /)  
+SELFREF(:,16) = (/ &
+ & 0.934781E-01_JPRB, 0.855190E-01_JPRB, 0.782376E-01_JPRB, 0.715761E-01_JPRB, 0.654819E-01_JPRB, &
+ & 0.599065E-01_JPRB, 0.548058E-01_JPRB, 0.501394E-01_JPRB, 0.458704E-01_JPRB, 0.419648E-01_JPRB /)  
+     
+!     -----------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB20',1,ZHOOK_HANDLE)
+RETURN
+
+1001 CONTINUE
+CALL ABOR1("SRTM_KGB20:ERROR READING FILE RADSRTM")
+
+END SUBROUTINE SRTM_KGB20
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb20.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb20.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb20.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SRTM_KGB20
+END SUBROUTINE SRTM_KGB20
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb21.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb21.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb21.F90	(revision 3908)
@@ -0,0 +1,207 @@
+SUBROUTINE SRTM_KGB21
+
+!     Originally by J.Delamere, Atmospheric & Environmental Research.
+!     Revision: 2.4
+!     BAND 21:  6150-7700 cm-1 (low - H2O,CO2; high - H2O,CO2)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+!     G.Mozdzynski March 2011 read constants from files
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  , ONLY : JPRB
+USE YOMHOOK   , ONLY : LHOOK, DR_HOOK
+USE YOMLUN    , ONLY : NULRAD
+USE YOMMP0    , ONLY : NPROC, MYPROC
+USE MPL_MODULE, ONLY : MPL_BROADCAST
+USE YOMTAG    , ONLY : MTAGRAD
+USE YOESRTA21 , ONLY : KA, KB, KA_D, KB_D, SELFREF, FORREF, SFLUXREF, RAYL, STRRAT, LAYREFFR  
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+
+! KURUCZ
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB21',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+ READ(NULRAD,ERR=1001) KA_D,KB_D
+  KA = REAL(KA_D,JPRB)
+  KB = REAL(KB_D,JPRB) 
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KA,MTAGRAD,1,CDSTRING='SRTM_KGB21:')
+  CALL MPL_BROADCAST (KB,MTAGRAD,1,CDSTRING='SRTM_KGB21:')
+ENDIF
+
+SFLUXREF(:, 1) = (/ &
+ & 16.1643_JPRB , 15.5806_JPRB, 14.7254_JPRB    , 13.5541_JPRB    , &
+ & 11.9519_JPRB ,10.44410_JPRB, 8.37884_JPRB    , 6.26384_JPRB    , &
+ & 4.28435_JPRB ,0.465228_JPRB, 0.385095_JPRB   ,0.304226_JPRB    , &
+ & 0.222479_JPRB,0.143286_JPRB, 5.58046E-02_JPRB, 7.84856E-03_JPRB /)  
+SFLUXREF(:, 2) = (/ &
+ & 15.6451_JPRB , 15.3170_JPRB, 14.6987_JPRB    , 13.7350_JPRB    , &
+ & 12.2267_JPRB ,10.51646_JPRB, 8.47150_JPRB    , 6.38873_JPRB    , &
+ & 4.33536_JPRB ,0.470610_JPRB,0.389426_JPRB    ,0.306461_JPRB    , &
+ & 0.223537_JPRB,0.143273_JPRB, 5.58179E-02_JPRB, 7.84856E-03_JPRB /)  
+SFLUXREF(:, 3) = (/ &
+ & 15.6092_JPRB , 15.3293_JPRB, 14.6881_JPRB    , 13.6693_JPRB    , &
+ & 12.2342_JPRB ,10.52010_JPRB, 8.49442_JPRB    , 6.42138_JPRB    , &
+ & 4.35865_JPRB ,0.473349_JPRB,0.391349_JPRB    ,0.308861_JPRB    , &
+ & 0.224666_JPRB,0.144799_JPRB, 5.58176E-02_JPRB, 7.84881E-03_JPRB /)  
+SFLUXREF(:, 4) = (/ &
+ & 15.5786_JPRB , 15.3422_JPRB, 14.6894_JPRB    , 13.6040_JPRB    , &
+ & 12.2567_JPRB ,10.49400_JPRB, 8.53521_JPRB    , 6.44427_JPRB    , &
+ & 4.37208_JPRB ,0.475709_JPRB,0.392956_JPRB    ,0.309737_JPRB    , &
+ & 0.226274_JPRB,0.146483_JPRB, 5.59325E-02_JPRB, 7.84881E-03_JPRB /)  
+SFLUXREF(:, 5) = (/ &
+ & 15.5380_JPRB , 15.3826_JPRB, 14.6575_JPRB    , 13.5722_JPRB    , &
+ & 12.2646_JPRB ,10.47672_JPRB, 8.57158_JPRB    , 6.46343_JPRB    , &
+ & 4.38259_JPRB ,0.477647_JPRB,0.393982_JPRB    ,0.310686_JPRB    , &
+ & 0.227620_JPRB,0.148376_JPRB, 5.60398E-02_JPRB, 7.83925E-03_JPRB /)  
+SFLUXREF(:, 6) = (/ &
+ & 15.5124_JPRB , 15.3986_JPRB, 14.6240_JPRB    , 13.5535_JPRB    , &
+ & 12.2468_JPRB ,10.48891_JPRB, 8.60434_JPRB    , 6.47985_JPRB    , &
+ & 4.39448_JPRB ,0.478267_JPRB,0.395618_JPRB    ,0.311043_JPRB    , &
+ & 0.230927_JPRB,0.148774_JPRB, 5.61189E-02_JPRB, 7.83925E-03_JPRB /)  
+SFLUXREF(:, 7) = (/ &
+ & 15.4910_JPRB , 15.4028_JPRB, 14.5772_JPRB    , 13.5507_JPRB    , &
+ & 12.2122_JPRB ,10.52735_JPRB, 8.62650_JPRB    , 6.49644_JPRB    , &
+ & 4.41173_JPRB ,0.478627_JPRB,0.396433_JPRB    ,0.314199_JPRB    ,  &
+ & 0.233125_JPRB,0.149052_JPRB, 5.62309E-02_JPRB, 7.83925E-03_JPRB /)  
+SFLUXREF(:, 8) = (/ &
+ & 15.4562_JPRB , 15.3928_JPRB, 14.5510_JPRB    , 13.5122_JPRB    , &
+ & 12.1890_JPRB , 10.5826_JPRB, 8.65842_JPRB    , 6.51558_JPRB    , &
+ & 4.42747_JPRB ,0.480669_JPRB,0.400143_JPRB    ,0.318144_JPRB    , &
+ & 0.233937_JPRB,0.149119_JPRB, 5.62309E-02_JPRB, 7.83925E-03_JPRB /)  
+SFLUXREF(:, 9) = (/ &
+ & 15.0069_JPRB , 15.1479_JPRB, 14.7802_JPRB    , 13.6085_JPRB    , &
+ & 12.2793_JPRB , 10.6929_JPRB, 8.72723_JPRB    , 6.57114_JPRB    , &
+ & 4.46330_JPRB ,0.486724_JPRB,0.401446_JPRB    ,0.318879_JPRB    , &
+ & 0.233959_JPRB,0.149119_JPRB, 5.62309E-02_JPRB, 7.83925E-03_JPRB /)  
+
+!     Rayleigh extinction coefficient at v = 6925 cm-1.
+RAYL = 9.41E-09_JPRB
+
+STRRAT = 0.0045321_JPRB
+
+LAYREFFR = 8
+
+!     ------------------------------------------------------------------
+
+!     The array KA contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels> ~100mb, temperatures, and binary
+!     species parameters (see taumol.f for definition).  The first 
+!     index in the array, JS, runs from 1 to 9, and corresponds to 
+!     different values of the binary species parameter.  For instance, 
+!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
+!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
+!     in the array, JT, which runs from 1 to 5, corresponds to different
+!     temperatures.  More specifically, JT = 3 means that the data are for
+!     the reference temperature TREF for this  pressure level, JT = 2 refers
+!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
+!     to the JPth reference pressure level (see taumol.f for these levels
+!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
+!     which g-interval the absorption coefficients are for.
+!     -----------------------------------------------------------------
+
+!     -----------------------------------------------------------------
+!     The array KB contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels < ~100mb and temperatures. The first 
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the reference temperature TREF for this pressure 
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
+!     The second index, JP, runs from 13 to 59 and refers to the JPth
+!     reference pressure level (see taumol.f for the value of these
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
+!     and tells us which g-interval the absorption coefficients are for.
+!     -----------------------------------------------------------------
+
+
+FORREF(:, 1) = (/ 0.110008E-06_JPRB, 0.630912E-06_JPRB, 0.363159E-05_JPRB, 0.616892E-05_JPRB /)
+FORREF(:, 2) = (/ 0.429709E-05_JPRB, 0.789174E-05_JPRB, 0.217416E-04_JPRB, 0.639393E-04_JPRB /)
+FORREF(:, 3) = (/ 0.436283E-04_JPRB, 0.526247E-04_JPRB, 0.116341E-03_JPRB, 0.205616E-03_JPRB /)
+FORREF(:, 4) = (/ 0.215627E-03_JPRB, 0.234522E-03_JPRB, 0.280497E-03_JPRB, 0.838668E-03_JPRB /)
+FORREF(:, 5) = (/ 0.529283E-03_JPRB, 0.620848E-03_JPRB, 0.935561E-03_JPRB, 0.171252E-02_JPRB /)
+FORREF(:, 6) = (/ 0.212267E-02_JPRB, 0.218564E-02_JPRB, 0.222227E-02_JPRB, 0.199650E-02_JPRB /)
+FORREF(:, 7) = (/ 0.291120E-02_JPRB, 0.281168E-02_JPRB, 0.259543E-02_JPRB, 0.210159E-02_JPRB /)
+FORREF(:, 8) = (/ 0.316249E-02_JPRB, 0.310695E-02_JPRB, 0.279501E-02_JPRB, 0.208076E-02_JPRB /)
+FORREF(:, 9) = (/ 0.354993E-02_JPRB, 0.336989E-02_JPRB, 0.298930E-02_JPRB, 0.180424E-02_JPRB /)
+FORREF(:,10) = (/ 0.397729E-02_JPRB, 0.367409E-02_JPRB, 0.328982E-02_JPRB, 0.177807E-02_JPRB /)
+FORREF(:,11) = (/ 0.408831E-02_JPRB, 0.398792E-02_JPRB, 0.352727E-02_JPRB, 0.192470E-02_JPRB /)
+FORREF(:,12) = (/ 0.433926E-02_JPRB, 0.420667E-02_JPRB, 0.383894E-02_JPRB, 0.220836E-02_JPRB /)
+FORREF(:,13) = (/ 0.436397E-02_JPRB, 0.433769E-02_JPRB, 0.425752E-02_JPRB, 0.237343E-02_JPRB /)
+FORREF(:,14) = (/ 0.440525E-02_JPRB, 0.449018E-02_JPRB, 0.451881E-02_JPRB, 0.269169E-02_JPRB /)
+FORREF(:,15) = (/ 0.491350E-02_JPRB, 0.481760E-02_JPRB, 0.475799E-02_JPRB, 0.362666E-02_JPRB /)
+FORREF(:,16) = (/ 0.561641E-02_JPRB, 0.524553E-02_JPRB, 0.512473E-02_JPRB, 0.493802E-02_JPRB /)
+
+!     -----------------------------------------------------------------
+!     The array SELFREF contains the coefficient of the water vapor
+!     self-continuum (including the energy term).  The first index
+!     refers to temperature in 7.2 degree increments.  For instance,
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+!     etc.  The second index runs over the g-channel (1 to 16).
+
+SELFREF(:, 1) = (/ &
+ & 0.115887E-03_JPRB, 0.926537E-04_JPRB, 0.740783E-04_JPRB, 0.592270E-04_JPRB, 0.473530E-04_JPRB, &
+ & 0.378596E-04_JPRB, 0.302694E-04_JPRB, 0.242010E-04_JPRB, 0.193491E-04_JPRB, 0.154700E-04_JPRB /)  
+SELFREF(:, 2) = (/ &
+ & 0.459557E-03_JPRB, 0.381962E-03_JPRB, 0.317469E-03_JPRB, 0.263866E-03_JPRB, 0.219313E-03_JPRB, &
+ & 0.182283E-03_JPRB, 0.151505E-03_JPRB, 0.125924E-03_JPRB, 0.104662E-03_JPRB, 0.869904E-04_JPRB /)  
+SELFREF(:, 3) = (/ &
+ & 0.166821E-02_JPRB, 0.151103E-02_JPRB, 0.136866E-02_JPRB, 0.123970E-02_JPRB, 0.112290E-02_JPRB, &
+ & 0.101710E-02_JPRB, 0.921266E-03_JPRB, 0.834463E-03_JPRB, 0.755839E-03_JPRB, 0.684623E-03_JPRB /)  
+SELFREF(:, 4) = (/ &
+ & 0.460175E-02_JPRB, 0.421372E-02_JPRB, 0.385842E-02_JPRB, 0.353307E-02_JPRB, 0.323516E-02_JPRB, &
+ & 0.296236E-02_JPRB, 0.271257E-02_JPRB, 0.248385E-02_JPRB, 0.227440E-02_JPRB, 0.208262E-02_JPRB /)  
+SELFREF(:, 5) = (/ &
+ & 0.101589E-01_JPRB, 0.924742E-02_JPRB, 0.841772E-02_JPRB, 0.766247E-02_JPRB, 0.697497E-02_JPRB, &
+ & 0.634917E-02_JPRB, 0.577951E-02_JPRB, 0.526096E-02_JPRB, 0.478893E-02_JPRB, 0.435926E-02_JPRB /)  
+SELFREF(:, 6) = (/ &
+ & 0.328043E-01_JPRB, 0.300853E-01_JPRB, 0.275917E-01_JPRB, 0.253048E-01_JPRB, 0.232075E-01_JPRB, &
+ & 0.212839E-01_JPRB, 0.195198E-01_JPRB, 0.179020E-01_JPRB, 0.164182E-01_JPRB, 0.150574E-01_JPRB /)  
+SELFREF(:, 7) = (/ &
+ & 0.405936E-01_JPRB, 0.376032E-01_JPRB, 0.348331E-01_JPRB, 0.322671E-01_JPRB, 0.298901E-01_JPRB, &
+ & 0.276883E-01_JPRB, 0.256486E-01_JPRB, 0.237591E-01_JPRB, 0.220089E-01_JPRB, 0.203876E-01_JPRB /)  
+SELFREF(:, 8) = (/ &
+ & 0.448362E-01_JPRB, 0.413811E-01_JPRB, 0.381923E-01_JPRB, 0.352492E-01_JPRB, 0.325329E-01_JPRB, &
+ & 0.300259E-01_JPRB, 0.277121E-01_JPRB, 0.255766E-01_JPRB, 0.236056E-01_JPRB, 0.217866E-01_JPRB /)  
+SELFREF(:, 9) = (/ &
+ & 0.479741E-01_JPRB, 0.445389E-01_JPRB, 0.413497E-01_JPRB, 0.383889E-01_JPRB, 0.356400E-01_JPRB, &
+ & 0.330880E-01_JPRB, 0.307188E-01_JPRB, 0.285191E-01_JPRB, 0.264770E-01_JPRB, 0.245812E-01_JPRB /)  
+SELFREF(:,10) = (/ &
+ & 0.519308E-01_JPRB, 0.484130E-01_JPRB, 0.451335E-01_JPRB, 0.420761E-01_JPRB, 0.392259E-01_JPRB, &
+ & 0.365687E-01_JPRB, 0.340916E-01_JPRB, 0.317822E-01_JPRB, 0.296293E-01_JPRB, 0.276222E-01_JPRB /)  
+SELFREF(:,11) = (/ &
+ & 0.572039E-01_JPRB, 0.527780E-01_JPRB, 0.486945E-01_JPRB, 0.449270E-01_JPRB, 0.414510E-01_JPRB, &
+ & 0.382439E-01_JPRB, 0.352849E-01_JPRB, 0.325549E-01_JPRB, 0.300361E-01_JPRB, 0.277122E-01_JPRB /)  
+SELFREF(:,12) = (/ &
+ & 0.601046E-01_JPRB, 0.554411E-01_JPRB, 0.511395E-01_JPRB, 0.471716E-01_JPRB, 0.435116E-01_JPRB, &
+ & 0.401356E-01_JPRB, 0.370215E-01_JPRB, 0.341490E-01_JPRB, 0.314994E-01_JPRB, 0.290554E-01_JPRB /)  
+SELFREF(:,13) = (/ &
+ & 0.616595E-01_JPRB, 0.567145E-01_JPRB, 0.521662E-01_JPRB, 0.479826E-01_JPRB, 0.441346E-01_JPRB, &
+ & 0.405951E-01_JPRB, 0.373395E-01_JPRB, 0.343450E-01_JPRB, 0.315906E-01_JPRB, 0.290571E-01_JPRB /)  
+SELFREF(:,14) = (/ &
+ & 0.647916E-01_JPRB, 0.592493E-01_JPRB, 0.541811E-01_JPRB, 0.495465E-01_JPRB, 0.453083E-01_JPRB, &
+ & 0.414326E-01_JPRB, 0.378885E-01_JPRB, 0.346475E-01_JPRB, 0.316837E-01_JPRB, 0.289735E-01_JPRB /)  
+SELFREF(:,15) = (/ &
+ & 0.694231E-01_JPRB, 0.637703E-01_JPRB, 0.585777E-01_JPRB, 0.538079E-01_JPRB, 0.494265E-01_JPRB, &
+ & 0.454019E-01_JPRB, 0.417050E-01_JPRB, 0.383091E-01_JPRB, 0.351897E-01_JPRB, 0.323244E-01_JPRB /)  
+SELFREF(:,16) = (/ &
+ & 0.761764E-01_JPRB, 0.701815E-01_JPRB, 0.646584E-01_JPRB, 0.595700E-01_JPRB, 0.548820E-01_JPRB, &
+ & 0.505629E-01_JPRB, 0.465838E-01_JPRB, 0.429178E-01_JPRB, 0.395403E-01_JPRB, 0.364286E-01_JPRB /)  
+
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB21',1,ZHOOK_HANDLE)
+RETURN
+
+1001 CONTINUE
+CALL ABOR1("SRTM_KGB21:ERROR READING FILE RADSRTM")
+
+END SUBROUTINE SRTM_KGB21
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb21.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb21.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb21.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SRTM_KGB21
+END SUBROUTINE SRTM_KGB21
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb22.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb22.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb22.F90	(revision 3908)
@@ -0,0 +1,207 @@
+SUBROUTINE SRTM_KGB22
+
+!     Originally by J.Delamere, Atmospheric & Environmental Research.
+!     Revision: 2.4
+!     BAND 16:  7700-8050 cm-1 (low - H2O,O2; high - O2)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+!     G.Mozdzynski March 2011 read constants from files
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  , ONLY : JPRB
+USE YOMHOOK   , ONLY : LHOOK, DR_HOOK
+USE YOMLUN    , ONLY : NULRAD
+USE YOMMP0    , ONLY : NPROC, MYPROC
+USE MPL_MODULE, ONLY : MPL_BROADCAST
+USE YOMTAG    , ONLY : MTAGRAD
+USE YOESRTA22 , ONLY : KA, KB, KA_D, KB_D, SELFREF, FORREF, SFLUXREF, RAYL, STRRAT, LAYREFFR  
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+
+! KURUCZ
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB22',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+ READ(NULRAD,ERR=1001) KA_D,KB_D
+  KA = REAL(KA_D,JPRB)
+  KB = REAL(KB_D,JPRB) 
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KA,MTAGRAD,1,CDSTRING='SRTM_KGB22:')
+  CALL MPL_BROADCAST (KB,MTAGRAD,1,CDSTRING='SRTM_KGB22:')
+ENDIF
+
+SFLUXREF(:, 1) = (/ &
+ & 3.71641_JPRB    ,3.63190_JPRB    ,3.44795_JPRB    ,3.17936_JPRB    , &
+ & 2.86071_JPRB    ,2.48490_JPRB    ,2.02471_JPRB    ,1.52475_JPRB    , &
+ & 1.03811_JPRB    ,0.113272_JPRB   ,9.37115E-02_JPRB,7.38969E-02_JPRB, &
+ & 5.44713E-02_JPRB,3.45905E-02_JPRB,1.30293E-02_JPRB,1.84198E-03_JPRB /)  
+SFLUXREF(:, 2) = (/ &
+ & 3.73933_JPRB    ,3.60360_JPRB    ,3.43370_JPRB    ,3.19749_JPRB    ,  &
+ & 2.87747_JPRB    ,2.47926_JPRB    ,2.02175_JPRB    ,1.52010_JPRB    , &
+ & 1.03612_JPRB    ,0.113265_JPRB   ,9.37145E-02_JPRB,7.38951E-02_JPRB, &
+ & 5.44714E-02_JPRB,3.45906E-02_JPRB,1.30293E-02_JPRB,1.84198E-03_JPRB /)  
+SFLUXREF(:, 3) = (/ &
+ & 3.73889_JPRB    ,3.60279_JPRB    ,3.43404_JPRB    ,3.20560_JPRB    , &
+ & 2.87367_JPRB    ,2.47515_JPRB    ,2.02412_JPRB    ,1.52315_JPRB    , &
+ & 1.03146_JPRB    ,0.113272_JPRB   ,9.36707E-02_JPRB,7.39080E-02_JPRB, &
+ & 5.44598E-02_JPRB,3.45906E-02_JPRB,1.30293E-02_JPRB,1.84198E-03_JPRB /)  
+SFLUXREF(:, 4) = (/ &
+ & 3.73801_JPRB    ,3.60530_JPRB    ,3.43659_JPRB    ,3.20640_JPRB    , &
+ & 2.87039_JPRB    ,2.47330_JPRB    ,2.02428_JPRB    ,1.52509_JPRB    , &
+ & 1.03037_JPRB    ,0.112553_JPRB   ,9.35352E-02_JPRB,7.39675E-02_JPRB, &
+ & 5.43951E-02_JPRB,3.45669E-02_JPRB,1.30292E-02_JPRB,1.84198E-03_JPRB /)  
+SFLUXREF(:, 5) = (/ &
+ & 3.73809_JPRB    ,3.60996_JPRB    ,3.43602_JPRB    ,3.20364_JPRB    , &
+ & 2.87005_JPRB    ,2.47343_JPRB    ,2.02353_JPRB    ,1.52617_JPRB    , &
+ & 1.03138_JPRB    ,0.111172_JPRB   ,9.29885E-02_JPRB,7.35034E-02_JPRB, &
+ & 5.42427E-02_JPRB,3.45732E-02_JPRB,1.30169E-02_JPRB,1.84550E-03_JPRB /)  
+SFLUXREF(:, 6) = (/ &
+ & 3.73872_JPRB    ,3.62054_JPRB    ,3.42934_JPRB    ,3.20110_JPRB    , &
+ & 2.86886_JPRB    ,2.47379_JPRB    ,2.02237_JPRB    ,1.52754_JPRB    ,  &
+ & 1.03228_JPRB    ,0.111597_JPRB   ,9.12252E-02_JPRB,7.33115E-02_JPRB, &
+ & 5.35600E-02_JPRB,3.45187E-02_JPRB,1.30184E-02_JPRB,1.84551E-03_JPRB /)  
+SFLUXREF(:, 7) = (/ &
+ & 3.73969_JPRB    ,3.65461_JPRB    ,3.40646_JPRB    ,3.19082_JPRB    , &
+ & 2.86919_JPRB    ,2.47289_JPRB    ,2.02312_JPRB    ,1.52629_JPRB    , &
+ & 1.03329_JPRB    ,0.111611_JPRB   ,9.16275E-02_JPRB,7.14731E-02_JPRB, &
+ & 5.31771E-02_JPRB,3.44980E-02_JPRB,1.30190E-02_JPRB,1.84551E-03_JPRB /)  
+SFLUXREF(:, 8) = (/ &
+ & 3.73995_JPRB    ,3.65348_JPRB    ,3.43707_JPRB    ,3.16351_JPRB    , &
+ & 2.87003_JPRB    ,2.47392_JPRB    ,2.02114_JPRB    ,1.52548_JPRB    ,  &
+ & 1.03306_JPRB    ,0.111088_JPRB   ,9.12422E-02_JPRB,7.11146E-02_JPRB, &
+ & 5.31333E-02_JPRB,3.45302E-02_JPRB,1.30209E-02_JPRB,1.84554E-03_JPRB /)  
+SFLUXREF(:, 9) = (/ &
+ & 3.73788_JPRB    ,3.65004_JPRB    ,3.46938_JPRB    ,3.15236_JPRB    , &
+ & 2.86381_JPRB    ,2.47393_JPRB    ,2.01715_JPRB    ,1.52134_JPRB    , &
+ & 1.03163_JPRB    ,0.111259_JPRB   ,9.12948E-02_JPRB,7.09999E-02_JPRB, &
+ & 5.31792E-02_JPRB,3.44955E-02_JPRB,1.30189E-02_JPRB,1.84551E-03_JPRB /)  
+
+!     Rayleigh extinction coefficient at v = 8000 cm-1.
+RAYL = 1.54E-08_JPRB
+
+STRRAT = 0.022708_JPRB
+
+LAYREFFR = 2
+
+!     ------------------------------------------------------------------
+
+!     The array KA contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels> ~100mb, temperatures, and binary
+!     species parameters (see taumol.f for definition).  The first 
+!     index in the array, JS, runs from 1 to 9, and corresponds to 
+!     different values of the binary species parameter.  For instance, 
+!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
+!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
+!     in the array, JT, which runs from 1 to 5, corresponds to different
+!     temperatures.  More specifically, JT = 3 means that the data are for
+!     the reference temperature TREF for this  pressure level, JT = 2 refers
+!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
+!     to the JPth reference pressure level (see taumol.f for these levels
+!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
+!     which g-interval the absorption coefficients are for.
+!     -----------------------------------------------------------------
+
+!     -----------------------------------------------------------------
+!     The array KB contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels < ~100mb and temperatures. The first 
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the reference temperature TREF for this pressure 
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
+!     The second index, JP, runs from 13 to 59 and refers to the JPth
+!     reference pressure level (see taumol.f for the value of these
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
+!     and tells us which g-interval the absorption coefficients are for.
+!     -----------------------------------------------------------------
+
+
+FORREF(:, 1) = (/ 0.351362E-07_JPRB, 0.341136E-07_JPRB, 0.181317E-06_JPRB /)
+FORREF(:, 2) = (/ 0.109648E-06_JPRB, 0.344240E-06_JPRB, 0.139709E-05_JPRB /)
+FORREF(:, 3) = (/ 0.374823E-06_JPRB, 0.103424E-05_JPRB, 0.188717E-05_JPRB /)
+FORREF(:, 4) = (/ 0.580041E-06_JPRB, 0.116876E-05_JPRB, 0.121183E-05_JPRB /)
+FORREF(:, 5) = (/ 0.115608E-05_JPRB, 0.148110E-05_JPRB, 0.836083E-06_JPRB /)
+FORREF(:, 6) = (/ 0.181460E-05_JPRB, 0.133313E-05_JPRB, 0.500167E-06_JPRB /)
+FORREF(:, 7) = (/ 0.199096E-05_JPRB, 0.115276E-05_JPRB, 0.432994E-06_JPRB /)
+FORREF(:, 8) = (/ 0.183730E-05_JPRB, 0.122260E-05_JPRB, 0.433248E-06_JPRB /)
+FORREF(:, 9) = (/ 0.198386E-05_JPRB, 0.100130E-05_JPRB, 0.269712E-06_JPRB /)
+FORREF(:,10) = (/ 0.276382E-05_JPRB, 0.749215E-06_JPRB, 0.236919E-06_JPRB /)
+FORREF(:,11) = (/ 0.298202E-05_JPRB, 0.629688E-06_JPRB, 0.228388E-06_JPRB /)
+FORREF(:,12) = (/ 0.364604E-05_JPRB, 0.455336E-06_JPRB, 0.206130E-06_JPRB /)
+FORREF(:,13) = (/ 0.373339E-05_JPRB, 0.245210E-06_JPRB, 0.201987E-06_JPRB /)
+FORREF(:,14) = (/ 0.480378E-05_JPRB, 0.177591E-06_JPRB, 0.171458E-06_JPRB /)
+FORREF(:,15) = (/ 0.521700E-05_JPRB, 0.203358E-06_JPRB, 0.189559E-06_JPRB /)
+FORREF(:,16) = (/ 0.542717E-05_JPRB, 0.219022E-06_JPRB, 0.218271E-06_JPRB /)
+
+!     -----------------------------------------------------------------
+!     The array SELFREF contains the coefficient of the water vapor
+!     self-continuum (including the energy term).  The first index
+!     refers to temperature in 7.2 degree increments.  For instance,
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+!     etc.  The second index runs over the g-channel (1 to 16).
+
+SELFREF(:, 1) = (/ &
+ & 0.538526E-04_JPRB, 0.464603E-04_JPRB, 0.400828E-04_JPRB, 0.345807E-04_JPRB, 0.298339E-04_JPRB, &
+ & 0.257386E-04_JPRB, 0.222055E-04_JPRB, 0.191574E-04_JPRB, 0.165277E-04_JPRB, 0.142590E-04_JPRB /)  
+SELFREF(:, 2) = (/ &
+ & 0.162409E-03_JPRB, 0.128347E-03_JPRB, 0.101430E-03_JPRB, 0.801571E-04_JPRB, 0.633460E-04_JPRB, &
+ & 0.500607E-04_JPRB, 0.395616E-04_JPRB, 0.312645E-04_JPRB, 0.247075E-04_JPRB, 0.195257E-04_JPRB /)  
+SELFREF(:, 3) = (/ &
+ & 0.262882E-03_JPRB, 0.212793E-03_JPRB, 0.172247E-03_JPRB, 0.139427E-03_JPRB, 0.112860E-03_JPRB, &
+ & 0.913557E-04_JPRB, 0.739487E-04_JPRB, 0.598584E-04_JPRB, 0.484529E-04_JPRB, 0.392206E-04_JPRB /)  
+SELFREF(:, 4) = (/ &
+ & 0.242873E-03_JPRB, 0.204225E-03_JPRB, 0.171726E-03_JPRB, 0.144399E-03_JPRB, 0.121421E-03_JPRB, &
+ & 0.102099E-03_JPRB, 0.858516E-04_JPRB, 0.721899E-04_JPRB, 0.607022E-04_JPRB, 0.510426E-04_JPRB /)  
+SELFREF(:, 5) = (/ &
+ & 0.235614E-03_JPRB, 0.207814E-03_JPRB, 0.183293E-03_JPRB, 0.161666E-03_JPRB, 0.142591E-03_JPRB, &
+ & 0.125766E-03_JPRB, 0.110927E-03_JPRB, 0.978381E-04_JPRB, 0.862939E-04_JPRB, 0.761119E-04_JPRB /)  
+SELFREF(:, 6) = (/ &
+ & 0.205508E-03_JPRB, 0.190174E-03_JPRB, 0.175985E-03_JPRB, 0.162854E-03_JPRB, 0.150702E-03_JPRB, &
+ & 0.139458E-03_JPRB, 0.129052E-03_JPRB, 0.119423E-03_JPRB, 0.110513E-03_JPRB, 0.102267E-03_JPRB /)  
+SELFREF(:, 7) = (/ &
+ & 0.185027E-03_JPRB, 0.175148E-03_JPRB, 0.165796E-03_JPRB, 0.156944E-03_JPRB, 0.148565E-03_JPRB, &
+ & 0.140633E-03_JPRB, 0.133124E-03_JPRB, 0.126016E-03_JPRB, 0.119288E-03_JPRB, 0.112919E-03_JPRB /)  
+SELFREF(:, 8) = (/ &
+ & 0.192634E-03_JPRB, 0.180192E-03_JPRB, 0.168554E-03_JPRB, 0.157668E-03_JPRB, 0.147484E-03_JPRB, &
+ & 0.137959E-03_JPRB, 0.129048E-03_JPRB, 0.120713E-03_JPRB, 0.112917E-03_JPRB, 0.105624E-03_JPRB /)  
+SELFREF(:, 9) = (/ &
+ & 0.161632E-03_JPRB, 0.155919E-03_JPRB, 0.150408E-03_JPRB, 0.145092E-03_JPRB, 0.139963E-03_JPRB, &
+ & 0.135016E-03_JPRB, 0.130244E-03_JPRB, 0.125640E-03_JPRB, 0.121199E-03_JPRB, 0.116915E-03_JPRB /)  
+SELFREF(:,10) = (/ &
+ & 0.120880E-03_JPRB, 0.125265E-03_JPRB, 0.129810E-03_JPRB, 0.134520E-03_JPRB, 0.139400E-03_JPRB, &
+ & 0.144458E-03_JPRB, 0.149699E-03_JPRB, 0.155130E-03_JPRB, 0.160758E-03_JPRB, 0.166591E-03_JPRB /)  
+SELFREF(:,11) = (/ &
+ & 0.104705E-03_JPRB, 0.111761E-03_JPRB, 0.119291E-03_JPRB, 0.127330E-03_JPRB, 0.135910E-03_JPRB, &
+ & 0.145068E-03_JPRB, 0.154843E-03_JPRB, 0.165277E-03_JPRB, 0.176414E-03_JPRB, 0.188302E-03_JPRB /)  
+SELFREF(:,12) = (/ &
+ & 0.846335E-04_JPRB, 0.951236E-04_JPRB, 0.106914E-03_JPRB, 0.120166E-03_JPRB, 0.135060E-03_JPRB, &
+ & 0.151800E-03_JPRB, 0.170616E-03_JPRB, 0.191763E-03_JPRB, 0.215532E-03_JPRB, 0.242246E-03_JPRB /)  
+SELFREF(:,13) = (/ &
+ & 0.669754E-04_JPRB, 0.781902E-04_JPRB, 0.912829E-04_JPRB, 0.106568E-03_JPRB, 0.124413E-03_JPRB, &
+ & 0.145245E-03_JPRB, 0.169566E-03_JPRB, 0.197959E-03_JPRB, 0.231107E-03_JPRB, 0.269805E-03_JPRB /)  
+SELFREF(:,14) = (/ &
+ & 0.597091E-04_JPRB, 0.722265E-04_JPRB, 0.873679E-04_JPRB, 0.105684E-03_JPRB, 0.127839E-03_JPRB, &
+ & 0.154639E-03_JPRB, 0.187057E-03_JPRB, 0.226272E-03_JPRB, 0.273707E-03_JPRB, 0.331087E-03_JPRB /)  
+SELFREF(:,15) = (/ &
+ & 0.640410E-04_JPRB, 0.771879E-04_JPRB, 0.930338E-04_JPRB, 0.112133E-03_JPRB, 0.135152E-03_JPRB, &
+ & 0.162897E-03_JPRB, 0.196338E-03_JPRB, 0.236644E-03_JPRB, 0.285225E-03_JPRB, 0.343778E-03_JPRB /)  
+SELFREF(:,16) = (/ &
+ & 0.666420E-04_JPRB, 0.801056E-04_JPRB, 0.962892E-04_JPRB, 0.115742E-03_JPRB, 0.139126E-03_JPRB, &
+ & 0.167233E-03_JPRB, 0.201019E-03_JPRB, 0.241630E-03_JPRB, 0.290446E-03_JPRB, 0.349125E-03_JPRB /)  
+
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB22',1,ZHOOK_HANDLE)
+RETURN
+
+1001 CONTINUE
+CALL ABOR1("SRTM_KGB22:ERROR READING FILE RADSRTM")
+
+END SUBROUTINE SRTM_KGB22
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb22.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb22.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb22.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SRTM_KGB22
+END SUBROUTINE SRTM_KGB22
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb23.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb23.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb23.F90	(revision 3908)
@@ -0,0 +1,155 @@
+SUBROUTINE SRTM_KGB23
+
+!     Originally by J.Delamere, Atmospheric & Environmental Research.
+!     Revision: 2.4
+!     BAND 16:  8050-12850 cm-1 (low - H2O; high - nothing)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     G.Mozdzynski March 2011 read constants from files
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  , ONLY : JPRB
+USE YOMHOOK   , ONLY : LHOOK, DR_HOOK
+USE YOMLUN    , ONLY : NULRAD
+USE YOMMP0    , ONLY : NPROC, MYPROC
+USE MPL_MODULE, ONLY : MPL_BROADCAST
+USE YOMTAG    , ONLY : MTAGRAD
+USE YOESRTA23 , ONLY : KA, KA_D,SELFREF, FORREF, SFLUXREF, RAYL, GIVFAC, LAYREFFR  
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+
+! KURUCZ
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB23',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+  READ(NULRAD,ERR=1001) KA_D
+  KA = REAL(KA_D,JPRB)
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KA,MTAGRAD,1,CDSTRING='SRTM_KGB23:')
+ENDIF
+
+SFLUXREF = (/ &
+ & 53.2101_JPRB , 51.4143_JPRB, 49.3348_JPRB, 45.4612_JPRB    , &
+ & 40.8294_JPRB , 35.1801_JPRB, 28.6947_JPRB, 21.5751_JPRB    , &
+ & 14.6388_JPRB , 1.59111_JPRB, 1.31860_JPRB, 1.04018_JPRB    , &
+ & 0.762140_JPRB,0.484214_JPRB,0.182275_JPRB, 2.54948E-02_JPRB /)  
+
+!     Rayleigh extinction coefficient at all v 
+RAYL = (/ &
+ & 5.94837E-08_JPRB,5.70593E-08_JPRB,6.27845E-08_JPRB,5.56602E-08_JPRB, &
+ & 5.25571E-08_JPRB,4.73388E-08_JPRB,4.17466E-08_JPRB,3.98097E-08_JPRB, &
+ & 4.00786E-08_JPRB,3.67478E-08_JPRB,3.45186E-08_JPRB,3.46156E-08_JPRB, &
+ & 3.32155E-08_JPRB,3.23642E-08_JPRB,2.72590E-08_JPRB,2.96813E-08_JPRB /)  
+
+!     Average Giver et al. correction factor for this band.
+GIVFAC = 1.029_JPRB
+
+LAYREFFR = 6
+
+!     ------------------------------------------------------------------
+
+!     The array KA contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels> ~100mb, temperatures, and binary
+!     species parameters (see taumol.f for definition).  The first 
+!     index in the array, JS, runs from 1 to 9, and corresponds to 
+!     different values of the binary species parameter.  For instance, 
+!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
+!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
+!     in the array, JT, which runs from 1 to 5, corresponds to different
+!     temperatures.  More specifically, JT = 3 means that the data are for
+!     the reference temperature TREF for this  pressure level, JT = 2 refers
+!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
+!     to the JPth reference pressure level (see taumol.f for these levels
+!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
+!     which g-interval the absorption coefficients are for.
+!     -----------------------------------------------------------------
+
+FORREF(:, 1) = (/ 0.315770E-07_JPRB, 0.671978E-07_JPRB, 0.440649E-06_JPRB /)
+FORREF(:, 2) = (/ 0.313674E-06_JPRB, 0.285252E-06_JPRB, 0.421024E-05_JPRB /)
+FORREF(:, 3) = (/ 0.135818E-05_JPRB, 0.145071E-05_JPRB, 0.611285E-05_JPRB /)
+FORREF(:, 4) = (/ 0.534065E-05_JPRB, 0.586268E-05_JPRB, 0.933970E-05_JPRB /)
+FORREF(:, 5) = (/ 0.964007E-05_JPRB, 0.107110E-04_JPRB, 0.104486E-04_JPRB /)
+FORREF(:, 6) = (/ 0.302775E-04_JPRB, 0.357530E-04_JPRB, 0.340724E-04_JPRB /)
+FORREF(:, 7) = (/ 0.102437E-03_JPRB, 0.108475E-03_JPRB, 0.105245E-03_JPRB /)
+FORREF(:, 8) = (/ 0.146054E-03_JPRB, 0.141490E-03_JPRB, 0.133071E-03_JPRB /)
+FORREF(:, 9) = (/ 0.163978E-03_JPRB, 0.150208E-03_JPRB, 0.142864E-03_JPRB /)
+FORREF(:,10) = (/ 0.220412E-03_JPRB, 0.182943E-03_JPRB, 0.150941E-03_JPRB /)
+FORREF(:,11) = (/ 0.228877E-03_JPRB, 0.197679E-03_JPRB, 0.163220E-03_JPRB /)
+FORREF(:,12) = (/ 0.234177E-03_JPRB, 0.217734E-03_JPRB, 0.185038E-03_JPRB /)
+FORREF(:,13) = (/ 0.257187E-03_JPRB, 0.241570E-03_JPRB, 0.221178E-03_JPRB /)
+FORREF(:,14) = (/ 0.272455E-03_JPRB, 0.270637E-03_JPRB, 0.256269E-03_JPRB /)
+FORREF(:,15) = (/ 0.339445E-03_JPRB, 0.300268E-03_JPRB, 0.286574E-03_JPRB /)
+FORREF(:,16) = (/ 0.338841E-03_JPRB, 0.355428E-03_JPRB, 0.353794E-03_JPRB /)
+
+!     -----------------------------------------------------------------
+!     The array SELFREF contains the coefficient of the water vapor
+!     self-continuum (including the energy term).  The first index
+!     refers to temperature in 7.2 degree increments.  For instance,
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+!     etc.  The second index runs over the g-channel (1 to 16).
+
+SELFREF(:, 1) = (/ &
+ & 0.100945E-04_JPRB, 0.801113E-05_JPRB, 0.635771E-05_JPRB, 0.504554E-05_JPRB, 0.400419E-05_JPRB, &
+ & 0.317777E-05_JPRB, 0.252191E-05_JPRB, 0.200141E-05_JPRB, 0.158834E-05_JPRB, 0.126052E-05_JPRB /)  
+SELFREF(:, 2) = (/ &
+ & 0.107573E-04_JPRB, 0.999809E-05_JPRB, 0.929245E-05_JPRB, 0.863661E-05_JPRB, 0.802706E-05_JPRB, &
+ & 0.746053E-05_JPRB, 0.693399E-05_JPRB, 0.644460E-05_JPRB, 0.598976E-05_JPRB, 0.556702E-05_JPRB /)  
+SELFREF(:, 3) = (/ &
+ & 0.350389E-04_JPRB, 0.319234E-04_JPRB, 0.290850E-04_JPRB, 0.264989E-04_JPRB, 0.241428E-04_JPRB, &
+ & 0.219962E-04_JPRB, 0.200404E-04_JPRB, 0.182586E-04_JPRB, 0.166351E-04_JPRB, 0.151560E-04_JPRB /)  
+SELFREF(:, 4) = (/ &
+ & 0.122993E-03_JPRB, 0.110885E-03_JPRB, 0.999691E-04_JPRB, 0.901277E-04_JPRB, 0.812551E-04_JPRB, &
+ & 0.732559E-04_JPRB, 0.660443E-04_JPRB, 0.595426E-04_JPRB, 0.536809E-04_JPRB, 0.483963E-04_JPRB /)  
+SELFREF(:, 5) = (/ &
+ & 0.206434E-03_JPRB, 0.187435E-03_JPRB, 0.170185E-03_JPRB, 0.154522E-03_JPRB, 0.140301E-03_JPRB, &
+ & 0.127388E-03_JPRB, 0.115664E-03_JPRB, 0.105019E-03_JPRB, 0.953540E-04_JPRB, 0.865783E-04_JPRB /)  
+SELFREF(:, 6) = (/ &
+ & 0.590645E-03_JPRB, 0.533109E-03_JPRB, 0.481177E-03_JPRB, 0.434305E-03_JPRB, 0.391998E-03_JPRB, &
+ & 0.353812E-03_JPRB, 0.319346E-03_JPRB, 0.288238E-03_JPRB, 0.260160E-03_JPRB, 0.234817E-03_JPRB /)  
+SELFREF(:, 7) = (/ &
+ & 0.163029E-02_JPRB, 0.148773E-02_JPRB, 0.135763E-02_JPRB, 0.123891E-02_JPRB, 0.113057E-02_JPRB, &
+ & 0.103170E-02_JPRB, 0.941483E-03_JPRB, 0.859153E-03_JPRB, 0.784023E-03_JPRB, 0.715462E-03_JPRB /)  
+SELFREF(:, 8) = (/ &
+ & 0.204528E-02_JPRB, 0.189258E-02_JPRB, 0.175128E-02_JPRB, 0.162053E-02_JPRB, 0.149954E-02_JPRB, &
+ & 0.138758E-02_JPRB, 0.128398E-02_JPRB, 0.118812E-02_JPRB, 0.109941E-02_JPRB, 0.101733E-02_JPRB /)  
+SELFREF(:, 9) = (/ &
+ & 0.210589E-02_JPRB, 0.197078E-02_JPRB, 0.184434E-02_JPRB, 0.172601E-02_JPRB, 0.161528E-02_JPRB, &
+ & 0.151164E-02_JPRB, 0.141466E-02_JPRB, 0.132390E-02_JPRB, 0.123896E-02_JPRB, 0.115947E-02_JPRB /)  
+SELFREF(:,10) = (/ &
+ & 0.245098E-02_JPRB, 0.233745E-02_JPRB, 0.222918E-02_JPRB, 0.212592E-02_JPRB, 0.202745E-02_JPRB, &
+ & 0.193353E-02_JPRB, 0.184397E-02_JPRB, 0.175856E-02_JPRB, 0.167710E-02_JPRB, 0.159941E-02_JPRB /)  
+SELFREF(:,11) = (/ &
+ & 0.267460E-02_JPRB, 0.253325E-02_JPRB, 0.239936E-02_JPRB, 0.227255E-02_JPRB, 0.215244E-02_JPRB, &
+ & 0.203868E-02_JPRB, 0.193093E-02_JPRB, 0.182888E-02_JPRB, 0.173222E-02_JPRB, 0.164067E-02_JPRB /)  
+SELFREF(:,12) = (/ &
+ & 0.304510E-02_JPRB, 0.283919E-02_JPRB, 0.264720E-02_JPRB, 0.246820E-02_JPRB, 0.230130E-02_JPRB, &
+ & 0.214568E-02_JPRB, 0.200059E-02_JPRB, 0.186531E-02_JPRB, 0.173918E-02_JPRB, 0.162157E-02_JPRB /)  
+SELFREF(:,13) = (/ &
+ & 0.338445E-02_JPRB, 0.314719E-02_JPRB, 0.292655E-02_JPRB, 0.272139E-02_JPRB, 0.253060E-02_JPRB, &
+ & 0.235319E-02_JPRB, 0.218822E-02_JPRB, 0.203482E-02_JPRB, 0.189217E-02_JPRB, 0.175952E-02_JPRB /)  
+SELFREF(:,14) = (/ &
+ & 0.388649E-02_JPRB, 0.357018E-02_JPRB, 0.327961E-02_JPRB, 0.301269E-02_JPRB, 0.276750E-02_JPRB, &
+ & 0.254226E-02_JPRB, 0.233535E-02_JPRB, 0.214528E-02_JPRB, 0.197068E-02_JPRB, 0.181029E-02_JPRB /)  
+SELFREF(:,15) = (/ &
+ & 0.412547E-02_JPRB, 0.387413E-02_JPRB, 0.363810E-02_JPRB, 0.341646E-02_JPRB, 0.320831E-02_JPRB, &
+ & 0.301285E-02_JPRB, 0.282930E-02_JPRB, 0.265693E-02_JPRB, 0.249506E-02_JPRB, 0.234305E-02_JPRB /)  
+SELFREF(:,16) = (/ &
+ & 0.534327E-02_JPRB, 0.482967E-02_JPRB, 0.436544E-02_JPRB, 0.394583E-02_JPRB, 0.356655E-02_JPRB, &
+ & 0.322373E-02_JPRB, 0.291387E-02_JPRB, 0.263378E-02_JPRB, 0.238062E-02_JPRB, 0.215179E-02_JPRB /)  
+     
+!     -----------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB23',1,ZHOOK_HANDLE)
+RETURN
+
+1001 CONTINUE
+CALL ABOR1("SRTM_KGB23:ERROR READING FILE RADSRTM")
+
+END SUBROUTINE SRTM_KGB23
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb23.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb23.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb23.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SRTM_KGB23
+END SUBROUTINE SRTM_KGB23
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb24.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb24.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb24.F90	(revision 3908)
@@ -0,0 +1,270 @@
+SUBROUTINE SRTM_KGB24
+
+!     Originally by J.Delamere, Atmospheric & Environmental Research.
+!     Revision: 2.4
+!     BAND 24: 12850-16000 cm-1 (low - H2O,O2; high - O2)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+!     G.Mozdzynski March 2011 read constants from files
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  , ONLY : JPRB
+USE YOMHOOK   , ONLY : LHOOK, DR_HOOK
+USE YOMLUN    , ONLY : NULRAD
+USE YOMMP0    , ONLY : NPROC, MYPROC
+USE MPL_MODULE, ONLY : MPL_BROADCAST
+USE YOMTAG    , ONLY : MTAGRAD
+USE YOESRTA24 , ONLY : KA, KB, KA_D, KB_D, SELFREF, FORREF, SFLUXREF, RAYLA, RAYLB, &
+ & ABSO3A, ABSO3B, STRRAT, LAYREFFR  
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+
+! KURUCZ
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB24',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+  READ(NULRAD,ERR=1001) KA_D,KB_D
+  KA = REAL(KA_D,JPRB)
+  KB = REAL(KB_D,JPRB) 
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KA,MTAGRAD,1,CDSTRING='SRTM_KGB24:')
+  CALL MPL_BROADCAST (KB,MTAGRAD,1,CDSTRING='SRTM_KGB24:')
+ENDIF
+
+SFLUXREF(:,1) = (/ &
+ & 34.3610_JPRB , 33.1240_JPRB, 31.3948_JPRB, 28.7248_JPRB, &
+ & 24.7884_JPRB , 21.4892_JPRB, 17.3972_JPRB, 13.7928_JPRB, &
+ & 9.54462_JPRB , 1.05002_JPRB,0.867332_JPRB,0.685753_JPRB, &
+ & 0.504718_JPRB,0.323112_JPRB,0.122183_JPRB, 1.70288E-02_JPRB /)  
+SFLUXREF(:,2) = (/ &
+ & 34.2367_JPRB , 32.4327_JPRB, 30.0863_JPRB, 28.2085_JPRB,  &
+ & 25.6533_JPRB , 22.3412_JPRB, 18.3112_JPRB, 13.8521_JPRB, &
+ & 9.51035_JPRB , 1.04138_JPRB,0.863493_JPRB,0.682790_JPRB, &
+ & 0.504721_JPRB,0.323102_JPRB,0.122193_JPRB, 1.70288E-02_JPRB /)  
+SFLUXREF(:,3) = (/ &
+ & 34.1883_JPRB , 32.2479_JPRB, 30.2650_JPRB, 28.2914_JPRB, &
+ & 25.6626_JPRB , 22.3163_JPRB, 18.3327_JPRB, 13.8508_JPRB, &
+ & 9.49190_JPRB , 1.03672_JPRB,0.858272_JPRB,0.681485_JPRB, &
+ & 0.501363_JPRB,0.323110_JPRB,0.122183_JPRB, 1.70288E-02_JPRB /)  
+SFLUXREF(:,4) = (/ &
+ & 34.1365_JPRB , 32.2316_JPRB, 30.3325_JPRB, 28.3305_JPRB, &
+ & 25.6420_JPRB , 22.3223_JPRB, 18.3411_JPRB, 13.8471_JPRB, &
+ & 9.47492_JPRB , 1.03376_JPRB,0.855380_JPRB,0.679085_JPRB, &
+ & 0.497998_JPRB,0.323053_JPRB,0.122183_JPRB, 1.70288E-02_JPRB /)  
+SFLUXREF(:,5) = (/ &
+ & 34.0460_JPRB , 32.2795_JPRB, 30.4147_JPRB, 28.3123_JPRB, &
+ & 25.6438_JPRB , 22.3238_JPRB, 18.3441_JPRB, 13.8528_JPRB, &
+ & 9.45222_JPRB , 1.03058_JPRB,0.854037_JPRB,0.675554_JPRB, &
+ & 0.498344_JPRB,0.320072_JPRB,0.122193_JPRB, 1.70288E-02_JPRB /)  
+SFLUXREF(:,6) = (/ &
+ & 33.9909_JPRB , 32.3127_JPRB, 30.4854_JPRB, 28.3005_JPRB, &
+ & 25.6310_JPRB , 22.3294_JPRB, 18.3459_JPRB, 13.8488_JPRB, &
+ & 9.43336_JPRB , 1.02901_JPRB,0.852728_JPRB,0.672322_JPRB, &
+ & 0.498056_JPRB,0.317753_JPRB,0.122183_JPRB, 1.70288E-02_JPRB /)  
+SFLUXREF(:,7) = (/ &
+ & 33.9225_JPRB , 32.4097_JPRB, 30.5125_JPRB, 28.2810_JPRB, &
+ & 25.6387_JPRB , 22.3080_JPRB, 18.3715_JPRB, 13.8248_JPRB, &
+ & 9.41834_JPRB , 1.02735_JPRB,0.850807_JPRB,0.671379_JPRB, &
+ & 0.496975_JPRB,0.317158_JPRB,0.119297_JPRB, 1.70207E-02_JPRB /)  
+SFLUXREF(:,8) = (/ &
+ & 33.8940_JPRB , 32.4951_JPRB, 30.5494_JPRB, 28.2788_JPRB, &
+ & 25.5975_JPRB , 22.3225_JPRB, 18.3358_JPRB, 13.8199_JPRB, &
+ & 9.40283_JPRB , 1.02751_JPRB,0.850729_JPRB,0.670152_JPRB, &
+ & 0.494294_JPRB,0.315829_JPRB,0.116195_JPRB, 1.64138E-02_JPRB /)  
+SFLUXREF(:,9) = (/ &
+ & 34.6501_JPRB , 32.6690_JPRB, 30.2872_JPRB, 28.0955_JPRB, &
+ & 25.4662_JPRB , 22.1446_JPRB, 18.2754_JPRB, 13.7573_JPRB, &
+ & 9.36645_JPRB , 1.02356_JPRB,0.847154_JPRB,0.668519_JPRB, &
+ & 0.489186_JPRB,0.313790_JPRB,0.117074_JPRB, 1.60943E-02_JPRB /)  
+
+!     Rayleigh extinction coefficient at all v
+RAYLA(:,1) = (/ &
+ & 1.28405E-07_JPRB,1.45501E-07_JPRB,1.67272E-07_JPRB,1.94856E-07_JPRB, &
+ & 2.15248E-07_JPRB,2.34920E-07_JPRB,2.48558E-07_JPRB,1.80004E-07_JPRB, &
+ & 1.46504E-07_JPRB,1.31355E-07_JPRB,1.33562E-07_JPRB,1.35618E-07_JPRB, &
+ & 1.22412E-07_JPRB,1.19842E-07_JPRB,1.19924E-07_JPRB,1.20264E-07_JPRB /)  
+RAYLA(:,2) = (/ &
+ & 1.41622E-07_JPRB,1.93436E-07_JPRB,2.25057E-07_JPRB,2.01025E-07_JPRB, &
+ & 1.85138E-07_JPRB,1.72672E-07_JPRB,1.64771E-07_JPRB,1.59312E-07_JPRB, &
+ & 1.44961E-07_JPRB,1.37448E-07_JPRB,1.37506E-07_JPRB,1.38081E-07_JPRB, &
+ & 1.22432E-07_JPRB,1.19844E-07_JPRB,1.19921E-07_JPRB,1.20287E-07_JPRB /)  
+RAYLA(:,3) = (/ &
+ & 1.45382E-07_JPRB,1.97020E-07_JPRB,2.22781E-07_JPRB,1.96062E-07_JPRB, &
+ & 1.83495E-07_JPRB,1.72495E-07_JPRB,1.64910E-07_JPRB,1.58797E-07_JPRB, &
+ & 1.46208E-07_JPRB,1.42274E-07_JPRB,1.40445E-07_JPRB,1.39496E-07_JPRB, &
+ & 1.26940E-07_JPRB,1.19844E-07_JPRB,1.19921E-07_JPRB,1.20287E-07_JPRB /)  
+RAYLA(:,4) = (/ &
+ & 1.48247E-07_JPRB,1.99958E-07_JPRB,2.18048E-07_JPRB,1.93896E-07_JPRB, &
+ & 1.83125E-07_JPRB,1.73244E-07_JPRB,1.64320E-07_JPRB,1.58298E-07_JPRB, &
+ & 1.48428E-07_JPRB,1.44769E-07_JPRB,1.43704E-07_JPRB,1.38498E-07_JPRB, &
+ & 1.31732E-07_JPRB,1.22299E-07_JPRB,1.19921E-07_JPRB,1.20287E-07_JPRB /)  
+RAYLA(:,5) = (/ &
+ & 1.51343E-07_JPRB,1.99621E-07_JPRB,2.14563E-07_JPRB,1.93824E-07_JPRB, &
+ & 1.82992E-07_JPRB,1.73143E-07_JPRB,1.64587E-07_JPRB,1.57355E-07_JPRB, &
+ & 1.51198E-07_JPRB,1.46373E-07_JPRB,1.45438E-07_JPRB,1.38095E-07_JPRB, &
+ & 1.35026E-07_JPRB,1.27504E-07_JPRB,1.19921E-07_JPRB,1.20287E-07_JPRB /)  
+RAYLA(:,6) = (/ &
+ & 1.54462E-07_JPRB,1.97610E-07_JPRB,2.11992E-07_JPRB,1.93831E-07_JPRB, &
+ & 1.83900E-07_JPRB,1.73125E-07_JPRB,1.64093E-07_JPRB,1.57651E-07_JPRB, &
+ & 1.53158E-07_JPRB,1.46843E-07_JPRB,1.44733E-07_JPRB,1.40611E-07_JPRB, &
+ & 1.37320E-07_JPRB,1.33932E-07_JPRB,1.20423E-07_JPRB,1.20287E-07_JPRB /)  
+RAYLA(:,7) = (/ &
+ & 1.59068E-07_JPRB,1.92757E-07_JPRB,2.09865E-07_JPRB,1.95132E-07_JPRB, &
+ & 1.83641E-07_JPRB,1.73778E-07_JPRB,1.63215E-07_JPRB,1.59462E-07_JPRB, &
+ & 1.54331E-07_JPRB,1.46177E-07_JPRB,1.45819E-07_JPRB,1.43177E-07_JPRB, &
+ & 1.39797E-07_JPRB,1.36780E-07_JPRB,1.33385E-07_JPRB,1.20287E-07_JPRB /)  
+RAYLA(:,8) = (/ &
+ & 1.62066E-07_JPRB,1.87529E-07_JPRB,2.07191E-07_JPRB,1.97788E-07_JPRB, &
+ & 1.84920E-07_JPRB,1.72951E-07_JPRB,1.65450E-07_JPRB,1.60344E-07_JPRB, &
+ & 1.54403E-07_JPRB,1.47679E-07_JPRB,1.47287E-07_JPRB,1.44951E-07_JPRB, &
+ & 1.42517E-07_JPRB,1.41107E-07_JPRB,1.48688E-07_JPRB,1.51127E-07_JPRB /)  
+RAYLA(:,9) = (/ &
+ & 1.19177E-07_JPRB,1.86522E-07_JPRB,2.20324E-07_JPRB,2.13543E-07_JPRB, &
+ & 1.92198E-07_JPRB,1.81641E-07_JPRB,1.70092E-07_JPRB,1.65072E-07_JPRB, &
+ & 1.59804E-07_JPRB,1.56745E-07_JPRB,1.51235E-07_JPRB,1.51400E-07_JPRB, &
+ & 1.49635E-07_JPRB,1.48056E-07_JPRB,1.49046E-07_JPRB,1.51010E-07_JPRB /)  
+
+RAYLB = (/ &
+ & 1.23766E-07_JPRB,1.40524E-07_JPRB,1.61610E-07_JPRB,1.83232E-07_JPRB, &
+ & 2.02951E-07_JPRB,2.21367E-07_JPRB,2.38367E-07_JPRB,2.53019E-07_JPRB, &
+ & 2.12202E-07_JPRB,1.36977E-07_JPRB,1.39118E-07_JPRB,1.37097E-07_JPRB, &
+ & 1.33223E-07_JPRB,1.38695E-07_JPRB,1.19868E-07_JPRB,1.20062E-07_JPRB /)  
+
+ABSO3A = (/ &
+ & 8.03067E-02_JPRB,0.180926_JPRB   ,0.227484_JPRB   ,0.168015_JPRB   , &
+ & 0.138284_JPRB   ,0.114537_JPRB   ,9.50114E-02_JPRB,8.06816E-02_JPRB, &
+ & 6.76406E-02_JPRB,5.69802E-02_JPRB,5.63283E-02_JPRB,4.57592E-02_JPRB, &
+ & 4.21862E-02_JPRB,3.47949E-02_JPRB,2.65731E-02_JPRB,2.67628E-02_JPRB /)  
+
+ABSO3B = (/ &
+ & 2.94848E-02_JPRB,4.33642E-02_JPRB,6.70197E-02_JPRB,0.104990_JPRB   , &
+ & 0.156180_JPRB   ,0.214638_JPRB   ,0.266281_JPRB   ,0.317941_JPRB   , &
+ & 0.355327_JPRB   ,0.371241_JPRB   ,0.374396_JPRB   ,0.326847_JPRB   , &
+ & 0.126497_JPRB   ,6.95264E-02_JPRB,2.58175E-02_JPRB,2.52862E-02_JPRB /)  
+
+STRRAT = 0.124692_JPRB
+
+LAYREFFR = 1
+
+!     ------------------------------------------------------------------
+
+!     The array KA contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels> ~100mb, temperatures, and binary
+!     species parameters (see taumol.f for definition).  The first 
+!     index in the array, JS, runs from 1 to 9, and corresponds to 
+!     different values of the binary species parameter.  For instance, 
+!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
+!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
+!     in the array, JT, which runs from 1 to 5, corresponds to different
+!     temperatures.  More specifically, JT = 3 means that the data are for
+!     the reference temperature TREF for this  pressure level, JT = 2 refers
+!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
+!     to the JPth reference pressure level (see taumol.f for these levels
+!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
+!     which g-interval the absorption coefficients are for.
+!     -----------------------------------------------------------------
+
+!     -----------------------------------------------------------------
+!     The array KB contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels < ~100mb and temperatures. The first 
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the reference temperature TREF for this pressure 
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
+!     The second index, JP, runs from 13 to 59 and refers to the JPth
+!     reference pressure level (see taumol.f for the value of these
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
+!     and tells us which g-interval the absorption coefficients are for.
+!     -----------------------------------------------------------------
+
+
+FORREF(:, 1) = (/ 0.515619E-08_JPRB, 0.131078E-06_JPRB, 0.349038E-06_JPRB /)
+FORREF(:, 2) = (/ 0.329605E-07_JPRB, 0.430497E-06_JPRB, 0.458569E-05_JPRB /)
+FORREF(:, 3) = (/ 0.188244E-06_JPRB, 0.792931E-06_JPRB, 0.267176E-05_JPRB /)
+FORREF(:, 4) = (/ 0.611237E-06_JPRB, 0.798868E-06_JPRB, 0.411583E-06_JPRB /)
+FORREF(:, 5) = (/ 0.111903E-05_JPRB, 0.914895E-06_JPRB, 0.444828E-06_JPRB /)
+FORREF(:, 6) = (/ 0.235399E-05_JPRB, 0.269099E-05_JPRB, 0.739855E-06_JPRB /)
+FORREF(:, 7) = (/ 0.400131E-05_JPRB, 0.378135E-05_JPRB, 0.231265E-06_JPRB /)
+FORREF(:, 8) = (/ 0.464257E-05_JPRB, 0.371927E-05_JPRB, 0.460611E-06_JPRB /)
+FORREF(:, 9) = (/ 0.476792E-05_JPRB, 0.311841E-05_JPRB, 0.934811E-06_JPRB /)
+FORREF(:,10) = (/ 0.555683E-05_JPRB, 0.238129E-05_JPRB, 0.400334E-07_JPRB /)
+FORREF(:,11) = (/ 0.569068E-05_JPRB, 0.196039E-05_JPRB, 0.374476E-07_JPRB /)
+FORREF(:,12) = (/ 0.554154E-05_JPRB, 0.131724E-05_JPRB, 0.399720E-07_JPRB /)
+FORREF(:,13) = (/ 0.462684E-05_JPRB, 0.238826E-07_JPRB, 0.325793E-07_JPRB /)
+FORREF(:,14) = (/ 0.808644E-06_JPRB, 0.105126E-11_JPRB, 0.148691E-07_JPRB /)
+FORREF(:,15) = (/ 0.865024E-12_JPRB, 0.822434E-12_JPRB, 0.825756E-12_JPRB /)
+FORREF(:,16) = (/ 0.945747E-12_JPRB, 0.802065E-12_JPRB, 0.724732E-12_JPRB /)
+
+!     -----------------------------------------------------------------
+!     The array SELFREF contains the coefficient of the water vapor
+!     self-continuum (including the energy term).  The first index
+!     refers to temperature in 7.2 degree increments.  For instance,
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+!     etc.  The second index runs over the g-channel (1 to 16).
+
+SELFREF(:, 1) = (/ &
+ & 0.637755E-05_JPRB, 0.403921E-05_JPRB, 0.255823E-05_JPRB, 0.162025E-05_JPRB, 0.102618E-05_JPRB, &
+ & 0.649930E-06_JPRB, 0.411632E-06_JPRB, 0.260707E-06_JPRB, 0.165118E-06_JPRB, 0.104577E-06_JPRB /)  
+SELFREF(:, 2) = (/ &
+ & 0.180887E-04_JPRB, 0.108890E-04_JPRB, 0.655493E-05_JPRB, 0.394592E-05_JPRB, 0.237536E-05_JPRB, &
+ & 0.142991E-05_JPRB, 0.860774E-06_JPRB, 0.518167E-06_JPRB, 0.311925E-06_JPRB, 0.187772E-06_JPRB /)  
+SELFREF(:, 3) = (/ &
+ & 0.212261E-04_JPRB, 0.150697E-04_JPRB, 0.106989E-04_JPRB, 0.759581E-05_JPRB, 0.539274E-05_JPRB, &
+ & 0.382864E-05_JPRB, 0.271819E-05_JPRB, 0.192981E-05_JPRB, 0.137009E-05_JPRB, 0.972711E-06_JPRB /)  
+SELFREF(:, 4) = (/ &
+ & 0.132497E-04_JPRB, 0.118071E-04_JPRB, 0.105216E-04_JPRB, 0.937599E-05_JPRB, 0.835516E-05_JPRB, &
+ & 0.744547E-05_JPRB, 0.663482E-05_JPRB, 0.591243E-05_JPRB, 0.526870E-05_JPRB, 0.469506E-05_JPRB /)  
+SELFREF(:, 5) = (/ &
+ & 0.124069E-04_JPRB, 0.120785E-04_JPRB, 0.117589E-04_JPRB, 0.114477E-04_JPRB, 0.111447E-04_JPRB, &
+ & 0.108498E-04_JPRB, 0.105626E-04_JPRB, 0.102831E-04_JPRB, 0.100109E-04_JPRB, 0.974601E-05_JPRB /)  
+SELFREF(:, 6) = (/ &
+ & 0.411994E-04_JPRB, 0.372560E-04_JPRB, 0.336901E-04_JPRB, 0.304654E-04_JPRB, 0.275494E-04_JPRB, &
+ & 0.249126E-04_JPRB, 0.225281E-04_JPRB, 0.203718E-04_JPRB, 0.184219E-04_JPRB, 0.166587E-04_JPRB /)  
+SELFREF(:, 7) = (/ &
+ & 0.537376E-04_JPRB, 0.501002E-04_JPRB, 0.467090E-04_JPRB, 0.435473E-04_JPRB, 0.405996E-04_JPRB, &
+ & 0.378515E-04_JPRB, 0.352893E-04_JPRB, 0.329006E-04_JPRB, 0.306736E-04_JPRB, 0.285974E-04_JPRB /)  
+SELFREF(:, 8) = (/ &
+ & 0.494279E-04_JPRB, 0.475365E-04_JPRB, 0.457175E-04_JPRB, 0.439681E-04_JPRB, 0.422857E-04_JPRB, &
+ & 0.406676E-04_JPRB, 0.391114E-04_JPRB, 0.376148E-04_JPRB, 0.361755E-04_JPRB, 0.347912E-04_JPRB /)  
+SELFREF(:, 9) = (/ &
+ & 0.377444E-04_JPRB, 0.378199E-04_JPRB, 0.378956E-04_JPRB, 0.379715E-04_JPRB, 0.380475E-04_JPRB, &
+ & 0.381236E-04_JPRB, 0.381999E-04_JPRB, 0.382763E-04_JPRB, 0.383529E-04_JPRB, 0.384297E-04_JPRB /)  
+SELFREF(:,10) = (/ &
+ & 0.245916E-04_JPRB, 0.267183E-04_JPRB, 0.290289E-04_JPRB, 0.315394E-04_JPRB, 0.342669E-04_JPRB, &
+ & 0.372304E-04_JPRB, 0.404501E-04_JPRB, 0.439483E-04_JPRB, 0.477490E-04_JPRB, 0.518784E-04_JPRB /)  
+SELFREF(:,11) = (/ &
+ & 0.186528E-04_JPRB, 0.211417E-04_JPRB, 0.239628E-04_JPRB, 0.271603E-04_JPRB, 0.307845E-04_JPRB, &
+ & 0.348923E-04_JPRB, 0.395482E-04_JPRB, 0.448254E-04_JPRB, 0.508068E-04_JPRB, 0.575863E-04_JPRB /)  
+SELFREF(:,12) = (/ &
+ & 0.109896E-04_JPRB, 0.133794E-04_JPRB, 0.162890E-04_JPRB, 0.198312E-04_JPRB, 0.241438E-04_JPRB, &
+ & 0.293942E-04_JPRB, 0.357864E-04_JPRB, 0.435686E-04_JPRB, 0.530432E-04_JPRB, 0.645781E-04_JPRB /)  
+SELFREF(:,13) = (/ &
+ & 0.183885E-06_JPRB, 0.391019E-06_JPRB, 0.831472E-06_JPRB, 0.176806E-05_JPRB, 0.375966E-05_JPRB, &
+ & 0.799463E-05_JPRB, 0.170000E-04_JPRB, 0.361492E-04_JPRB, 0.768686E-04_JPRB, 0.163455E-03_JPRB /)  
+SELFREF(:,14) = (/ &
+ & 0.466057E-07_JPRB, 0.937419E-07_JPRB, 0.188551E-06_JPRB, 0.379248E-06_JPRB, 0.762813E-06_JPRB, &
+ & 0.153431E-05_JPRB, 0.308608E-05_JPRB, 0.620729E-05_JPRB, 0.124852E-04_JPRB, 0.251126E-04_JPRB /)  
+SELFREF(:,15) = (/ &
+ & 0.248961E-06_JPRB, 0.216780E-06_JPRB, 0.188758E-06_JPRB, 0.164358E-06_JPRB, 0.143113E-06_JPRB, &
+ & 0.124613E-06_JPRB, 0.108505E-06_JPRB, 0.944795E-07_JPRB, 0.822667E-07_JPRB, 0.716326E-07_JPRB /)  
+SELFREF(:,16) = (/ &
+ & 0.252246E-06_JPRB, 0.220335E-06_JPRB, 0.192462E-06_JPRB, 0.168114E-06_JPRB, 0.146847E-06_JPRB, &
+ & 0.128270E-06_JPRB, 0.112043E-06_JPRB, 0.978688E-07_JPRB, 0.854878E-07_JPRB, 0.746731E-07_JPRB /)  
+
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB24',1,ZHOOK_HANDLE)
+RETURN
+
+1001 CONTINUE
+CALL ABOR1("SRTM_KGB24:ERROR READING FILE RADSRTM")
+
+END SUBROUTINE SRTM_KGB24
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb24.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb24.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb24.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SRTM_KGB24
+END SUBROUTINE SRTM_KGB24
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb25.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb25.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb25.F90	(revision 3908)
@@ -0,0 +1,91 @@
+SUBROUTINE SRTM_KGB25
+
+!     Originally by J.Delamere, Atmospheric & Environmental Research.
+!     Revision: 2.4
+!     BAND 25: 16000-22650 cm-1 (low - H2O; high - nothing)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     G.Mozdzynski March 2011 read constants from files
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  , ONLY : JPRB
+USE YOMHOOK   , ONLY : LHOOK, DR_HOOK
+USE YOMLUN    , ONLY : NULRAD
+USE YOMMP0    , ONLY : NPROC, MYPROC
+USE MPL_MODULE, ONLY : MPL_BROADCAST
+USE YOMTAG    , ONLY : MTAGRAD
+USE YOESRTA25 , ONLY : KA, KA_D,SFLUXREF, RAYL, ABSO3A, ABSO3B, LAYREFFR  
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+
+! KURUCZ
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB25',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+  READ(NULRAD,ERR=1001) KA_D
+    KA = REAL(KA_D,JPRB)
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KA,MTAGRAD,1,CDSTRING='SRTM_KGB25:')
+ENDIF
+
+SFLUXREF = (/ &
+ & 42.6858_JPRB , 45.7720_JPRB, 44.9872_JPRB, 45.9662_JPRB    , &
+ & 46.5458_JPRB , 41.6926_JPRB, 32.2893_JPRB, 24.0928_JPRB    , &
+ & 16.7686_JPRB , 1.86048_JPRB, 1.54057_JPRB, 1.23503_JPRB    , &
+ & 0.915085_JPRB,0.590099_JPRB,0.218622_JPRB, 3.21287E-02_JPRB /)  
+
+!     Rayleigh extinction coefficient at v = 2925 cm-1.
+RAYL = (/ &
+ & 9.81132E-07_JPRB,8.25605E-07_JPRB,6.71302E-07_JPRB,5.53556E-07_JPRB,  &
+ & 3.97383E-07_JPRB,3.68206E-07_JPRB,4.42379E-07_JPRB,4.57799E-07_JPRB, &
+ & 4.22683E-07_JPRB,3.87113E-07_JPRB,3.79810E-07_JPRB,3.63192E-07_JPRB, &
+ & 3.51921E-07_JPRB,3.34231E-07_JPRB,3.34294E-07_JPRB,3.32673E-07_JPRB /)  
+     
+ABSO3A = (/ &
+ & 2.32664E-02_JPRB,5.76154E-02_JPRB,0.125389_JPRB,0.250158_JPRB, &
+ & 0.378756_JPRB   ,0.402196_JPRB   ,0.352026_JPRB,0.352036_JPRB, &
+ & 0.386253_JPRB   ,0.414598_JPRB   ,0.420079_JPRB,0.435471_JPRB, &
+ & 0.445487_JPRB   ,0.459549_JPRB   ,0.452920_JPRB,0.456838_JPRB /)  
+
+ABSO3B = (/      &
+ & 1.76917E-02_JPRB,4.64185E-02_JPRB,1.03640E-01_JPRB,0.189469_JPRB, &
+ & 0.303858_JPRB   ,0.400248_JPRB   ,0.447357_JPRB   ,0.470009_JPRB, &
+ & 0.498673_JPRB   ,0.515696_JPRB   ,0.517053_JPRB   ,0.517930_JPRB, &
+ & 0.518345_JPRB   ,0.524952_JPRB   ,0.508244_JPRB   ,0.468981_JPRB /)  
+
+LAYREFFR = 2
+
+!     ------------------------------------------------------------------
+
+!     The array KA contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels> ~100mb, temperatures, and binary
+!     species parameters (see taumol.f for definition).  The first 
+!     index in the array, JS, runs from 1 to 9, and corresponds to 
+!     different values of the binary species parameter.  For instance, 
+!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
+!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
+!     in the array, JT, which runs from 1 to 5, corresponds to different
+!     temperatures.  More specifically, JT = 3 means that the data are for
+!     the reference temperature TREF for this  pressure level, JT = 2 refers
+!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
+!     to the JPth reference pressure level (see taumol.f for these levels
+!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
+!     which g-interval the absorption coefficients are for.
+!     -----------------------------------------------------------------
+  
+!     -----------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB25',1,ZHOOK_HANDLE)
+RETURN
+
+1001 CONTINUE
+CALL ABOR1("SRTM_KGB25:ERROR READING FILE RADSRTM")
+
+END SUBROUTINE SRTM_KGB25
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb25.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb25.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb25.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SRTM_KGB25
+END SUBROUTINE SRTM_KGB25
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb26.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb26.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb26.F90	(revision 3908)
@@ -0,0 +1,39 @@
+SUBROUTINE SRTM_KGB26
+
+!     Originally by J.Delamere, Atmospheric & Environmental Research.
+!     Revision: 2.4
+!     BAND 26:  22650-29000 cm-1 (low - nothing; high - nothing)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     G.Mozdzynski March 2011 read constants from files
+
+!     ------------------------------------------------------------------
+
+USE PARKIND1  , ONLY : JPRB
+USE YOMHOOK   , ONLY : LHOOK, DR_HOOK
+USE YOESRTA26 , ONLY : SFLUXREF, RAYL 
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+
+! KURUCZ
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB26',0,ZHOOK_HANDLE)
+
+SFLUXREF = (/ &
+ !  &     129.462_JPRB, 15*_ZERO_ /)
+ & 29.0079_JPRB,  28.4088_JPRB,     20.3099_JPRB,  13.0283_JPRB &
+ & ,  11.8619_JPRB,  9.95840_JPRB,     6.68696_JPRB,  5.38987_JPRB &
+ & ,  3.49829_JPRB, 0.407693_JPRB,    0.299027_JPRB, 0.236827_JPRB &
+ & , 0.188502_JPRB, 0.163489_JPRB, 4.64335E-02_JPRB, 2.72662E-03_JPRB /)  
+
+!     Rayleigh extinction coefficient at all v 
+RAYL = (/ &
+ & 1.21263E-06_JPRB,1.43428E-06_JPRB,1.67677E-06_JPRB,1.93255E-06_JPRB &
+ & , 2.19177E-06_JPRB,2.44195E-06_JPRB,2.66926E-06_JPRB,2.85990E-06_JPRB &
+ & , 3.00380E-06_JPRB,3.06996E-06_JPRB,3.08184E-06_JPRB,3.09172E-06_JPRB &
+ & , 3.09938E-06_JPRB,3.10456E-06_JPRB,3.10727E-06_JPRB,3.10818E-06_JPRB /)  
+
+!     ------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB26',1,ZHOOK_HANDLE)
+END SUBROUTINE SRTM_KGB26
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb26.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb26.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb26.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SRTM_KGB26
+END SUBROUTINE SRTM_KGB26
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb27.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb27.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb27.F90	(revision 3908)
@@ -0,0 +1,103 @@
+SUBROUTINE SRTM_KGB27
+
+!     Originally by J.Delamere, Atmospheric & Environmental Research.
+!     Revision: 2.4
+!     BAND 16: 29000-38000 cm-1 (low - O3; high - O3)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     G.Mozdzynski March 2011 read constants from files
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  , ONLY : JPRB
+USE YOMHOOK   , ONLY : LHOOK, DR_HOOK
+USE YOMLUN    , ONLY : NULRAD
+USE YOMMP0    , ONLY : NPROC, MYPROC
+USE MPL_MODULE, ONLY : MPL_BROADCAST
+USE YOMTAG    , ONLY : MTAGRAD
+USE YOESRTA27 , ONLY : KA, KB, KA_D, KB_D, SFLUXREF, RAYL, SCALEKUR, LAYREFFR  
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+
+! KURUCZ
+!     The following values 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, below these values are scaled by the factor SCALEKUR.
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB27',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+ READ(NULRAD,ERR=1001) KA_D,KB_D
+  KA = REAL(KA_D,JPRB)
+  KB = REAL(KB_D,JPRB) 
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KA,MTAGRAD,1,CDSTRING='SRTM_KGB27:')
+  CALL MPL_BROADCAST (KB,MTAGRAD,1,CDSTRING='SRTM_KGB27:')
+ENDIF
+
+SFLUXREF = (/ &
+ & 14.0526_JPRB    , 11.4794_JPRB    , 8.72590_JPRB    , 5.56966_JPRB    , &
+ & 3.80927_JPRB    , 1.57690_JPRB    , 1.15099_JPRB    , 1.10012_JPRB    , &
+ & 0.658212_JPRB   , 5.86859E-02_JPRB, 5.56186E-02_JPRB, 4.68040E-02_JPRB, &
+ & 3.64897E-02_JPRB, 3.58053E-02_JPRB, 1.38130E-02_JPRB, 1.90193E-03_JPRB /)  
+
+!     Rayleigh extinction coefficient at v = 2925 cm-1.
+RAYL = (/ &
+ & 3.44534E-06_JPRB,4.14480E-06_JPRB,4.95069E-06_JPRB,5.81204E-06_JPRB, &
+ & 6.69748E-06_JPRB,7.56488E-06_JPRB,8.36344E-06_JPRB,9.04135E-06_JPRB, &
+ & 9.58324E-06_JPRB,9.81542E-06_JPRB,9.75119E-06_JPRB,9.74533E-06_JPRB, &
+ & 9.74139E-06_JPRB,9.73525E-06_JPRB,9.73577E-06_JPRB,9.73618E-06_JPRB /)  
+
+SCALEKUR = 50.15_JPRB/48.37_JPRB
+
+LAYREFFR = 32
+
+!     ------------------------------------------------------------------
+
+!     The array KA contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels> ~100mb, temperatures, and binary
+!     species parameters (see taumol.f for definition).  The first 
+!     index in the array, JS, runs from 1 to 9, and corresponds to 
+!     different values of the binary species parameter.  For instance, 
+!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
+!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
+!     in the array, JT, which runs from 1 to 5, corresponds to different
+!     temperatures.  More specifically, JT = 3 means that the data are for
+!     the reference temperature TREF for this  pressure level, JT = 2 refers
+!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
+!     to the JPth reference pressure level (see taumol.f for these levels
+!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
+!     which g-interval the absorption coefficients are for.
+!     -----------------------------------------------------------------
+
+!     -----------------------------------------------------------------
+!     The array KB contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels < ~100mb and temperatures. The first 
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the reference temperature TREF for this pressure 
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
+!     The second index, JP, runs from 13 to 59 and refers to the JPth
+!     reference pressure level (see taumol.f for the value of these
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
+!     and tells us which g-interval the absorption coefficients are for.
+!     -----------------------------------------------------------------
+  
+     
+!     -----------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB27',1,ZHOOK_HANDLE)
+RETURN
+
+1001 CONTINUE
+CALL ABOR1("SRTM_KGB27:ERROR READING FILE RADSRTM")
+
+END SUBROUTINE SRTM_KGB27
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb27.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb27.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb27.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SRTM_KGB27
+END SUBROUTINE SRTM_KGB27
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb28.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb28.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb28.F90	(revision 3908)
@@ -0,0 +1,117 @@
+SUBROUTINE SRTM_KGB28
+
+!     Originally by J.Delamere, Atmospheric & Environmental Research.
+!     Revision: 2.4
+!     BAND 28: 38000-50000 cm-1 (low - O3,O2; high - O3,O2)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+!     G.Mozdzynski March 2011 read constants from files
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  , ONLY : JPRB
+USE YOMHOOK   , ONLY : LHOOK, DR_HOOK
+USE YOMLUN    , ONLY : NULRAD
+USE YOMMP0    , ONLY : NPROC, MYPROC
+USE MPL_MODULE, ONLY : MPL_BROADCAST
+USE YOMTAG    , ONLY : MTAGRAD
+USE YOESRTA28 , ONLY : KA, KB, KA_D, KB_D, SFLUXREF, RAYL, STRRAT, LAYREFFR  
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+
+! KURUCZ
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB28',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+ READ(NULRAD,ERR=1001) KA_D,KB_D
+  KA = REAL(KA_D,JPRB)
+  KB = REAL(KB_D,JPRB) 
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KA,MTAGRAD,1,CDSTRING='SRTM_KGB28:')
+  CALL MPL_BROADCAST (KB,MTAGRAD,1,CDSTRING='SRTM_KGB28:')
+ENDIF
+
+SFLUXREF(:,1) = (/ &
+ & 1.06156_JPRB    , 0.599910_JPRB   , 0.422462_JPRB   , 0.400077_JPRB   , &
+ & 0.282221_JPRB   , 0.187893_JPRB   , 6.77357E-02_JPRB, 3.04572E-02_JPRB, &
+ & 2.00442E-02_JPRB, 2.30786E-03_JPRB, 2.08824E-03_JPRB, 1.42604E-03_JPRB, &
+ & 9.67384E-04_JPRB, 6.35362E-04_JPRB, 1.47727E-04_JPRB, 6.87639E-06_JPRB /)  
+SFLUXREF(:,2) = (/ &
+ & 1.07598_JPRB    , 0.585099_JPRB   , 0.422852_JPRB   , 0.400077_JPRB   , &
+ & 0.282221_JPRB   , 0.187893_JPRB   , 6.69686E-02_JPRB, 3.09070E-02_JPRB, &
+ & 2.02400E-02_JPRB, 2.47760E-03_JPRB, 1.89411E-03_JPRB, 1.41122E-03_JPRB, &
+ & 1.12449E-03_JPRB, 5.73505E-04_JPRB, 2.04160E-04_JPRB, 1.58371E-05_JPRB /)  
+SFLUXREF(:,3) = (/ &
+ & 0.461647_JPRB   , 0.406113_JPRB   , 0.332506_JPRB   , 0.307508_JPRB   , &
+ & 0.211167_JPRB   , 0.235457_JPRB   , 0.495886_JPRB   , 0.363921_JPRB   , &
+ & 0.192700_JPRB   , 2.04678E-02_JPRB, 1.55407E-02_JPRB, 1.03882E-02_JPRB, &
+ & 1.10778E-02_JPRB, 1.00504E-02_JPRB, 4.93497E-03_JPRB, 5.73410E-04_JPRB /)  
+SFLUXREF(:,4) = (/ &
+ & 0.132669_JPRB   , 0.175058_JPRB   , 0.359263_JPRB   , 0.388142_JPRB   , &
+ & 0.350359_JPRB   , 0.475892_JPRB   , 0.489593_JPRB   , 0.408437_JPRB   , &
+ & 0.221049_JPRB   , 1.94514E-02_JPRB, 1.54848E-02_JPRB, 1.44999E-02_JPRB, &
+ & 1.44568E-02_JPRB, 1.00527E-02_JPRB, 4.95897E-03_JPRB, 5.73327E-04_JPRB /)  
+SFLUXREF(:,5) = (/ &
+ & 7.54800E-02_JPRB, 0.232246_JPRB   , 0.359263_JPRB   , 0.388142_JPRB   , &
+ & 0.350359_JPRB   , 0.426317_JPRB   , 0.493485_JPRB   , 0.432016_JPRB   , &
+ & 0.239203_JPRB   , 1.74951E-02_JPRB, 1.74477E-02_JPRB, 1.83566E-02_JPRB, &
+ & 1.44818E-02_JPRB, 1.01048E-02_JPRB, 4.97487E-03_JPRB, 5.66831E-04_JPRB /)  
+
+!     Rayleigh extinction coefficient at v = ????? cm-1.
+RAYL = 2.02E-05_JPRB
+
+STRRAT = 6.67029E-07_JPRB
+
+LAYREFFR = 58
+! The following improves this band (Eli Mlawer, personal
+! communication, confirmed by comparison with LBLRTM)
+!LAYREFFR = 40
+
+!     ------------------------------------------------------------------
+
+!     The array KA contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels> ~100mb, temperatures, and binary
+!     species parameters (see taumol.f for definition).  The first 
+!     index in the array, JS, runs from 1 to 9, and corresponds to 
+!     different values of the binary species parameter.  For instance, 
+!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
+!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
+!     in the array, JT, which runs from 1 to 5, corresponds to different
+!     temperatures.  More specifically, JT = 3 means that the data are for
+!     the reference temperature TREF for this  pressure level, JT = 2 refers
+!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
+!     to the JPth reference pressure level (see taumol.f for these levels
+!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
+!     which g-interval the absorption coefficients are for.
+!     -----------------------------------------------------------------
+
+!     -----------------------------------------------------------------
+!     The array KB contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels < ~100mb and temperatures. The first 
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the reference temperature TREF for this pressure 
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
+!     The second index, JP, runs from 13 to 59 and refers to the JPth
+!     reference pressure level (see taumol.f for the value of these
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
+!     and tells us which g-interval the absorption coefficients are for.
+!     -----------------------------------------------------------------
+
+
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB28',1,ZHOOK_HANDLE)
+RETURN
+
+1001 CONTINUE
+CALL ABOR1("SRTM_KGB28:ERROR READING FILE RADSRTM")
+
+END SUBROUTINE SRTM_KGB28
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb28.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb28.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb28.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SRTM_KGB28
+END SUBROUTINE SRTM_KGB28
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb29.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb29.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb29.F90	(revision 3908)
@@ -0,0 +1,181 @@
+SUBROUTINE SRTM_KGB29
+
+!     Originally by J.Delamere, Atmospheric & Environmental Research.
+!     Revision: 2.4
+!     BAND 29:   820-2600 cm-1 (low - H2O; high - CO2)
+!     Reformatted for F90 by JJMorcrette, ECMWF
+!     G.Mozdzynski March 2011 read constants from files
+!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+!     ------------------------------------------------------------------
+
+USE PARKIND1  , ONLY : JPRB
+USE YOMHOOK   , ONLY : LHOOK, DR_HOOK
+USE YOMLUN    , ONLY : NULRAD
+USE YOMMP0    , ONLY : NPROC, MYPROC
+USE MPL_MODULE, ONLY : MPL_BROADCAST
+USE YOMTAG    , ONLY : MTAGRAD
+USE YOESRTA29 , ONLY : KA, KB, KA_D, KB_D, SELFREF, FORREF, SFLUXREF, RAYL, &
+ & ABSH2O, ABSCO2, LAYREFFR  
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+
+! KURUCZ
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB29',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+ READ(NULRAD,ERR=1001) KA_D,KB_D
+  KA = REAL(KA_D,JPRB)
+  KB = REAL(KB_D,JPRB)  
+  CLOSE(NULRAD,ERR=1000)
+ENDIF
+IF( NPROC>1 )THEN
+  CALL MPL_BROADCAST (KA,MTAGRAD,1,CDSTRING='SRTM_KGB29:')
+  CALL MPL_BROADCAST (KB,MTAGRAD,1,CDSTRING='SRTM_KGB29:')
+ENDIF
+
+SFLUXREF = (/ &
+ & 1.32880_JPRB    , 2.14018_JPRB    , 1.97612_JPRB    , 1.79000_JPRB    , &
+ & 1.51242_JPRB    , 1.22977_JPRB    , 1.06052_JPRB    , 0.800996_JPRB   , &
+ & 0.748053_JPRB   , 8.64369E-02_JPRB, 7.10675E-02_JPRB, 5.62425E-02_JPRB, &
+ & 4.46988E-02_JPRB, 3.07441E-02_JPRB, 1.16728E-02_JPRB, 1.65573E-03_JPRB /)  
+
+ABSCO2 = (/ &
+ & 2.90073E-06_JPRB, 2.12382E-05_JPRB, 1.03032E-04_JPRB, 1.86481E-04_JPRB, &
+ & 4.31997E-04_JPRB, 6.08238E-04_JPRB, 2.17603E-03_JPRB, 4.64479E-02_JPRB, &
+ & 2.96956_JPRB    , 14.9569_JPRB    , 28.4831_JPRB    , 61.3998_JPRB    , &
+ & 164.129_JPRB    , 832.282_JPRB    , 4995.02_JPRB    , 12678.1_JPRB     /)  
+     
+ABSH2O = (/ &
+ & 2.99508E-04_JPRB, 3.95012E-03_JPRB, 1.49316E-02_JPRB, 3.24384E-02_JPRB, &
+ & 6.92879E-02_JPRB, 0.123523_JPRB   , 0.360985_JPRB   , 1.86434_JPRB    , &
+ & 10.38157_JPRB   , 0.214129_JPRB   , 0.213914_JPRB   , 0.212781_JPRB   , &
+ & 0.215562_JPRB   , 0.218087_JPRB   , 0.220918_JPRB   , 0.218546_JPRB    /)  
+     
+!     Rayleigh extinction coefficient at v = 2200 cm-1.
+RAYL = 9.30E-11_JPRB
+
+LAYREFFR = 49
+
+!     ------------------------------------------------------------------
+
+!     The array KA contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels> ~100mb, temperatures, and binary
+!     species parameters (see taumol.f for definition).  The first 
+!     index in the array, JS, runs from 1 to 9, and corresponds to 
+!     different values of the binary species parameter.  For instance, 
+!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
+!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
+!     in the array, JT, which runs from 1 to 5, corresponds to different
+!     temperatures.  More specifically, JT = 3 means that the data are for
+!     the reference temperature TREF for this  pressure level, JT = 2 refers
+!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
+!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
+!     to the JPth reference pressure level (see taumol.f for these levels
+!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
+!     which g-interval the absorption coefficients are for.
+!     -----------------------------------------------------------------
+
+!     -----------------------------------------------------------------
+!     The array KB contains absorption coefs at the 16 chosen g-values 
+!     for a range of pressure levels < ~100mb and temperatures. The first 
+!     index in the array, JT, which runs from 1 to 5, corresponds to 
+!     different temperatures.  More specifically, JT = 3 means that the 
+!     data are for the reference temperature TREF for this pressure 
+!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
+!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
+!     The second index, JP, runs from 13 to 59 and refers to the JPth
+!     reference pressure level (see taumol.f for the value of these
+!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
+!     and tells us which g-interval the absorption coefficients are for.
+!     -----------------------------------------------------------------
+
+
+FORREF(:, 1) = (/ 0.299818E-05_JPRB, 0.209282E-05_JPRB, 0.988353E-04_JPRB, 0.632178E-03_JPRB /)
+FORREF(:, 2) = (/ 0.633648E-05_JPRB, 0.509214E-04_JPRB, 0.650535E-03_JPRB, 0.264019E-02_JPRB /)
+FORREF(:, 3) = (/ 0.636782E-04_JPRB, 0.136577E-03_JPRB, 0.166500E-02_JPRB, 0.750821E-02_JPRB /)
+FORREF(:, 4) = (/ 0.472314E-03_JPRB, 0.988296E-03_JPRB, 0.585751E-02_JPRB, 0.187352E-01_JPRB /)
+FORREF(:, 5) = (/ 0.558635E-02_JPRB, 0.856489E-02_JPRB, 0.157438E-01_JPRB, 0.181471E-01_JPRB /)
+FORREF(:, 6) = (/ 0.217395E-01_JPRB, 0.229156E-01_JPRB, 0.230125E-01_JPRB, 0.143821E-01_JPRB /)
+FORREF(:, 7) = (/ 0.277222E-01_JPRB, 0.299252E-01_JPRB, 0.208929E-01_JPRB, 0.826748E-02_JPRB /)
+FORREF(:, 8) = (/ 0.252119E-01_JPRB, 0.262911E-01_JPRB, 0.187663E-01_JPRB, 0.417110E-02_JPRB /)
+FORREF(:, 9) = (/ 0.304941E-01_JPRB, 0.175545E-01_JPRB, 0.971224E-02_JPRB, 0.142023E-02_JPRB /)
+FORREF(:,10) = (/ 0.327200E-01_JPRB, 0.215788E-01_JPRB, 0.346831E-02_JPRB, 0.157989E-02_JPRB /)
+FORREF(:,11) = (/ 0.324955E-01_JPRB, 0.228571E-01_JPRB, 0.171749E-02_JPRB, 0.226853E-02_JPRB /)
+FORREF(:,12) = (/ 0.326588E-01_JPRB, 0.198544E-01_JPRB, 0.532339E-06_JPRB, 0.279086E-02_JPRB /)
+FORREF(:,13) = (/ 0.345157E-01_JPRB, 0.168679E-01_JPRB, 0.505361E-06_JPRB, 0.276647E-02_JPRB /)
+FORREF(:,14) = (/ 0.448765E-01_JPRB, 0.123791E-02_JPRB, 0.488367E-06_JPRB, 0.122245E-02_JPRB /)
+FORREF(:,15) = (/ 0.486925E-01_JPRB, 0.464371E-06_JPRB, 0.464241E-06_JPRB, 0.753846E-06_JPRB /)
+FORREF(:,16) = (/ 0.530511E-01_JPRB, 0.376234E-06_JPRB, 0.409824E-06_JPRB, 0.470650E-06_JPRB /)
+
+!     -----------------------------------------------------------------
+!     The array SELFREF contains the coefficient of the water vapor
+!     self-continuum (including the energy term).  The first index
+!     refers to temperature in 7.2 degree increments.  For instance,
+!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+!     etc.  The second index runs over the g-channel (1 to 16).
+
+SELFREF(:, 1) = (/ &
+ & 0.118069E+00_JPRB, 0.713523E-01_JPRB, 0.431199E-01_JPRB, 0.260584E-01_JPRB, 0.157477E-01_JPRB, &
+ & 0.951675E-02_JPRB, 0.575121E-02_JPRB, 0.347560E-02_JPRB, 0.210039E-02_JPRB, 0.126932E-02_JPRB /)  
+SELFREF(:, 2) = (/ &
+ & 0.137081E-01_JPRB, 0.139046E-01_JPRB, 0.141040E-01_JPRB, 0.143061E-01_JPRB, 0.145112E-01_JPRB, &
+ & 0.147193E-01_JPRB, 0.149303E-01_JPRB, 0.151443E-01_JPRB, 0.153614E-01_JPRB, 0.155816E-01_JPRB /)  
+SELFREF(:, 3) = (/ &
+ & 0.166575E-01_JPRB, 0.164916E-01_JPRB, 0.163273E-01_JPRB, 0.161647E-01_JPRB, 0.160037E-01_JPRB, &
+ & 0.158443E-01_JPRB, 0.156864E-01_JPRB, 0.155302E-01_JPRB, 0.153755E-01_JPRB, 0.152224E-01_JPRB /)  
+SELFREF(:, 4) = (/ &
+ & 0.597379E-01_JPRB, 0.509517E-01_JPRB, 0.434579E-01_JPRB, 0.370662E-01_JPRB, 0.316145E-01_JPRB, &
+ & 0.269647E-01_JPRB, 0.229988E-01_JPRB, 0.196162E-01_JPRB, 0.167311E-01_JPRB, 0.142703E-01_JPRB /)  
+SELFREF(:, 5) = (/ &
+ & 0.227517E+00_JPRB, 0.198401E+00_JPRB, 0.173011E+00_JPRB, 0.150870E+00_JPRB, 0.131563E+00_JPRB, &
+ & 0.114726E+00_JPRB, 0.100044E+00_JPRB, 0.872415E-01_JPRB, 0.760769E-01_JPRB, 0.663411E-01_JPRB /)  
+SELFREF(:, 6) = (/ &
+ & 0.453235E+00_JPRB, 0.414848E+00_JPRB, 0.379712E+00_JPRB, 0.347552E+00_JPRB, 0.318116E+00_JPRB, &
+ & 0.291173E+00_JPRB, 0.266512E+00_JPRB, 0.243940E+00_JPRB, 0.223279E+00_JPRB, 0.204368E+00_JPRB /)  
+SELFREF(:, 7) = (/ &
+ & 0.569263E+00_JPRB, 0.516415E+00_JPRB, 0.468473E+00_JPRB, 0.424982E+00_JPRB, 0.385528E+00_JPRB, &
+ & 0.349737E+00_JPRB, 0.317269E+00_JPRB, 0.287815E+00_JPRB, 0.261095E+00_JPRB, 0.236856E+00_JPRB /)  
+SELFREF(:, 8) = (/ &
+ & 0.490314E+00_JPRB, 0.448042E+00_JPRB, 0.409413E+00_JPRB, 0.374116E+00_JPRB, 0.341861E+00_JPRB, &
+ & 0.312387E+00_JPRB, 0.285455E+00_JPRB, 0.260844E+00_JPRB, 0.238355E+00_JPRB, 0.217805E+00_JPRB /)  
+SELFREF(:, 9) = (/ &
+ & 0.258162E+00_JPRB, 0.265085E+00_JPRB, 0.272193E+00_JPRB, 0.279493E+00_JPRB, 0.286988E+00_JPRB, &
+ & 0.294684E+00_JPRB, 0.302586E+00_JPRB, 0.310701E+00_JPRB, 0.319033E+00_JPRB, 0.327588E+00_JPRB /)  
+SELFREF(:,10) = (/ &
+ & 0.332019E+00_JPRB, 0.331902E+00_JPRB, 0.331784E+00_JPRB, 0.331666E+00_JPRB, 0.331549E+00_JPRB, &
+ & 0.331431E+00_JPRB, 0.331314E+00_JPRB, 0.331197E+00_JPRB, 0.331079E+00_JPRB, 0.330962E+00_JPRB /)  
+SELFREF(:,11) = (/ &
+ & 0.357523E+00_JPRB, 0.353154E+00_JPRB, 0.348839E+00_JPRB, 0.344576E+00_JPRB, 0.340366E+00_JPRB, &
+ & 0.336207E+00_JPRB, 0.332099E+00_JPRB, 0.328041E+00_JPRB, 0.324032E+00_JPRB, 0.320073E+00_JPRB /)  
+SELFREF(:,12) = (/ &
+ & 0.294662E+00_JPRB, 0.299043E+00_JPRB, 0.303488E+00_JPRB, 0.308000E+00_JPRB, 0.312579E+00_JPRB, &
+ & 0.317226E+00_JPRB, 0.321941E+00_JPRB, 0.326727E+00_JPRB, 0.331585E+00_JPRB, 0.336514E+00_JPRB /)  
+SELFREF(:,13) = (/ &
+ & 0.227445E+00_JPRB, 0.241545E+00_JPRB, 0.256519E+00_JPRB, 0.272422E+00_JPRB, 0.289311E+00_JPRB, &
+ & 0.307247E+00_JPRB, 0.326294E+00_JPRB, 0.346523E+00_JPRB, 0.368005E+00_JPRB, 0.390820E+00_JPRB /)  
+SELFREF(:,14) = (/ &
+ & 0.616203E-02_JPRB, 0.113523E-01_JPRB, 0.209144E-01_JPRB, 0.385307E-01_JPRB, 0.709852E-01_JPRB, &
+ & 0.130776E+00_JPRB, 0.240929E+00_JPRB, 0.443865E+00_JPRB, 0.817733E+00_JPRB, 0.150651E+01_JPRB /)  
+SELFREF(:,15) = (/ &
+ & 0.279552E-03_JPRB, 0.808472E-03_JPRB, 0.233812E-02_JPRB, 0.676192E-02_JPRB, 0.195557E-01_JPRB, &
+ & 0.565555E-01_JPRB, 0.163560E+00_JPRB, 0.473020E+00_JPRB, 0.136799E+01_JPRB, 0.395626E+01_JPRB /)  
+SELFREF(:,16) = (/ &
+ & 0.261006E-03_JPRB, 0.771043E-03_JPRB, 0.227776E-02_JPRB, 0.672879E-02_JPRB, 0.198777E-01_JPRB, &
+ & 0.587212E-01_JPRB, 0.173470E+00_JPRB, 0.512452E+00_JPRB, 0.151385E+01_JPRB, 0.447209E+01_JPRB /)  
+     
+!     -----------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB29',1,ZHOOK_HANDLE)
+RETURN
+
+1000 CONTINUE
+CALL ABOR1("SRTM_KGB29:ERROR CLOSING FILE RADSRTM")
+1001 CONTINUE
+CALL ABOR1("SRTM_KGB29:ERROR READING FILE RADSRTM")
+
+END SUBROUTINE SRTM_KGB29
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb29.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb29.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb29.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SRTM_KGB29
+END SUBROUTINE SRTM_KGB29
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_setcoef.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_setcoef.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_setcoef.F90	(revision 3908)
@@ -0,0 +1,234 @@
+SUBROUTINE SRTM_SETCOEF &
+ & ( KIDIA   , KFDIA    , KLEV    ,&
+ &   PAVEL   , PTAVEL   ,&
+ &   PCOLDRY , PWKL     ,&
+ &   KLAYTROP,&
+ &   PCOLCH4  , PCOLCO2 , PCOLH2O , PCOLMOL  , PCOLO2 , PCOLO3 ,&
+ &   PFORFAC , PFORFRAC , KINDFOR , PSELFFAC, PSELFFRAC, KINDSELF ,&
+ &   PFAC00  , PFAC01   , PFAC10  , PFAC11  ,&
+ &   KJP     , KJT      , KJT1    , PRMU0    &
+ & )  
+
+!     J. Delamere, AER, Inc. (version 2.5, 02/04/01)
+
+!     Modifications:
+!     JJMorcrette 030224   rewritten / adapted to ECMWF F90 system
+!        M.Hamrud      01-Oct-2003 CY28 Cleaning
+!        D.Salmond  31-Oct-2007 Vector version in the style of RRTM from Meteo France & NEC
+
+!     Purpose:  For a given atmosphere, calculate the indices and
+!     fractions related to the pressure and temperature interpolations.
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
+USE YOESRTWN , ONLY : PREFLOG, TREF
+!!  USE YOESWN  , ONLY : NDBUG
+
+IMPLICIT NONE
+
+!-- Input arguments
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA, KFDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PAVEL(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAVEL(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLDRY(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PWKL(KIDIA:KFDIA,35,KLEV) 
+INTEGER(KIND=JPIM),INTENT(OUT)   :: KLAYTROP(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCOLCH4(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCOLCO2(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCOLH2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCOLMOL(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCOLO2(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCOLO3(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFORFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFORFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(OUT)   :: KINDFOR(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(OUT)   :: KINDSELF(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(OUT)   :: KJP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(OUT)   :: KJT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(OUT)   :: KJT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KIDIA:KFDIA) 
+!-- Output arguments
+
+!-- local integers
+
+INTEGER(KIND=JPIM) :: I_NLAYERS, JK, JL, JP1
+
+!-- local reals
+
+REAL(KIND=JPRB) :: Z_STPFAC, Z_PLOG
+REAL(KIND=JPRB) :: Z_FP, Z_FT, Z_FT1, Z_WATER, Z_SCALEFAC
+REAL(KIND=JPRB) :: Z_FACTOR, Z_CO2REG, Z_COMPFP
+!REAL(KIND=JPRB) :: Z_TBNDFRAC, Z_T0FRAC
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+
+
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('SRTM_SETCOEF',0,ZHOOK_HANDLE)
+
+Z_STPFAC = 296._JPRB/1013._JPRB
+I_NLAYERS = KLEV
+
+DO JL = KIDIA, KFDIA
+  IF (PRMU0(JL) > 0.0_JPRB) THEN
+    KLAYTROP(JL)  = 0
+  ENDIF
+ENDDO
+
+DO JK = 1, I_NLAYERS
+  DO JL = KIDIA, KFDIA
+    IF (PRMU0(JL) > 0.0_JPRB) THEN
+      !        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.
+
+      Z_PLOG = LOG(PAVEL(JL,JK))
+      KJP(JL,JK) = INT(36._JPRB - 5._JPRB*(Z_PLOG+0.04_JPRB))
+      IF (KJP(JL,JK) < 1) THEN
+        KJP(JL,JK) = 1
+      ELSEIF (KJP(JL,JK) > 58) THEN
+        KJP(JL,JK) = 58
+      ENDIF
+      JP1 = KJP(JL,JK) + 1
+      Z_FP = 5. * (PREFLOG(KJP(JL,JK)) - Z_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.
+
+      KJT(JL,JK) = INT(3. + (PTAVEL(JL,JK)-TREF(KJP(JL,JK)))/15.)
+      IF (KJT(JL,JK) < 1) THEN
+        KJT(JL,JK) = 1
+      ELSEIF (KJT(JL,JK) > 4) THEN
+        KJT(JL,JK) = 4
+      ENDIF
+      Z_FT = ((PTAVEL(JL,JK)-TREF(KJP(JL,JK)))/15.) - REAL(KJT(JL,JK)-3)
+      KJT1(JL,JK) = INT(3. + (PTAVEL(JL,JK)-TREF(JP1))/15.)
+      IF (KJT1(JL,JK) < 1) THEN
+        KJT1(JL,JK) = 1
+      ELSEIF (KJT1(JL,JK) > 4) THEN
+        KJT1(JL,JK) = 4
+      ENDIF
+      Z_FT1 = ((PTAVEL(JL,JK)-TREF(JP1))/15.) - REAL(KJT1(JL,JK)-3)
+
+      Z_WATER = PWKL(JL,1,JK)/PCOLDRY(JL,JK)
+      Z_SCALEFAC = PAVEL(JL,JK) * Z_STPFAC / PTAVEL(JL,JK)
+
+      !        If the pressure is less than ~100mb, perform a different
+      !        set of species interpolations.
+
+      IF (Z_PLOG <= 4.56_JPRB) GO TO 5300
+      KLAYTROP(JL) =  KLAYTROP(JL) + 1
+
+      !        Set up factors needed to separately include the water vapor
+      !        foreign-continuum in the calculation of absorption coefficient.
+
+      PFORFAC(JL,JK) = Z_SCALEFAC / (1.+Z_WATER)
+      Z_FACTOR = (332.0-PTAVEL(JL,JK))/36.0
+      KINDFOR(JL,JK) = MIN(2, MAX(1, INT(Z_FACTOR)))
+      PFORFRAC(JL,JK) = Z_FACTOR - REAL(KINDFOR(JL,JK))
+
+      !        Set up factors needed to separately include the water vapor
+      !        self-continuum in the calculation of absorption coefficient.
+
+      PSELFFAC(JL,JK) = Z_WATER * PFORFAC(JL,JK)
+      Z_FACTOR = (PTAVEL(JL,JK)-188.0)/7.2
+      KINDSELF(JL,JK) = MIN(9, MAX(1, INT(Z_FACTOR)-7))
+      PSELFFRAC(JL,JK) = Z_FACTOR - REAL(KINDSELF(JL,JK) + 7)
+
+      !        Calculate needed column amounts.
+
+      PCOLH2O(JL,JK) = 1.E-20 * PWKL(JL,1,JK)
+      PCOLCO2(JL,JK) = 1.E-20 * PWKL(JL,2,JK)
+      PCOLO3(JL,JK) = 1.E-20 * PWKL(JL,3,JK)
+      !         COLO3(LAY) = 0.
+      !         COLO3(LAY) = colo3(lay)/1.16
+      PCOLCH4(JL,JK) = 1.E-20 * PWKL(JL,6,JK)
+      PCOLO2(JL,JK) = 1.E-20 * PWKL(JL,7,JK)
+      PCOLMOL(JL,JK) = 1.E-20 * PCOLDRY(JL,JK) + PCOLH2O(JL,JK)
+      !         colco2(lay) = 0.
+      !         colo3(lay) = 0.
+      !         colch4(lay) = 0.
+      !         colo2(lay) = 0.
+      !         colmol(lay) = 0.
+      IF (PCOLCO2(JL,JK) == 0.) PCOLCO2(JL,JK) = 1.E-32 * PCOLDRY(JL,JK)
+      IF (PCOLCH4(JL,JK) == 0.) PCOLCH4(JL,JK) = 1.E-32 * PCOLDRY(JL,JK)
+      IF (PCOLO2(JL,JK) == 0.) PCOLO2(JL,JK) = 1.E-32 * PCOLDRY(JL,JK)
+      !        Using E = 1334.2 cm-1.
+      Z_CO2REG = 3.55E-24 * PCOLDRY(JL,JK)
+      GO TO 5400
+
+      !        Above LAYTROP.
+5300  CONTINUE
+
+      !        Set up factors needed to separately include the water vapor
+      !        foreign-continuum in the calculation of absorption coefficient.
+
+      PFORFAC(JL,JK) = Z_SCALEFAC / (1.+Z_WATER)
+      Z_FACTOR = (PTAVEL(JL,JK)-188.0)/36.0
+      KINDFOR(JL,JK) = 3
+      PFORFRAC(JL,JK) = Z_FACTOR - 1.0
+
+      !        Calculate needed column amounts.
+
+      PCOLH2O(JL,JK) = 1.E-20 * PWKL(JL,1,JK)
+      PCOLCO2(JL,JK) = 1.E-20 * PWKL(JL,2,JK)
+      PCOLO3(JL,JK)  = 1.E-20 * PWKL(JL,3,JK)
+      PCOLCH4(JL,JK) = 1.E-20 * PWKL(JL,6,JK)
+      PCOLO2(JL,JK)  = 1.E-20 * PWKL(JL,7,JK)
+      PCOLMOL(JL,JK) = 1.E-20 * PCOLDRY(JL,JK) + PCOLH2O(JL,JK)
+      IF (PCOLCO2(JL,JK) == 0.) PCOLCO2(JL,JK) = 1.E-32 * PCOLDRY(JL,JK)
+      IF (PCOLCH4(JL,JK) == 0.) PCOLCH4(JL,JK) = 1.E-32 * PCOLDRY(JL,JK)
+      IF (PCOLO2(JL,JK) == 0.) PCOLO2(JL,JK)  = 1.E-32 * PCOLDRY(JL,JK)
+      Z_CO2REG = 3.55E-24 * PCOLDRY(JL,JK)
+
+      PSELFFAC(JL,JK) =0.0_JPRB
+      PSELFFRAC(JL,JK)=0.0_JPRB
+      KINDSELF(JL,JK) = 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).
+
+      Z_COMPFP = 1. - Z_FP
+      PFAC10(JL,JK) = Z_COMPFP * Z_FT
+      PFAC00(JL,JK) = Z_COMPFP * (1. - Z_FT)
+      PFAC11(JL,JK) = Z_FP * Z_FT1
+      PFAC01(JL,JK) = Z_FP * (1. - Z_FT1)
+
+      !  IF (NDBUG.LE.3) THEN
+      !    print 9000,LAY,LAYTROP,JP(LAY),JT(LAY),JT1(LAY),TAVEL(LAY) &
+      !      &,FAC00(LAY),FAC01(LAY),FAC10(LAY),FAC11(LAY) &
+      !      &,COLMOL(LAY),COLCH4(LAY),COLCO2(LAY),COLH2O(LAY) &
+      !      &,COLO2(LAY),COLO3(LAY),SELFFAC(LAY),SELFFRAC(LAY) &
+      !      &,FORFAC(LAY),FORFRAC(LAY),INDSELF(LAY),INDFOR(LAY)
+9000  format(1x,2I3,3I4,F6.1,4F7.2,12E9.2,2I5)
+      !  ENDIF
+
+    ENDIF
+  ENDDO
+ENDDO
+
+!----------------------------------------------------------------------- 
+IF (LHOOK) CALL DR_HOOK('SRTM_SETCOEF',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE SRTM_SETCOEF
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_setcoef.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_setcoef.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_setcoef.intfb.h	(revision 3908)
@@ -0,0 +1,41 @@
+INTERFACE
+SUBROUTINE SRTM_SETCOEF&
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PAVEL , PTAVEL ,&
+ & PCOLDRY , PWKL ,&
+ & KLAYTROP,&
+ & PCOLCH4 , PCOLCO2 , PCOLH2O , PCOLMOL , PCOLO2 , PCOLO3 ,&
+ & PFORFAC , PFORFRAC , KINDFOR , PSELFFAC, PSELFFRAC, KINDSELF ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PRMU0&
+ & ) 
+USE PARKIND1 , ONLY : JPIM, JPRB
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA, KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(IN) :: PAVEL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PTAVEL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLDRY(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PWKL(KIDIA:KFDIA,35,KLEV)
+INTEGER(KIND=JPIM),INTENT(OUT) :: KLAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PCOLCH4(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PCOLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PCOLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PCOLMOL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PCOLO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PCOLO3(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(OUT) :: KINDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PSELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PSELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(OUT) :: KINDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(OUT) :: KJP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(OUT) :: KJT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(OUT) :: KJT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KIDIA:KFDIA)
+END SUBROUTINE SRTM_SETCOEF
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_spcvrt_mcica.F90.or
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_spcvrt_mcica.F90.or	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_spcvrt_mcica.F90.or	(revision 3908)
@@ -0,0 +1,699 @@
+#ifdef RS6K
+@PROCESS HOT(NOVECTOR) NOSTRICT
+#endif
+SUBROUTINE SRTM_SPCVRT_MCICA &
+ & ( KIDIA   , KFDIA   , KLEV    , KSW    , KCOLS  , PONEMINUS, &
+ &   PALBD   , PALBP, &
+ &   PFRCL   , PTAUC   , PASYC  , POMGC  , PTAUA    , PASYA   , POMGA , PRMU0, &
+ &   KLAYTROP,&
+ &   PCOLCH4  , PCOLCO2 , PCOLH2O , PCOLMOL  , PCOLO2 , PCOLO3 ,&
+ &   PFORFAC , PFORFRAC , KINDFOR , PSELFFAC, PSELFFRAC, KINDSELF ,&
+ &   PFAC00  , PFAC01   , PFAC10  , PFAC11 ,&
+ &   KJP     , KJT      , KJT1 ,&
+ !-- output arrays 
+ &   PBBFD   , PBBFU    , PBBCD, PBBCU, PFUVF, PFUVC, PPARF, PPARCF, PSUDU, &
+ &   PBBFDIR , PBBCDIR  , PSwDiffuseBand     , PSwDirectBand )
+
+
+!**** *SRTM_SPCVRT* - SPECTRAL LOOP TO COMPUTE THE SHORTWAVE RADIATION FLUXES.
+
+!     PURPOSE.
+!     --------
+
+!          THIS ROUTINE COMPUTES THE TWO-STREAM METHOD OF BARKER
+
+!**   INTERFACE.
+!     ----------
+
+!          *SRTM_SPCVRT_MCICA* IS CALLED FROM *SRTM_SRTM_224GP*
+
+!        IMPLICIT ARGUMENTS :
+!        --------------------
+
+!     ==== INPUTS ===
+!     ==== OUTPUTS ===
+
+!     METHOD.
+!     -------
+
+!     EXTERNALS.
+!     ----------
+
+!          *SWVRTQDR*
+
+!     REFERENCE.
+!     ----------
+
+!        SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
+!        DOCUMENTATION
+!     AUTHOR.
+!     -------
+!        from Howard Barker
+!        JEAN-JACQUES MORCRETTE  *ECMWF*
+
+!     MODIFICATIONS.
+!     --------------
+!        ORIGINAL : 03-02-27
+!        M.Hamrud      01-Oct-2003 CY28 Cleaning
+!        JJMorcrette   20050110 McICA version
+!        JJMorcrette   20070614 bug-fix for solar duration
+!        JJMorcrette   20070831 UV-B surface flux
+!        D.Salmond  31-Oct-2007 Vector version in the style of RRTM from Meteo France & NEC
+!        JJMorcrette/MJIacono 20080724 Look-up table replacing exponential
+!        JJMorcrette   20091201 Total and clear-sky downward direct flux
+!        RJHogan       20140627 Store downwelling surface fluxes in each band
+!     ------------------------------------------------------------------
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
+USE PARSRTM  , ONLY : JPB1, JPB2
+USE YOESRTM  , ONLY : JPGPT
+USE YOESRTWN , ONLY : NGC, NMPSRTM
+USE YOERDI   , ONLY : REPCLC
+USE YOESRTAB , ONLY : BPADE, TRANS, RODLOW, RTBLINT
+USE YOERAD   , ONLY : NSW, LApproxSwUpdate
+
+IMPLICIT NONE
+
+!     ------------------------------------------------------------------
+
+!*       0.1   ARGUMENTS
+!              ---------
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KSW
+INTEGER(KIND=JPIM),INTENT(IN)    :: KCOLS
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA, KFDIA
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PONEMINUS(KIDIA:KFDIA)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBD(KIDIA:KFDIA,KSW) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBP(KIDIA:KFDIA,KSW) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PFRCL(KIDIA:KFDIA,KCOLS,KLEV)  ! bottom to top
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUC(KIDIA:KFDIA,KLEV,KCOLS)  ! bottom to top
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PASYC(KIDIA:KFDIA,KLEV,KCOLS)  ! bottom to top
+REAL(KIND=JPRB)   ,INTENT(IN)    :: POMGC(KIDIA:KFDIA,KLEV,KCOLS)  ! bottom to top
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUA(KIDIA:KFDIA,KLEV,KSW)    ! bottom to top
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PASYA(KIDIA:KFDIA,KLEV,KSW)    ! bottom to top
+REAL(KIND=JPRB)   ,INTENT(IN)    :: POMGA(KIDIA:KFDIA,KLEV,KSW)    ! bottom to top
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KIDIA:KFDIA)
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLCH4(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLMOL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLO3(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PFORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PFORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)    :: KINDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PSELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PSELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)    :: KINDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)    :: KJP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)    :: KJT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN)    :: KJT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB)   ,INTENT(INOUT) :: PBBFD(KIDIA:KFDIA,KLEV+1) 
+REAL(KIND=JPRB)   ,INTENT(INOUT) :: PBBFU(KIDIA:KFDIA,KLEV+1) 
+REAL(KIND=JPRB)   ,INTENT(INOUT) :: PBBCD(KIDIA:KFDIA,KLEV+1) 
+REAL(KIND=JPRB)   ,INTENT(INOUT) :: PBBCU(KIDIA:KFDIA,KLEV+1) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFUVF(KIDIA:KFDIA), PFUVC(KIDIA:KFDIA)
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PPARF(KIDIA:KFDIA), PPARCF(KIDIA:KFDIA)
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSUDU(KIDIA:KFDIA)
+REAL(KIND=JPRB)   ,INTENT(INOUT) :: PBBFDIR(KIDIA:KFDIA,KLEV+1)
+REAL(KIND=JPRB)   ,INTENT(INOUT) :: PBBCDIR(KIDIA:KFDIA,KLEV+1)
+
+! Surface diffuse and direct downwelling shortwave flux in each
+! shortwave albedo band, used in RADINTG to update the surface fluxes
+! accounting for high-resolution albedo information
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSwDiffuseBand(KIDIA:KFDIA,NSW)
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSwDirectBand(KIDIA:KFDIA,NSW)
+
+!     ------------------------------------------------------------------
+
+!              ------------
+
+LOGICAL :: LLRTCHK(KIDIA:KFDIA,KLEV)
+
+REAL(KIND=JPRB) :: &
+ & ZCLEAR(KIDIA:KFDIA)      , ZCLOUD(KIDIA:KFDIA)       &
+ & , ZDBT(KIDIA:KFDIA,KLEV+1) &
+ & , ZGCC(KIDIA:KFDIA,KLEV)   , ZGCO(KIDIA:KFDIA,KLEV)     &
+ & , ZOMCC(KIDIA:KFDIA,KLEV)  , ZOMCO(KIDIA:KFDIA,KLEV)    &
+ & , ZRDND(KIDIA:KFDIA,KLEV+1), ZRDNDC(KIDIA:KFDIA,KLEV+1)&
+ & , ZREF(KIDIA:KFDIA,KLEV+1) , ZREFC(KIDIA:KFDIA,KLEV+1) , ZREFO(KIDIA:KFDIA,KLEV+1)  &
+ & , ZREFD(KIDIA:KFDIA,KLEV+1), ZREFDC(KIDIA:KFDIA,KLEV+1), ZREFDO(KIDIA:KFDIA,KLEV+1) &
+ & , ZRUP(KIDIA:KFDIA,KLEV+1) , ZRUPD(KIDIA:KFDIA,KLEV+1) &
+ & , ZRUPC(KIDIA:KFDIA,KLEV+1), ZRUPDC(KIDIA:KFDIA,KLEV+1)&
+ & , ZTAUC(KIDIA:KFDIA,KLEV)  , ZTAUO(KIDIA:KFDIA,KLEV)    &
+ & , ZTDBT(KIDIA:KFDIA,KLEV+1) &
+ & , ZTRA(KIDIA:KFDIA,KLEV+1) , ZTRAC(KIDIA:KFDIA,KLEV+1) , ZTRAO(KIDIA:KFDIA,KLEV+1)  &
+ & , ZTRAD(KIDIA:KFDIA,KLEV+1), ZTRADC(KIDIA:KFDIA,KLEV+1), ZTRADO(KIDIA:KFDIA,KLEV+1)   
+REAL(KIND=JPRB) :: &
+ & ZDBTC(KIDIA:KFDIA,KLEV+1), ZTDBTC(KIDIA:KFDIA,KLEV+1), ZINCFLX(KIDIA:KFDIA,JPGPT)  &
+ & ,  ZINCF14(KIDIA:KFDIA,14)   , ZINCTOT(KIDIA:KFDIA)   
+
+INTEGER(KIND=JPIM) :: IB1, IB2, IBM, IGT, IKL, IW(KIDIA:KFDIA), JB, JG, JK, I_KMODTS, JL, IC, ICOUNT
+
+! An index for the 6 bands used in the original albedo data rather
+! than the 14 RRTM bands
+INTEGER(KIND=JPIM) :: JB_ALBEDO
+
+INTEGER(KIND=JPIM) :: INDEX(KIDIA:KFDIA)
+
+REAL(KIND=JPRB) :: ZDBTMC(KIDIA:KFDIA), ZDBTMO(KIDIA:KFDIA), ZF(KIDIA:KFDIA)
+! REAL(KIND=JPRB) :: ZARG1(KIDIA:KFDIA), ZARG2(KIDIA:KFDIA)
+REAL(KIND=JPRB) :: ZINCFLUX(KIDIA:KFDIA), ZWF(KIDIA:KFDIA)
+REAL(KIND=JPRB) :: ZCOEFVS
+
+!-- Output of SRTM_TAUMOLn routines
+
+REAL(KIND=JPRB) :: ZTAUG(KIDIA:KFDIA,KLEV,16), ZTAUR(KIDIA:KFDIA,KLEV,16), ZSFLXZEN(KIDIA:KFDIA,16)
+
+!-- Output of SRTM_VRTQDR routine
+REAL(KIND=JPRB) :: &
+ & ZCD(KIDIA:KFDIA,KLEV+1,JPGPT), ZCU(KIDIA:KFDIA,KLEV+1,JPGPT) &
+ & ,  ZFD(KIDIA:KFDIA,KLEV+1,JPGPT), ZFU(KIDIA:KFDIA,KLEV+1,JPGPT)  
+
+REAL(KIND=JPRB) :: ZTAU, ZPAO, ZPTO
+REAL(KIND=JPRB) :: ZPAOJ(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZPTOJ(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZRMU0D(KIDIA:KFDIA) 
+ 
+!--  Use of exponential look-up table
+REAL(KIND=JPRB) :: ZE1, ZE2, ZTBLIND
+INTEGER(KIND=JPIM) :: ITIND
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+
+#include "srtm_taumol16.intfb.h"
+#include "srtm_taumol17.intfb.h"
+#include "srtm_taumol18.intfb.h"
+#include "srtm_taumol19.intfb.h"
+#include "srtm_taumol20.intfb.h"
+#include "srtm_taumol21.intfb.h"
+#include "srtm_taumol22.intfb.h"
+#include "srtm_taumol23.intfb.h"
+#include "srtm_taumol24.intfb.h"
+#include "srtm_taumol25.intfb.h"
+#include "srtm_taumol26.intfb.h"
+#include "srtm_taumol27.intfb.h"
+#include "srtm_taumol28.intfb.h"
+#include "srtm_taumol29.intfb.h"
+#include "srtm_reftra.intfb.h"
+#include "srtm_vrtqdr.intfb.h"
+!     ------------------------------------------------------------------
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('SRTM_SPCVRT_MCICA',0,ZHOOK_HANDLE)
+
+!-- Two-stream model 1: Eddington, 2: PIFM, Zdunkowski et al., 3: discrete ordinates
+
+IB1=JPB1
+IB2=JPB2
+
+IC=0
+DO JL = KIDIA, KFDIA
+  IF (PRMU0(JL) > 0.0_JPRB) THEN
+    IC=IC+1
+    INDEX(IC)=JL
+    IW(JL)=0
+    ZINCFLUX(JL)=0.0_JPRB
+    ZINCTOT(JL)=0.0_JPRB
+    PFUVF(JL) = 0.0_JPRB
+    PFUVC(JL) = 0.0_JPRB
+    PPARF(JL) = 0.0_JPRB
+    PPARCF(JL)= 0.0_JPRB
+  ENDIF
+ENDDO
+ICOUNT=IC
+IF(ICOUNT==0)THEN
+  IF (LHOOK) CALL DR_HOOK('SRTM_SPCVRT_MCICA',1,ZHOOK_HANDLE)
+  RETURN
+ENDIF
+
+! Since the stored shortwave downwelling fluxes in bands are
+! accumulated over the g-points within that band, they need to be
+! initialized here
+IF (LApproxSwUpdate) THEN
+  DO JB_ALBEDO = 1,NSW
+    DO JL = KIDIA, KFDIA
+      PSwDiffuseBand(JL,JB_ALBEDO) = 0.0_JPRB
+      PSwDirectBand (JL,JB_ALBEDO) = 0.0_JPRB
+    ENDDO
+  ENDDO
+ENDIF
+
+
+!-- fraction of visible (to 0.69 um) in interval 0.6250-0.7782 um
+ZCOEFVS = 0.42425_JPRB
+
+JB=IB1-1
+DO JB = IB1, IB2
+  DO IC=1,ICOUNT
+    JL=INDEX(IC)
+    IBM = JB-15
+    IGT = NGC(IBM)
+    ZINCF14(JL,IBM)=0.0_JPRB
+  ENDDO
+
+  !-- for each band, computes the gaseous and Rayleigh optical thickness 
+  !  for all g-points within the band
+
+  IF (JB == 16) THEN
+    CALL SRTM_TAUMOL16 &
+     & ( KIDIA   , KFDIA    , KLEV    ,&
+     &   PFAC00  , PFAC01   , PFAC10   , PFAC11   ,&
+     &   KJP     , KJT      , KJT1     , PONEMINUS,&
+     &   PCOLH2O , PCOLCH4  , PCOLMOL  ,&
+     &   KLAYTROP, PSELFFAC , PSELFFRAC, KINDSELF, PFORFAC  , PFORFRAC, KINDFOR ,&
+     &   ZSFLXZEN, ZTAUG    , ZTAUR    , PRMU0     &
+     & )  
+
+  ELSEIF (JB == 17) THEN
+    CALL SRTM_TAUMOL17 &
+     & ( KIDIA   , KFDIA   , KLEV    ,&
+     &   PFAC00  , PFAC01  , PFAC10   , PFAC11 ,&
+     &   KJP     , KJT     , KJT1     , PONEMINUS ,&
+     &   PCOLH2O , PCOLCO2 , PCOLMOL  ,&
+     &   KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF  , PFORFAC, PFORFRAC, KINDFOR ,&
+     &   ZSFLXZEN, ZTAUG   , ZTAUR    , PRMU0     &
+     & )  
+
+  ELSEIF (JB == 18) THEN
+    CALL SRTM_TAUMOL18 &
+     & ( KIDIA   , KFDIA   , KLEV    ,&
+     &   PFAC00  , PFAC01  , PFAC10   , PFAC11 ,&
+     &   KJP     , KJT     , KJT1     , PONEMINUS ,&
+     &   PCOLH2O , PCOLCH4 , PCOLMOL  ,&
+     &   KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF  , PFORFAC, PFORFRAC, KINDFOR ,&
+     &   ZSFLXZEN, ZTAUG   , ZTAUR    , PRMU0     &
+     & )  
+
+  ELSEIF (JB == 19) THEN
+    CALL SRTM_TAUMOL19 &
+     & ( KIDIA   , KFDIA   , KLEV    ,&
+     &   PFAC00  , PFAC01  , PFAC10   , PFAC11 ,&
+     &   KJP     , KJT     , KJT1     , PONEMINUS ,&
+     &   PCOLH2O , PCOLCO2 , PCOLMOL  ,&
+     &   KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF  , PFORFAC, PFORFRAC, KINDFOR ,&
+     &   ZSFLXZEN, ZTAUG   , ZTAUR    , PRMU0     &
+     & )  
+
+  ELSEIF (JB == 20) THEN
+    CALL SRTM_TAUMOL20 &
+     & ( KIDIA   , KFDIA   , KLEV    ,&
+     &   PFAC00  , PFAC01  , PFAC10   , PFAC11 ,&
+     &   KJP     , KJT     , KJT1     ,&
+     &   PCOLH2O , PCOLCH4 , PCOLMOL  ,&
+     &   KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF  , PFORFAC, PFORFRAC, KINDFOR ,&
+     &   ZSFLXZEN, ZTAUG   , ZTAUR    , PRMU0     &
+     & )  
+
+  ELSEIF (JB == 21) THEN
+    CALL SRTM_TAUMOL21 &
+     & ( KIDIA   , KFDIA   , KLEV    ,&
+     &   PFAC00  , PFAC01  , PFAC10   , PFAC11 ,&
+     &   KJP     , KJT     , KJT1     , PONEMINUS ,&
+     &   PCOLH2O , PCOLCO2 , PCOLMOL  ,&
+     &   KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF  , PFORFAC, PFORFRAC, KINDFOR ,&
+     &   ZSFLXZEN, ZTAUG   , ZTAUR    , PRMU0     &
+     & )  
+
+  ELSEIF (JB == 22) THEN
+    CALL SRTM_TAUMOL22 &
+     & ( KIDIA   , KFDIA   , KLEV    ,&
+     &   PFAC00  , PFAC01  , PFAC10   , PFAC11 ,&
+     &   KJP     , KJT     , KJT1     , PONEMINUS ,&
+     &   PCOLH2O , PCOLMOL , PCOLO2   ,&
+     &   KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF  , PFORFAC, PFORFRAC, KINDFOR ,&
+     &   ZSFLXZEN, ZTAUG   , ZTAUR    , PRMU0     &
+     & )  
+
+  ELSEIF (JB == 23) THEN
+    CALL SRTM_TAUMOL23 &
+     & ( KIDIA   , KFDIA   , KLEV    ,&
+     &   PFAC00  , PFAC01  , PFAC10   , PFAC11 ,&
+     &   KJP     , KJT     , KJT1     ,&
+     &   PCOLH2O , PCOLMOL ,&
+     &   KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF  , PFORFAC, PFORFRAC, KINDFOR ,&
+     &   ZSFLXZEN, ZTAUG   , ZTAUR    , PRMU0     &
+     & )  
+
+  ELSEIF (JB == 24) THEN
+    CALL SRTM_TAUMOL24 &
+     & ( KIDIA   , KFDIA   , KLEV    ,&
+     &   PFAC00  , PFAC01  , PFAC10   , PFAC11 ,&
+     &   KJP     , KJT     , KJT1     , PONEMINUS ,&
+     &   PCOLH2O , PCOLMOL , PCOLO2   , PCOLO3 ,&
+     &   KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF  , PFORFAC, PFORFRAC, KINDFOR ,&
+     &   ZSFLXZEN, ZTAUG   , ZTAUR    , PRMU0     &
+     & )  
+
+  ELSEIF (JB == 25) THEN
+    !--- visible 16000-22650 cm-1   0.4415 - 0.6250 um
+    CALL SRTM_TAUMOL25 &
+     & ( KIDIA    , KFDIA   , KLEV     ,&
+     &   PFAC00   , PFAC01  , PFAC10 , PFAC11 ,&
+     &   KJP      , KJT     , KJT1   ,&
+     &   PCOLH2O  , PCOLMOL , PCOLO3 ,&
+     &   KLAYTROP ,&
+     &   ZSFLXZEN, ZTAUG   , ZTAUR   , PRMU0     &
+     & )  
+
+  ELSEIF (JB == 26) THEN
+    !--- UV-A 22650-29000 cm-1   0.3448 - 0.4415 um
+    CALL SRTM_TAUMOL26 &
+     & ( KIDIA   , KFDIA   , KLEV    ,&
+     &   PCOLMOL ,KLAYTROP,&
+     &   ZSFLXZEN, ZTAUG   , ZTAUR    , PRMU0     &
+     & )  
+
+  ELSEIF (JB == 27) THEN
+    !--- UV-B 29000-38000 cm-1   0.2632 - 0.3448 um
+    CALL SRTM_TAUMOL27 &
+     & ( KIDIA   , KFDIA   , KLEV    ,&
+     &   PFAC00  , PFAC01  , PFAC10   , PFAC11 ,&
+     &   KJP     , KJT     , KJT1     ,&
+     &   PCOLMOL , PCOLO3 ,&
+     &   KLAYTROP ,&
+     &   ZSFLXZEN, ZTAUG   , ZTAUR    , PRMU0     &
+     & )  
+
+  ELSEIF (JB == 28) THEN
+    !--- UV-C 38000-50000 cm-1   0.2000 - 0.2632 um
+    CALL SRTM_TAUMOL28 &
+     & ( KIDIA   , KFDIA   , KLEV    ,&
+     &   PFAC00  , PFAC01  , PFAC10 , PFAC11 ,&
+     &   KJP     , KJT     , KJT1   , PONEMINUS ,&
+     &   PCOLMOL , PCOLO2  , PCOLO3 ,&
+     &   KLAYTROP ,&
+     &   ZSFLXZEN, ZTAUG   , ZTAUR  , PRMU0     &
+     & )  
+
+  ELSEIF (JB == 29) THEN
+    CALL SRTM_TAUMOL29 &
+     & ( KIDIA    , KFDIA   , KLEV     ,&
+     &   PFAC00   , PFAC01  , PFAC10   , PFAC11 ,&
+     &   KJP      , KJT     , KJT1     ,&
+     &   PCOLH2O  , PCOLCO2 , PCOLMOL  ,&
+     &   KLAYTROP , PSELFFAC, PSELFFRAC, KINDSELF  , PFORFAC, PFORFRAC, KINDFOR ,&
+     &   ZSFLXZEN , ZTAUG   , ZTAUR    , PRMU0     &
+     & )  
+
+  ENDIF
+   
+!J---Start---
+  DO JK=1,KLEV
+    IKL=KLEV+1-JK
+    DO IC=1,ICOUNT
+      JL=INDEX(IC)
+      ZPAOJ(JL,JK) = PASYA(JL,IKL,IBM)*POMGA(JL,IKL,IBM)
+      ZPTOJ(JL,JK) = PTAUA(JL,IKL,IBM)*POMGA(JL,IKL,IBM)
+    ENDDO
+  ENDDO
+!J---End---
+
+  DO JG=1,IGT
+    DO IC=1,ICOUNT
+      JL=INDEX(IC)
+      IW(JL)=IW(JL)+1
+
+      ZINCFLX(JL,IW(JL)) =ZSFLXZEN(JL,JG)*PRMU0(JL)
+      ZINCFLUX(JL)    =ZINCFLUX(JL)+ZSFLXZEN(JL,JG)*PRMU0(JL)           
+      ZINCTOT(JL)     =ZINCTOT(JL)+ZSFLXZEN(JL,JG)
+      ZINCF14(JL,IBM)=ZINCF14(JL,IBM)+ZSFLXZEN(JL,JG)
+
+      !-- CALL to compute layer reflectances and transmittances for direct 
+      !  and diffuse sources, first clear then cloudy.
+      !   Use direct/parallel albedo for direct radiation and diffuse albedo
+      !   otherwise.
+
+      ! 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(JL,1)=1._JPRB
+      !----- surface values
+      ZDBTC(JL,KLEV+1) =0.0_JPRB
+      ZTRAC(JL,KLEV+1) =0.0_JPRB
+      ZTRADC(JL,KLEV+1)=0.0_JPRB
+      ZREFC(JL,KLEV+1) =PALBP(JL,IBM)
+      ZREFDC(JL,KLEV+1)=PALBD(JL,IBM)
+      ZRUPC(JL,KLEV+1) =PALBP(JL,IBM)
+      ZRUPDC(JL,KLEV+1)=PALBD(JL,IBM)
+
+      !-- total sky    
+      !----- TOA direct beam    
+      ZTDBT(JL,1)=1._JPRB
+      !----- surface values
+      ZDBT(JL,KLEV+1) =0.0_JPRB
+      ZTRA(JL,KLEV+1) =0.0_JPRB
+      ZTRAD(JL,KLEV+1)=0.0_JPRB
+      ZREF(JL,KLEV+1) =PALBP(JL,IBM)
+      ZREFD(JL,KLEV+1)=PALBD(JL,IBM)
+      ZRUP(JL,KLEV+1) =PALBP(JL,IBM)
+      ZRUPD(JL,KLEV+1)=PALBD(JL,IBM)
+    ENDDO
+
+
+    !-- NB: a two-stream calculations from top to bottom, but RRTM_SW quantities 
+    !       are given bottom to top (argh!)
+    !       Inputs for clouds and aerosols are bottom to top as inputs
+
+!    DO JK=1,KLEV
+!      IKL=KLEV+1-JK
+!      WRITE(NULOUT,8001) IBM,JG,IKL,(PTAUA(INDEX(IC),IKL,IBM),IC=1,ICOUNT)
+8001  format(1X,'McICA_SW',3I5,30E12.5)
+!    ENDDO
+
+
+
+    DO JK=1,KLEV
+      IKL=KLEV+1-JK
+      DO IC=1,ICOUNT
+        JL=INDEX(IC)
+        !-- clear-sky optical parameters      
+        LLRTCHK(JL,JK)=.TRUE.
+        !-- clear-sky optical parameters including aerosols
+!J      ZTAUC(JL,JK) = ZTAUR(JL,IKL,JG) + ZTAUG(JL,IKL,JG) + PTAUA(JL,IKL,IBM)
+!J      ZOMCC(JL,JK) = ZTAUR(JL,IKL,JG)*1.0_JPRB + PTAUA(JL,IKL,IBM)*POMGA(JL,IKL,IBM)
+!J      ZGCC(JL,JK) = PASYA(JL,IKL,IBM)*POMGA(JL,IKL,IBM)*PTAUA(JL,IKL,IBM) / ZOMCC(JL,JK)
+!J      ZOMCC(JL,JK) = ZOMCC(JL,JK) / ZTAUC(JL,JK)
+!J    ENDDO
+!J  ENDDO
+!J  DO JK=1,KLEV
+!J    IKL=KLEV+1-JK
+!J    DO IC=1,ICOUNT
+!J      JL=INDEX(IC)
+!J      !-- total sky optical parameters        
+!J      ZTAUO(JL,JK) = ZTAUR(JL,IKL,JG) + ZTAUG(JL,IKL,JG) + PTAUA(JL,IKL,IBM) + PTAUC(JL,IKL,IW(JL))
+!J      ZOMCO(JL,JK) = PTAUA(JL,IKL,IBM)*POMGA(JL,IKL,IBM) + PTAUC(JL,IKL,IW(JL))*POMGC(JL,IKL,IW(JL)) &
+!J       & + ZTAUR(JL,IKL,JG)*1.0_JPRB  
+!J      ZGCO(JL,JK) = (PTAUC(JL,IKL,IW(JL))*POMGC(JL,IKL,IW(JL))*PASYC(JL,IKL,IW(JL))  &
+!J       & +  PTAUA(JL,IKL,IBM)*POMGA(JL,IKL,IBM)*PASYA(JL,IKL,IBM)) &
+!J       & /  ZOMCO(JL,JK)  
+!J      ZOMCO(JL,JK) = ZOMCO(JL,JK) / ZTAUO(JL,JK)
+
+        ZTAU = ZTAUR(JL,IKL,JG) + ZTAUG(JL,IKL,JG)
+!       ZPAO = PASYA(JL,IKL,IBM)*POMGA(JL,IKL,IBM)
+!       ZPTO = PTAUA(JL,IKL,IBM)*POMGA(JL,IKL,IBM)
+        ZPAO = ZPAOJ(JL,JK)
+        ZPTO = ZPTOJ(JL,JK)
+        ZTAUC(JL,JK) = ZTAU + PTAUA(JL,IKL,IBM)
+        ZOMCC(JL,JK) = ZTAUR(JL,IKL,JG) + ZPTO
+        ZGCC(JL,JK) = ZPAO*PTAUA(JL,IKL,IBM) / ZOMCC(JL,JK)
+        ZOMCC(JL,JK) = ZOMCC(JL,JK) / ZTAUC(JL,JK)
+        !-- total sky optical parameters        
+        ZTAUO(JL,JK) = ZTAU + PTAUA(JL,IKL,IBM) + PTAUC(JL,IKL,IW(JL))
+        ZOMCO(JL,JK) = ZPTO + PTAUC(JL,IKL,IW(JL))*POMGC(JL,IKL,IW(JL)) + ZTAUR(JL,IKL,JG)  
+        ZGCO(JL,JK) = (PTAUC(JL,IKL,IW(JL))*POMGC(JL,IKL,IW(JL))*PASYC(JL,IKL,IW(JL))  &
+         & +  PTAUA(JL,IKL,IBM)*ZPAO) /  ZOMCO(JL,JK)  
+        ZOMCO(JL,JK) = ZOMCO(JL,JK) / ZTAUO(JL,JK)
+      ENDDO
+    ENDDO
+
+    !-- Delta scaling for clear-sky / aerosol optical quantities
+    DO  JK=1,KLEV
+      DO IC=1,ICOUNT
+        JL=INDEX(IC)
+        ZF(JL)=ZGCC(JL,JK)*ZGCC(JL,JK)
+        ZWF(JL)=ZOMCC(JL,JK)*ZF(JL)
+        ZTAUC(JL,JK)=(1._JPRB-ZWF(JL))*ZTAUC(JL,JK)
+        ZOMCC(JL,JK)=(ZOMCC(JL,JK)-ZWF(JL))/(1.0_JPRB-ZWF(JL))
+        ZGCC(JL,JK)=(ZGCC(JL,JK)-ZF(JL))/(1.0_JPRB-ZF(JL))
+      ENDDO
+    ENDDO
+
+    CALL SRTM_REFTRA ( KIDIA, KFDIA, KLEV, I_KMODTS ,&
+     &   LLRTCHK, ZGCC  , PRMU0, ZTAUC , ZOMCC ,&
+     &   ZREFC  , ZREFDC, ZTRAC, ZTRADC )  
+
+    !-- Delta scaling for cloudy quantities
+    DO JK=1,KLEV
+      IKL=KLEV+1-JK
+      DO IC=1,ICOUNT
+        JL=INDEX(IC)
+        LLRTCHK(JL,JK)=.FALSE.
+        ZF(JL)=ZGCO(JL,JK)*ZGCO(JL,JK)
+        ZWF(JL)=ZOMCO(JL,JK)*ZF(JL)
+        ZTAUO(JL,JK)=(1._JPRB-ZWF(JL))*ZTAUO(JL,JK)
+        ZOMCO(JL,JK)=(ZOMCO(JL,JK)-ZWF(JL))/(1._JPRB-ZWF(JL))
+        ZGCO(JL,JK)=(ZGCO(JL,JK)-ZF(JL))/(1._JPRB-ZF(JL))
+        LLRTCHK(JL,JK)=(PFRCL(JL,IW(JL),IKL) > REPCLC)
+      ENDDO
+    ENDDO
+
+    CALL SRTM_REFTRA ( KIDIA, KFDIA, KLEV, I_KMODTS ,&
+     &   LLRTCHK, ZGCO  , PRMU0, ZTAUO , ZOMCO ,&
+     &   ZREFO , ZREFDO, ZTRAO, ZTRADO )  
+
+!J---Start---
+    DO IC=1,ICOUNT
+      JL=INDEX(IC)
+      ZRMU0D(JL)=1.0_JPRB/PRMU0(JL)
+    ENDDO 
+!J---End---
+
+    DO JK=1,KLEV
+      IKL=KLEV+1-JK 
+      DO IC=1,ICOUNT
+        JL=INDEX(IC)
+        !-- combine clear and cloudy contributions for total sky
+
+        ZCLEAR(JL)   = 1.0_JPRB - PFRCL(JL,IW(JL),IKL)
+        ZCLOUD(JL)   = PFRCL(JL,IW(JL),IKL)
+
+        ZREF(JL,JK) = ZCLEAR(JL)*ZREFC(JL,JK) + ZCLOUD(JL)*ZREFO(JL,JK)
+        ZREFD(JL,JK)= ZCLEAR(JL)*ZREFDC(JL,JK)+ ZCLOUD(JL)*ZREFDO(JL,JK)
+        ZTRA(JL,JK) = ZCLEAR(JL)*ZTRAC(JL,JK) + ZCLOUD(JL)*ZTRAO(JL,JK)
+        ZTRAD(JL,JK)= ZCLEAR(JL)*ZTRADC(JL,JK)+ ZCLOUD(JL)*ZTRADO(JL,JK)
+
+        !-- direct beam transmittance        
+!        ZARG1(JL)      = MIN( 200._JPRB, ZTAUC(JL,JK)/PRMU0(JL) )
+!        ZARG2(JL)      = MIN( 200._JPRB, ZTAUO(JL,JK)/PRMU0(JL) )
+!        ZDBTMC(JL)     = EXP(-ZARG1(JL) )
+!        ZDBTMO(JL)     = EXP(-ZARG2(JL) )
+
+!-- Use exponential look-up table for transmittance, or expansion of exponential for 
+!   low optical thickness
+!J      ZE1 = ZTAUC(JL,JK)/PRMU0(JL)
+        ZE1 = ZTAUC(JL,JK)*ZRMU0D(JL)
+        IF (ZE1 <= RODLOW) THEN
+          ZDBTMC(JL) = 1._JPRB - ZE1 + 0.5_JPRB*ZE1*ZE1
+        ELSE
+          ZTBLIND = ZE1 / (BPADE+ZE1)
+          ITIND = RTBLINT * ZTBLIND + 0.5_JPRB
+          ZDBTMC(JL) = TRANS(ITIND)
+        ENDIF
+
+!J      ZE2 = ZTAUO(JL,JK)/PRMU0(JL)
+        ZE2 = ZTAUO(JL,JK)*ZRMU0D(JL)
+        IF (ZE2 <= RODLOW) THEN
+          ZDBTMO(JL) = 1._JPRB - ZE2 + 0.5_JPRB*ZE2*ZE2
+        ELSE
+          ZTBLIND = ZE2 / (BPADE+ZE2)
+          ITIND = RTBLINT * ZTBLIND + 0.5_JPRB
+          ZDBTMO(JL) = TRANS(ITIND)
+        ENDIF
+!---
+
+        ZDBT(JL,JK)   = ZCLEAR(JL)*ZDBTMC(JL)+ZCLOUD(JL)*ZDBTMO(JL)
+        ZTDBT(JL,JK+1)= ZDBT(JL,JK)*ZTDBT(JL,JK)
+
+        !-- clear-sky        
+        ZDBTC(JL,JK)   =ZDBTMC(JL)
+        ZTDBTC(JL,JK+1)=ZDBTC(JL,JK)*ZTDBTC(JL,JK)
+
+      ENDDO
+    ENDDO
+
+    !-- vertical quadrature producing clear-sky fluxes
+
+    !    print *,'SRTM_SPCVRT after 3 before SRTM_VRTQDR clear'
+
+    CALL SRTM_VRTQDR ( KIDIA, KFDIA, KLEV, IW ,&
+     &   ZREFC, ZREFDC, ZTRAC , ZTRADC ,&
+     &   ZDBTC, ZRDNDC, ZRUPC , ZRUPDC, ZTDBTC ,&
+     &   ZCD  , ZCU   , PRMU0 )  
+
+    !-- vertical quadrature producing cloudy fluxes
+
+    CALL SRTM_VRTQDR ( KIDIA, KFDIA, KLEV, IW ,&
+     &   ZREF , ZREFD , ZTRA , ZTRAD ,&
+     &   ZDBT , ZRDND , ZRUP , ZRUPD , ZTDBT ,&
+     &   ZFD  , ZFU   , PRMU0)  
+
+    !-- up and down-welling fluxes at levels
+    DO JK=1,KLEV+1
+      DO IC=1,ICOUNT
+        JL=INDEX(IC)
+        !-- accumulation of spectral fluxes          
+        PBBFU(JL,JK) = PBBFU(JL,JK) + ZINCFLX(JL,IW(JL))*ZFU(JL,JK,IW(JL))
+        PBBFD(JL,JK) = PBBFD(JL,JK) + ZINCFLX(JL,IW(JL))*ZFD(JL,JK,IW(JL))
+        PBBCU(JL,JK) = PBBCU(JL,JK) + ZINCFLX(JL,IW(JL))*ZCU(JL,JK,IW(JL))
+        PBBCD(JL,JK) = PBBCD(JL,JK) + ZINCFLX(JL,IW(JL))*ZCD(JL,JK,IW(JL))
+
+        PBBFDIR(JL,JK)=PBBFDIR(JL,JK)+ZINCFLX(JL,IW(JL))*ZTDBT (JL,JK)
+        PBBCDIR(JL,JK)=PBBCDIR(JL,JK)+ZINCFLX(JL,IW(JL))*ZTDBTC(JL,JK)
+
+      ENDDO
+    ENDDO
+    DO IC=1,ICOUNT
+      JL=INDEX(IC)
+      IF ( JB >= 26 .AND. JB <= 28 ) THEN
+        PFUVF(JL) = PFUVF(JL) + ZINCFLX(JL,IW(JL))*ZFD(JL,KLEV+1,IW(JL))
+        PFUVC(JL) = PFUVC(JL) + ZINCFLX(JL,IW(JL))*ZCD(JL,KLEV+1,IW(JL))
+      ENDIF
+      IF ( JB == 23) THEN
+        PPARF(JL) = PPARF(JL)+ ZINCFLX(JL,IW(JL))*ZFD(JL,KLEV+1,IW(JL))*ZCOEFVS
+        PPARCF(JL)=PPARCF(JL)+ ZINCFLX(JL,IW(JL))*ZCD(JL,KLEV+1,IW(JL))*ZCOEFVS 
+      ENDIF
+      IF ( JB == 24) THEN
+        PPARF(JL) = PPARF(JL)+ ZINCFLX(JL,IW(JL))*ZFD(JL,KLEV+1,IW(JL))
+        PPARCF(JL)=PPARCF(JL)+ ZINCFLX(JL,IW(JL))*ZCD(JL,KLEV+1,IW(JL))
+      ENDIF
+      PSUDU(JL) = PSUDU(JL)  + ZINCFLX(JL,IW(JL))*ZTDBT(JL,KLEV+1)
+    ENDDO
+
+    ! Store the shortwave downwelling fluxes in each band
+    IF (LApproxSwUpdate) THEN
+      JB_ALBEDO = NMPSRTM(JB-IB1+1)
+      DO IC = 1,ICOUNT
+        JL = INDEX(IC)
+        PSwDiffuseBand(JL,JB_ALBEDO)= PSwDiffuseBand(JL,JB_ALBEDO) &
+             & + ZINCFLX(JL,IW(JL)) * (ZFD(JL, KLEV+1, IW(JL))-ZTDBT(JL,KLEV+1))
+        PSwDirectBand(JL,JB_ALBEDO) = PSwDirectBand(JL,JB_ALBEDO) &
+             & + ZINCFLX(JL,IW(JL)) * ZTDBT(JL,KLEV+1)
+      ENDDO
+    ENDIF
+
+  ENDDO
+  !-- end loop on JG
+
+ENDDO
+!-- end loop on JB
+
+!     ------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_SPCVRT_MCICA',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE SRTM_SPCVRT_MCICA
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_srtm_224gp_mcica.F90.or
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_srtm_224gp_mcica.F90.or	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_srtm_224gp_mcica.F90.or	(revision 3908)
@@ -0,0 +1,463 @@
+SUBROUTINE SRTM_SRTM_224GP_MCICA &
+ & ( KIDIA, KFDIA, KLON , KLEV , KSW  , KCOLS , KCLDLY ,&
+ &   PAER , PALBD, PALBP, PAPH , PAP  , PAERTAUS, PAERASYS, PAEROMGS ,&
+ &   PTS  , PTH  , PT   ,&
+ &   PQ   , PCO2 , PCH4 , PN2O , PNO2 , POZN  , PRMU0 ,&
+ &   PFRCL, PTAUC, PASYC, POMGC,&
+ &   PFSUX, PFSUC, PFUVF, PFUVC, PPARF, PPARCF, PSUDU ,&
+ &   PFDIR, PCDIR, PFDIF, PCDIF, PSwDiffuseBand, PSwDirectBand, RII0)  
+
+!----compiled for Cray with -h nopaattern----
+
+!-- interface to RRTM_SW
+!     JJMorcrette 030225
+!     JJMorcrette 20050110  McICA version
+!     JJMorcrette 20070614  bug-fix for solar duration
+!     JJMorcrette 20071015  3D fields of CO2, CH4, N2O and NO2
+!     D.Salmond  31-Oct-2007 Vector version in the style of RRTM from Meteo France & NEC
+!     JJMorcrette 20091201  Total and clear-sky downward direct flux
+!     PBechtold+NSemane  09-Jul-2012 Gravity
+!     R J Hogan   20140627  Passing through PSwDn*SurfBand
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
+USE YOMCST   , ONLY : RG, RI0
+USE YOERAD   , ONLY : NSW, NAER, LApproxSwUpdate
+USE YOESRTAER, ONLY : RSRTAUA, RSRPIZA, RSRASYA
+USE YOEAERATM, ONLY : LAERRRTM, LAERCSTR, LAERVOL
+!USE YOMPHY3  , ONLY : RII0
+USE YOMDYNCORE,ONLY : RPLRG
+USE YOM_YGFL , ONLY : YGFL
+
+IMPLICIT NONE
+
+!-- Input arguments
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLON 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
+INTEGER(KIND=JPIM),INTENT(IN)    :: KSW  
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KCOLS
+INTEGER(KIND=JPIM),INTENT(IN)    :: KCLDLY(KCOLS) 
+
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PAER(KLON,6,KLEV)    ! top to bottom
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PAERTAUS(KLON,KLEV,14), PAERASYS(KLON,KLEV,14), PAEROMGS(KLON,KLEV,14)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBD(KLON,KSW) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBP(KLON,KSW) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPH(KLON,KLEV+1) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PAP(KLON,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(KLON) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PTH(KLON,KLEV+1) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KLON,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KLON,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PCO2(KLON,KLEV), PCH4(KLON,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PN2O(KLON,KLEV), PNO2(KLON,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: POZN(KLON,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KLON)
+
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PFRCL(KLON,KCOLS,KLEV) ! bottom to top
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUC(KLON,KCOLS,KLEV) ! bottom to top
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PASYC(KLON,KCOLS,KLEV) ! bottom to top
+REAL(KIND=JPRB)   ,INTENT(IN)    :: POMGC(KLON,KCOLS,KLEV) ! bottom to top
+
+!-- Output arguments
+
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSUX(KLON,2,KLEV+1) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSUC(KLON,2,KLEV+1) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFUVF(KLON), PFUVC(KLON), PPARF(KLON), PPARCF(KLON)
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSUDU(KLON)
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFDIF(KLON,KLEV+1), PCDIF(KLON,KLEV+1)
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFDIR(KLON,KLEV+1), PCDIR(KLON,KLEV+1)
+
+! Surface diffuse and direct downwelling shortwave flux in each
+! shortwave albedo band, used in RADINTG to update the surface fluxes
+! accounting for high-resolution albedo information
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSwDiffuseBand(KLON,NSW)
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSwDirectBand (KLON,NSW)
+
+REAL(KIND=JPRB)   ,INTENT(IN)    :: RII0
+!-----------------------------------------------------------------------
+
+!-- dummy integers
+
+INTEGER(KIND=JPIM) :: ICLDATM, INFLAG, ICEFLAG, I_LIQFLAG, ITMOL, I_NSTR
+
+INTEGER(KIND=JPIM) :: IK, IMOL, J1, J2, JAE, JL, JK, JSW, JB
+
+!-- dummy reals
+
+REAL(KIND=JPRB) :: ZPZ(KIDIA:KFDIA,0:KLEV)   , ZPAVEL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZTAVEL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZCOLDRY(KIDIA:KFDIA,KLEV) , ZCOLMOL(KIDIA:KFDIA,KLEV) , ZWKL(KIDIA:KFDIA,35,KLEV)
+REAL(KIND=JPRB) :: ZCOLCH4(KIDIA:KFDIA,KLEV) , ZCOLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZCOLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZCOLO2(KIDIA:KFDIA,KLEV)  , ZCOLO3(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZFORFAC(KIDIA:KFDIA,KLEV) , ZFORFRAC(KIDIA:KFDIA,KLEV), ZSELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZSELFFRAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZFAC00(KIDIA:KFDIA,KLEV)  , ZFAC01(KIDIA:KFDIA,KLEV)  , ZFAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZFAC11(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZONEMINUS(KIDIA:KFDIA)    , ZRMU0(KIDIA:KFDIA) , ZADJI0
+REAL(KIND=JPRB) :: ZALBD(KIDIA:KFDIA,KSW)    , ZALBP(KIDIA:KFDIA,KSW)    
+
+REAL(KIND=JPRB) :: ZFRCL(KIDIA:KFDIA,KCOLS,KLEV), ZTAUC(KIDIA:KFDIA,KLEV,KCOLS), &
+                 & ZASYC(KIDIA:KFDIA,KLEV,KCOLS)
+REAL(KIND=JPRB) :: ZOMGC(KIDIA:KFDIA,KLEV,KCOLS)
+REAL(KIND=JPRB) :: ZTAUA(KIDIA:KFDIA,KLEV,KSW), ZASYA(KIDIA:KFDIA,KLEV,KSW), ZOMGA(KIDIA:KFDIA,KLEV,KSW)
+REAL(KIND=JPRB) :: ZFUVF(KIDIA:KFDIA), ZFUVC(KIDIA:KFDIA), ZPARF(KIDIA:KFDIA), ZPARCF(KIDIA:KFDIA), ZSUDU(KIDIA:KFDIA)
+
+REAL(KIND=JPRB) :: ZBBCD(KIDIA:KFDIA,KLEV+1), ZBBCU(KIDIA:KFDIA,KLEV+1), ZBBFD(KIDIA:KFDIA,KLEV+1), &
+                 & ZBBFU(KIDIA:KFDIA,KLEV+1)
+REAL(KIND=JPRB) :: ZBBFDIR(KIDIA:KFDIA,KLEV+1),ZBBCDIR(KIDIA:KFDIA,KLEV+1)
+
+! As PSw*Band but dimensioned KIDIA:KFDIA
+REAL(KIND=JPRB) :: ZSwDiffuseBand(KIDIA:KFDIA,NSW)
+REAL(KIND=JPRB) :: ZSwDirectBand (KIDIA:KFDIA,NSW)
+
+INTEGER(KIND=JPIM) :: ILAYTROP(KIDIA:KFDIA)
+INTEGER(KIND=JPIM) :: INDFOR(KIDIA:KFDIA,KLEV), INDSELF(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM) :: JP(KIDIA:KFDIA,KLEV), JT(KIDIA:KFDIA,KLEV), JT1(KIDIA:KFDIA,KLEV)
+
+REAL(KIND=JPRB) :: ZAMD                  ! Effective molecular weight of dry air (g/mol)
+REAL(KIND=JPRB) :: ZAMW                  ! Molecular weight of water vapor (g/mol)
+REAL(KIND=JPRB) :: ZAMCO2                ! Molecular weight of carbon dioxide (g/mol)
+REAL(KIND=JPRB) :: ZAMO                  ! Molecular weight of ozone (g/mol)
+REAL(KIND=JPRB) :: ZAMCH4                ! Molecular weight of methane (g/mol)
+REAL(KIND=JPRB) :: ZAMN2O                ! Molecular weight of nitrous oxide (g/mol)
+REAL(KIND=JPRB) :: ZAMC11                ! Molecular weight of CFC11 (g/mol) - CFCL3
+REAL(KIND=JPRB) :: ZAMC12                ! Molecular weight of CFC12 (g/mol) - CF2CL2
+REAL(KIND=JPRB) :: ZAVGDRO               ! Avogadro's number (molecules/mole)
+REAL(KIND=JPRB) :: ZGRAVIT               ! Gravitational acceleration (cm/sec2)
+REAL(KIND=JPRB) :: ZAMM(KIDIA:KFDIA)
+
+REAL(KIND=JPRB) :: ZRAMW                  ! Molecular weight of water vapor (g/mol)
+REAL(KIND=JPRB) :: ZRAMCO2                ! Molecular weight of carbon dioxide (g/mol)
+REAL(KIND=JPRB) :: ZRAMO                  ! Molecular weight of ozone (g/mol)
+REAL(KIND=JPRB) :: ZRAMCH4                ! Molecular weight of methane (g/mol)
+REAL(KIND=JPRB) :: ZRAMN2O                ! Molecular weight of nitrous oxide (g/mol)
+
+! Atomic weights for conversion from mass to volume mixing ratios; these
+!  are the same values used in ECRT to assure accurate conversion to vmr
+data ZAMD   /  28.970_JPRB    /
+data ZAMW   /  18.0154_JPRB   /
+data ZAMCO2 /  44.011_JPRB    /
+data ZAMO   /  47.9982_JPRB   /
+data ZAMCH4 /  16.043_JPRB    /
+data ZAMN2O /  44.013_JPRB    /
+data ZAMC11 / 137.3686_JPRB   /
+data ZAMC12 / 120.9140_JPRB   /
+data ZAVGDRO/ 6.02214E23_JPRB /
+data ZRAMW   /  0.05550_JPRB   /
+data ZRAMCO2 /  0.02272_JPRB   /
+data ZRAMO   /  0.02083_JPRB   /
+data ZRAMCH4 /  0.06233_JPRB    /
+data ZRAMN2O /  0.02272_JPRB    /
+
+
+!REAL(KIND=JPRB) :: ZCLEAR, ZCLOUD, ZTOTCC
+REAL(KIND=JPRB) :: ZEPSEC
+
+INTEGER(KIND=JPIM) :: IOVLP, IC, ICOUNT, INDEX(KIDIA:KFDIA)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+
+#include "srtm_setcoef.intfb.h"
+#include "srtm_spcvrt_mcica.intfb.h"
+
+
+!-----------------------------------------------------------------------
+!-- calculate information needed ny the radiative transfer routine 
+
+ASSOCIATE(NFLEVG=>KLEV, &
+ & NACTAERO=>YGFL%NACTAERO)
+IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP_MCICA',0,ZHOOK_HANDLE)
+ZGRAVIT =(RG/RPLRG)*1.E2_JPRB
+ZEPSEC  = 1.E-06_JPRB
+ZONEMINUS=1.0_JPRB -  ZEPSEC
+ZADJI0 = RII0 / RI0
+!-- overlap: 1=max-ran, 2=maximum, 3=random   N.B.: irrelevant in McICA version
+IOVLP=3
+
+IC=0
+DO JL = KIDIA, KFDIA
+  IF (PRMU0(JL) > 0.0_JPRB) THEN
+    IC=IC+1
+    INDEX(IC)=JL
+  ENDIF
+ENDDO
+ICOUNT=IC
+
+ICLDATM  = 1
+INFLAG   = 2
+ICEFLAG  = 3
+I_LIQFLAG= 1
+ITMOL    = 7
+I_NSTR   = 2
+
+DO JSW=1,KCOLS
+  DO JK=1,KLEV
+    DO JL = KIDIA, KFDIA
+      ZFRCL(JL,JSW,JK) = PFRCL(JL,JSW,JK)
+      ZTAUC(JL,JK,JSW) = PTAUC(JL,JSW,JK)
+      ZASYC(JL,JK,JSW) = PASYC(JL,JSW,JK)
+      ZOMGC(JL,JK,JSW) = POMGC(JL,JSW,JK)
+    ENDDO
+  ENDDO
+ENDDO
+
+ZRMU0(KIDIA:KFDIA)=PRMU0(KIDIA:KFDIA)
+PFUVF(KIDIA:KFDIA)=0._JPRB
+PFUVC(KIDIA:KFDIA)=0._JPRB
+PPARF(KIDIA:KFDIA)=0._JPRB
+PPARCF(KIDIA:KFDIA)=0._JPRB
+
+!- coefficients related to the cloud optical properties (original RRTM_SW)
+
+!- coefficients for the temperature and pressure dependence of the 
+! molecular absorption coefficients
+
+DO J1=1,35
+  DO J2=1,KLEV
+    DO IC=1,ICOUNT
+      JL=INDEX(IC)
+      ZWKL(JL,J1,J2)=0.0_JPRB 
+    ENDDO
+  ENDDO
+ENDDO
+
+DO IC=1,ICOUNT
+  JL=INDEX(IC)
+  ZPZ(JL,0) = paph(JL,klev+1)*0.01_JPRB
+ENDDO
+
+!ZCLEAR=1.0_JPRB
+!ZCLOUD=0.0_JPRB
+!ZTOTCC=0.0_JPRB
+
+DO JK = 1, KLEV
+  DO IC=1,ICOUNT
+    JL=INDEX(IC)
+    ZPAVEL(JL,JK) = pap(JL,KLEV-JK+1) *0.01_JPRB
+    ZTAVEL(JL,JK) = pt (JL,KLEV-JK+1)
+    ZPZ(JL,JK)    = paph(JL,KLEV-JK+1) *0.01_JPRB
+    ZWKL(JL,1,JK) = pq(JL,KLEV-JK+1)  *ZAMD*ZRAMW
+    ZWKL(JL,2,JK) = PCO2(JL,KLEV-JK+1)*ZAMD*ZRAMCO2
+    ZWKL(JL,3,JK) = pozn(JL,KLEV-JK+1)*ZAMD*ZRAMO
+    ZWKL(JL,4,JK) = PN2O(JL,KLEV-JK+1)*ZAMD*ZRAMN2O
+    ZWKL(JL,6,JK) = PCH4(JL,KLEV-JK+1)*ZAMD*ZRAMCH4
+!O2 volume mixing ratio
+    ZWKL(JL,7,JK) = 0.20944_JPRB
+    ZAMM(JL) = (1-ZWKL(JL,1,JK))*ZAMD + ZWKL(JL,1,JK)*ZAMW
+    ZCOLDRY(JL,JK) = (ZPZ(JL,JK-1)-ZPZ(JL,JK))*1.E3_JPRB*ZAVGDRO/(ZGRAVIT*ZAMM(JL)*(1+ZWKL(JL,1,JK)))
+  ENDDO
+ENDDO
+
+DO IMOL=1,ITMOL
+  DO JK=1,KLEV
+    DO IC=1,ICOUNT
+      JL=INDEX(IC)
+      ZWKL(JL,IMOL,JK)=ZCOLDRY(JL,JK)* ZWKL(JL,IMOL,JK)
+    ENDDO
+  ENDDO
+ENDDO
+
+CALL SRTM_SETCOEF &
+ & ( KIDIA , KFDIA    , KLEV,&
+ & ZPAVEL  , ZTAVEL,&
+ & ZCOLDRY , ZWKL,&
+ & ILAYTROP,&
+ & ZCOLCH4  , ZCOLCO2 , ZCOLH2O , ZCOLMOL  , ZCOLO2 , ZCOLO3,&
+ & ZFORFAC , ZFORFRAC , INDFOR  , ZSELFFAC, ZSELFFRAC, INDSELF, &
+ & ZFAC00  , ZFAC01   , ZFAC10  , ZFAC11,&
+ & JP      , JT       , JT1     , ZRMU0  &
+ & )  
+
+!- call the radiation transfer routine
+
+DO JSW=1,KSW
+  DO IC=1,ICOUNT
+    JL=INDEX(IC)
+    ZALBD(JL,JSW)=PALBD(JL,JSW)
+    ZALBP(JL,JSW)=PALBP(JL,JSW)
+  ENDDO
+ENDDO
+
+!- mixing of aerosols
+
+IF (NAER == 0) THEN
+  DO JSW=1,KSW
+    DO JK=1,KLEV
+      DO IC=1,ICOUNT
+        JL=INDEX(IC)
+        ZTAUA(JL,JK,JSW)= 0.0_JPRB
+        ZASYA(JL,JK,JSW)= 0.0_JPRB
+        ZOMGA(JL,JK,JSW)= 1.0_JPRB
+      ENDDO
+    ENDDO
+  ENDDO
+ELSE
+
+!- If prognostic aerosols with proper RRTM optical properties, fill the RRTM aerosol arrays
+
+  IF (LAERRRTM) THEN
+    IF (LAERCSTR .OR. (LAERVOL .AND. NACTAERO == 15)) THEN
+      DO JSW=1,KSW
+        DO JK=1,KLEV
+          IK=KLEV-JK+1
+          DO IC=1,ICOUNT
+            JL=INDEX(IC)
+            ZTAUA(JL,JK,JSW)=PAERTAUS(JL,IK,JSW)
+            ZASYA(JL,JK,JSW)=PAERASYS(JL,IK,JSW)
+            ZOMGA(JL,JK,JSW)=PAEROMGS(JL,IK,JSW)
+          ENDDO
+        ENDDO
+      ENDDO
+
+    ELSEIF (.NOT.LAERCSTR) THEN
+      DO JSW=1,KSW
+        DO JK=1,KLEV
+          IK=KLEV-JK+1
+          DO IC=1,ICOUNT
+            JL=INDEX(IC)
+            ZTAUA(JL,JK,JSW)=PAERTAUS(JL,IK,JSW)+RSRTAUA(JSW,6)*PAER(JL,6,IK)
+            ZASYA(JL,JK,JSW)=PAERASYS(JL,IK,JSW)+RSRTAUA(JSW,6)*PAER(JL,6,IK)*RSRPIZA(JSW,6)
+            ZOMGA(JL,JK,JSW)=PAEROMGS(JL,IK,JSW)+RSRTAUA(JSW,6)*PAER(JL,6,IK)*RSRPIZA(JSW,6)*RSRASYA(JSW,6)
+            IF (ZOMGA(JL,JK,JSW) /= 0.0_JPRB) THEN
+              ZASYA(JL,JK,JSW)=ZASYA(JL,JK,JSW)/ZOMGA(JL,JK,JSW)
+            ENDIF
+            IF (ZTAUA(JL,JK,JSW) /= 0.0_JPRB) THEN
+              ZOMGA(JL,JK,JSW)=ZOMGA(JL,JK,JSW)/ZTAUA(JL,JK,JSW)
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDDO
+    ENDIF 
+
+  ELSE
+
+!- Otherwise, fill RRTM aerosol arrays with operational ECMWF aerosols,
+!  do the mixing and distribute over the 14 spectral intervals
+
+    DO JSW=1,KSW
+      DO JK=1,KLEV
+        DO IC=1,ICOUNT
+          JL=INDEX(IC)
+          IK=KLEV+1-JK
+          ZTAUA(JL,JK,JSW)=0.0_JPRB
+          ZASYA(JL,JK,JSW)=0.0_JPRB
+          ZOMGA(JL,JK,JSW)=0.0_JPRB
+!CDIR UNROLL=6
+          DO JAE=1,6
+            ZTAUA(JL,JK,JSW)=ZTAUA(JL,JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK)
+            ZOMGA(JL,JK,JSW)=ZOMGA(JL,JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK) &
+             & *RSRPIZA(JSW,JAE)  
+            ZASYA(JL,JK,JSW)=ZASYA(JL,JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK) &
+             & *RSRPIZA(JSW,JAE)*RSRASYA(JSW,JAE)  
+          ENDDO
+          IF (ZOMGA(JL,JK,JSW) /= 0.0_JPRB) THEN
+            ZASYA(JL,JK,JSW)=ZASYA(JL,JK,JSW)/ZOMGA(JL,JK,JSW)
+          ENDIF
+          IF (ZTAUA(JL,JK,JSW) /= 0.0_JPRB) THEN
+            ZOMGA(JL,JK,JSW)=ZOMGA(JL,JK,JSW)/ZTAUA(JL,JK,JSW)
+          ENDIF
+        ENDDO
+      ENDDO
+    ENDDO
+  ENDIF
+ENDIF
+
+DO JK=1,KLEV+1
+  DO IC=1,ICOUNT
+    JL=INDEX(IC)
+    ZBBCU(JL,JK)=0.0_JPRB
+    ZBBCD(JL,JK)=0.0_JPRB
+    ZBBFU(JL,JK)=0.0_JPRB
+    ZBBFD(JL,JK)=0.0_JPRB
+    ZBBFDIR(JL,JK)=0.0_JPRB
+    ZBBCDIR(JL,JK)=0.0_JPRB
+  ENDDO
+ENDDO
+
+DO IC=1,ICOUNT
+  JL=INDEX(IC)
+  ZFUVF(JL)=0.0_JPRB
+  ZFUVC(JL)=0.0_JPRB
+  ZPARF(JL)=0.0_JPRB
+  ZPARCF(JL)=0.0_JPRB     
+  ZSUDU(JL)=0.0_JPRB
+ENDDO
+
+CALL SRTM_SPCVRT_MCICA &
+ &( KIDIA  , KFDIA    , KLEV   , KSW    , KCOLS  , ZONEMINUS,&
+ & ZALBD   , ZALBP,&
+ & ZFRCL   , ZTAUC    , ZASYC  , ZOMGC  ,&
+ & ZTAUA   , ZASYA   , ZOMGA , ZRMU0,&
+ & ILAYTROP,&
+ & ZCOLCH4 , ZCOLCO2  , ZCOLH2O, ZCOLMOL , ZCOLO2   , ZCOLO3,&
+ & ZFORFAC , ZFORFRAC , INDFOR , ZSELFFAC, ZSELFFRAC, INDSELF,&
+ & ZFAC00  , ZFAC01   , ZFAC10 , ZFAC11  ,&
+ & JP      , JT       , JT1    ,&
+ & ZBBFD   , ZBBFU    , ZBBCD  , ZBBCU , ZFUVF , ZFUVC, ZPARF, ZPARCF, ZSUDU,& 
+ & ZBBFDIR , ZBBCDIR  , ZSwDiffuseBand, ZSwDirectBand)
+
+DO JK=1,KLEV+1
+  DO IC=1,ICOUNT
+    JL=INDEX(IC)
+    PFSUC(JL,1,JK)=ZADJI0 * ZBBCU(JL,JK)
+    PFSUC(JL,2,JK)=ZADJI0 * ZBBCD(JL,JK)
+    PFSUX(JL,1,JK)=ZADJI0 * ZBBFU(JL,JK)
+    PFSUX(JL,2,JK)=ZADJI0 * ZBBFD(JL,JK)
+    PFDIR(JL,JK)  =ZADJI0 * ZBBFDIR(JL,JK)
+    PCDIR(JL,JK)  =ZADJI0 * ZBBCDIR(JL,JK)
+    PFDIF(JL,JK)  =PFSUX(JL,2,JK)-PFDIR(JL,JK)
+    PCDIF(JL,JK)  =PFSUC(JL,2,JK)-PCDIR(JL,JK)
+  ENDDO
+ENDDO
+
+IF (LApproxSwUpdate) THEN
+  DO JB=1,NSW
+    DO IC=1,ICOUNT
+      JL=INDEX(IC)
+      PSwDiffuseBand(JL,JB) = ZADJI0 * ZSwDiffuseBand(JL,JB)
+      PSwDirectBand (JL,JB) = ZADJI0 * ZSwDirectBand (JL,JB)
+    ENDDO
+  ENDDO
+ENDIF
+
+DO IC=1,ICOUNT
+  JL=INDEX(IC)
+  PFUVF(JL) =ZADJI0 * ZFUVF(JL)
+  PFUVC(JL) =ZADJI0 * ZFUVC(JL)
+  PPARF(JL) =ZADJI0 * ZPARF(JL)
+  PPARCF(JL)=ZADJI0 * ZPARCF(JL)
+  PSUDU(JL) =ZADJI0 * ZSUDU(JL)
+ENDDO
+
+DO JK=1,KLEV+1
+  DO IC=1,ICOUNT
+    JL=INDEX(IC)
+    IF (PRMU0(JL) <= 0.0_JPRB) THEN
+      PFSUC(JL,1,JK)=0.0_JPRB
+      PFSUC(JL,2,JK)=0.0_JPRB
+      PFSUX(JL,1,JK)=0.0_JPRB
+      PFSUX(JL,2,JK)=0.0_JPRB
+      PFDIR(JL,JK)  =0.0_JPRB
+      PCDIR(JL,JK)  =0.0_JPRB
+    ENDIF
+  ENDDO
+ENDDO
+DO IC=1,ICOUNT
+  JL=INDEX(IC)
+  IF (PRMU0(JL) <= 0.0_JPRB) THEN
+    PFUVF(JL) =0.0_JPRB
+    PFUVC(JL) =0.0_JPRB
+    PPARF(JL) =0.0_JPRB
+    PPARCF(JL)=0.0_JPRB
+    PSUDU(JL)=0.0_JPRB
+  ENDIF
+ENDDO
+
+!-----------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP_MCICA',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE SRTM_SRTM_224GP_MCICA
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol16.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol16.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol16.F90	(revision 3908)
@@ -0,0 +1,185 @@
+SUBROUTINE SRTM_TAUMOL16 &
+ & ( KIDIA   , KFDIA     , KLEV,&
+ & P_FAC00   , P_FAC01   , P_FAC10   , P_FAC11,&
+ & K_JP      , K_JT      , K_JT1     , P_ONEMINUS,&
+ & P_COLH2O  , P_COLCH4  , P_COLMOL,&
+ & K_LAYTROP , P_SELFFAC , P_SELFFRAC, K_INDSELF , P_FORFAC  , P_FORFRAC, K_INDFOR,&
+ & P_SFLUXZEN, P_TAUG    , P_TAUR    , PRMU0     &
+ & )  
+
+!     Written by Eli J. Mlawer, Atmospheric & Environmental Research.
+
+!     BAND 16:  2600-3250 cm-1 (low - H2O,CH4; high - CH4)
+
+! Modifications
+!        M.Hamrud      01-Oct-2003 CY28 Cleaning
+
+!     JJMorcrette 2003-02-24 adapted to ECMWF environment
+!        D.Salmond  31-Oct-2007 Vector version in the style of RRTM from Meteo France & NEC
+!     JJMorcrette 20010610 Flexible configuration for number of g-points
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
+USE PARSRTM  , ONLY : JPG
+USE YOESRTM  , ONLY : NG16
+USE YOESRTA16, ONLY : ABSA, ABSB, FORREFC, SELFREFC, SFLUXREFC, RAYL, LAYREFFR, STRRAT1  
+USE YOESRTWN , ONLY : NSPA, NSPB
+
+IMPLICIT NONE
+
+!-- Output
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA, KFDIA 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ONEMINUS(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCH4(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLMOL(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDFOR(KIDIA:KFDIA,KLEV) 
+
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SFLUXZEN(KIDIA:KFDIA,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUG(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUR(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KIDIA:KFDIA)
+!- from INTFAC      
+!- from INTIND
+!- from PRECISE             
+!- from PROFDATA             
+!- from SELF             
+INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, INDF, JS, I_LAY, I_LAYSOLFR(KIDIA:KFDIA), I_NLAYERS, IPLON
+
+REAL(KIND=JPRB) :: Z_FAC000, Z_FAC001, Z_FAC010, Z_FAC011, Z_FAC100, Z_FAC101,&
+ & Z_FAC110, Z_FAC111, Z_FS, Z_SPECCOMB, Z_SPECMULT, Z_SPECPARM, &
+ & Z_TAURAY  
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL16',0,ZHOOK_HANDLE)
+
+I_NLAYERS = KLEV
+
+!     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.  
+
+DO I_LAY = 1, I_NLAYERS
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY <= K_LAYTROP(IPLON)) THEN
+        Z_SPECCOMB = P_COLH2O(IPLON,I_LAY) + STRRAT1*P_COLCH4(IPLON,I_LAY)
+        Z_SPECPARM = P_COLH2O(IPLON,I_LAY)/Z_SPECCOMB 
+        IF (Z_SPECPARM >= P_ONEMINUS(IPLON)) Z_SPECPARM = P_ONEMINUS(IPLON)
+        Z_SPECMULT = 8._JPRB*(Z_SPECPARM)
+        JS = 1 + INT(Z_SPECMULT)
+        Z_FS = MOD(Z_SPECMULT, 1.0_JPRB )
+        ! Z_FAC000 = (1.0_JPRB - Z_FS) * P_FAC00(I_LAY)
+        ! Z_FAC010 = (1.0_JPRB - Z_FS) * P_FAC10(I_LAY)
+        ! Z_FAC100 = Z_FS * P_FAC00(I_LAY)
+        ! Z_FAC110 = Z_FS * P_FAC10(I_LAY)
+        ! Z_FAC001 = (1.0_JPRB - Z_FS) * P_FAC01(I_LAY)
+        ! Z_FAC011 = (1.0_JPRB - Z_FS) * P_FAC11(I_LAY)
+        ! Z_FAC101 = Z_FS * P_FAC01(I_LAY)
+        ! Z_FAC111 = Z_FS * P_FAC11(I_LAY)
+        IND0 = ((K_JP(IPLON,I_LAY)-1)*5+(K_JT(IPLON,I_LAY)-1))*NSPA(16) + JS
+        IND1 = (K_JP(IPLON,I_LAY)*5+(K_JT1(IPLON,I_LAY)-1))*NSPA(16) + JS
+        INDS = K_INDSELF(IPLON,I_LAY)
+        INDF = K_INDFOR(IPLON,I_LAY)
+        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
+
+        !  print 9001,LAY,IND0,IND1,INDS,INDF,FAC000,FAC010,FAC100,FAC110,FAC001,FAC011,FAC101,FAC111 &
+        !   &,TAURAY,SELFFAC(LAY),SELFFRAC(LAY),FORFAC(LAY),FORFRAC(LAY)
+9001    format(1x,'T16 ',5I4,13E12.3)
+
+        !  DO IG = 1, NG(16)
+!CDIR UNROLL=NG16
+        DO IG = 1, NG16
+          P_TAUG(IPLON,I_LAY,IG) = Z_SPECCOMB * &
+           !    & (Z_FAC000 * ABSA(IND0   ,IG) + &
+           !    & Z_FAC100 * ABSA(IND0 +1,IG) + &
+           !    & Z_FAC010 * ABSA(IND0 +9,IG) + &
+           !    & Z_FAC110 * ABSA(IND0+10,IG) + &
+           !    & Z_FAC001 * ABSA(IND1   ,IG) + &
+           !    & Z_FAC101 * ABSA(IND1 +1,IG) + &
+           !    & Z_FAC011 * ABSA(IND1 +9,IG) + &
+           !    & Z_FAC111 * ABSA(IND1+10,IG)) + &
+           & (&
+           & (1. - Z_FS) * ( ABSA(IND0,IG) * P_FAC00(IPLON,I_LAY) + &
+           &                 ABSA(IND0+9,IG) * P_FAC10(IPLON,I_LAY) + &
+           &                 ABSA(IND1,IG) * P_FAC01(IPLON,I_LAY) + &
+           &                 ABSA(IND1+9,IG) * P_FAC11(IPLON,I_LAY) ) + &
+           & Z_FS        * ( ABSA(IND0+1,IG) * P_FAC00(IPLON,I_LAY) + &
+           &                 ABSA(IND0+10,IG) * P_FAC10(IPLON,I_LAY) + &
+           &                 ABSA(IND1+1,IG) * P_FAC01(IPLON,I_LAY) + &
+           &                 ABSA(IND1+10,IG) * P_FAC11(IPLON,I_LAY) ) &
+           & ) + &
+           & P_COLH2O(IPLON,I_LAY) * &
+           & (P_SELFFAC(IPLON,I_LAY) * (SELFREFC(INDS,IG) + &
+           & P_SELFFRAC(IPLON,I_LAY) * &
+           & (SELFREFC(INDS+1,IG) - SELFREFC(INDS,IG))) + &
+           & P_FORFAC(IPLON,I_LAY) * (FORREFC(INDF,IG) + &
+           & P_FORFRAC(IPLON,I_LAY) * &
+           & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG))))   
+          !     &           + TAURAY
+          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
+          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
+          !    print 9002,LAY,IG,ABSA(IND0,IG),ABSA(IND0+1,IG),ABSA(IND0+9,IG),ABSA(IND0+10,IG) & 
+          !      &, ABSA(IND1,IG),ABSA(IND1+1,IG),ABSA(IND1+9,IG),ABSA(IND1+10,IG) & 
+          !      &, SELFREFC(INDS+1,IG),SELFREFC(INDS,IG),FORREFC(INDF+1,IG),FORREFC(INDF,IG)
+9002      format(1x,'U16 ',2I3,12E12.3)
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+I_LAYSOLFR(:) = I_NLAYERS
+
+DO I_LAY = 1, I_NLAYERS
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY >= K_LAYTROP(IPLON)+1) THEN
+        IF (K_JP(IPLON,I_LAY-1) < LAYREFFR .AND. K_JP(IPLON,I_LAY) >= LAYREFFR) &
+         & I_LAYSOLFR(IPLON) = I_LAY  
+        IND0 = ((K_JP(IPLON,I_LAY)-13)*5+(K_JT(IPLON,I_LAY)-1))*NSPB(16) + 1
+        IND1 = ((K_JP(IPLON,I_LAY)-12)*5+(K_JT1(IPLON,I_LAY)-1))*NSPB(16) + 1
+        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
+
+        !  DO IG = 1, NG(16)
+!CDIR UNROLL=NG16
+        DO IG = 1, NG16
+          P_TAUG(IPLON,I_LAY,IG) = P_COLCH4(IPLON,I_LAY) * &
+           & (P_FAC00(IPLON,I_LAY) * ABSB(IND0  ,IG) + &
+           & P_FAC10(IPLON,I_LAY) * ABSB(IND0+1,IG) + &
+           & P_FAC01(IPLON,I_LAY) * ABSB(IND1  ,IG) + &
+           & P_FAC11(IPLON,I_LAY) * ABSB(IND1+1,IG))   
+          !     &           + TAURAY
+          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
+          IF (I_LAY == I_LAYSOLFR(IPLON)) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG) 
+          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY  
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+!DO LAY=1,NLAYERS
+!  print 9003,LAY,(TAUG(LAY,IG),IG=1,NG16)
+9003 format(1x,'O16 ',I3,16E13.5)
+!END DO
+
+!----------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL16',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE SRTM_TAUMOL16
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol16.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol16.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol16.intfb.h	(revision 3908)
@@ -0,0 +1,37 @@
+INTERFACE
+SUBROUTINE SRTM_TAUMOL16&
+ & ( KIDIA , KFDIA , KLEV,&
+ & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
+ & K_JP , K_JT , K_JT1 , P_ONEMINUS,&
+ & P_COLH2O , P_COLCH4 , P_COLMOL,&
+ & K_LAYTROP , P_SELFFAC , P_SELFFRAC, K_INDSELF , P_FORFAC , P_FORFRAC, K_INDFOR,&
+ & P_SFLUXZEN, P_TAUG , P_TAUR , PRMU0&
+ & ) 
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE PARSRTM , ONLY : JPG
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA, KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCH4(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(KIDIA:KFDIA,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KIDIA:KFDIA)
+END SUBROUTINE SRTM_TAUMOL16
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol17.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol17.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol17.F90	(revision 3908)
@@ -0,0 +1,199 @@
+SUBROUTINE SRTM_TAUMOL17 &
+ & ( KIDIA   , KFDIA    , KLEV,&
+ & P_FAC00   , P_FAC01  , P_FAC10   , P_FAC11,&
+ & K_JP      , K_JT     , K_JT1     , P_ONEMINUS,&
+ & P_COLH2O  , P_COLCO2 , P_COLMOL,&
+ & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF  , P_FORFAC, P_FORFRAC, K_INDFOR,&
+ & P_SFLUXZEN, P_TAUG   , P_TAUR    , PRMU0   &
+ & )  
+
+!     Written by Eli J. Mlawer, Atmospheric & Environmental Research.
+
+!     BAND 17:  3250-4000 cm-1 (low - H2O,CO2; high - H2O,CO2)
+
+! Modifications
+!        M.Hamrud      01-Oct-2003 CY28 Cleaning
+
+!     JJMorcrette 2003-02-24 adapted to ECMWF environment
+!        D.Salmond  31-Oct-2007 Vector version in the style of RRTM from Meteo France & NEC
+!     JJMorcrette 20010610 Flexible configuration for number of g-points
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
+USE PARSRTM  , ONLY : JPG
+USE YOESRTM  , ONLY : NG17
+USE YOESRTA17, ONLY : ABSA, ABSB, FORREFC, SELFREFC, SFLUXREFC, RAYL, LAYREFFR, STRRAT  
+USE YOESRTWN , ONLY : NSPA, NSPB
+
+IMPLICIT NONE
+
+!-- Output
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA, KFDIA 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ONEMINUS(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCO2(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLMOL(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDFOR(KIDIA:KFDIA,KLEV) 
+
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SFLUXZEN(KIDIA:KFDIA,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUG(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUR(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KIDIA:KFDIA)
+!- from INTFAC      
+!- from INTIND
+!- from PRECISE             
+!- from PROFDATA             
+!- from SELF             
+INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, INDF, JS, I_LAY, I_LAYSOLFR(KIDIA:KFDIA), I_NLAYERS, IPLON
+
+! REAL(KIND=JPRB) :: Z_FAC000, Z_FAC001, Z_FAC010, Z_FAC011, Z_FAC100, Z_FAC101,&
+!  & Z_FAC110, Z_FAC111
+REAL(KIND=JPRB) :: Z_FS, Z_SPECCOMB, Z_SPECMULT, Z_SPECPARM, Z_TAURAY  
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL17',0,ZHOOK_HANDLE)
+
+I_NLAYERS = KLEV
+
+!     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.  
+
+DO I_LAY = 1, I_NLAYERS
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY <= K_LAYTROP(IPLON)) THEN
+        Z_SPECCOMB = P_COLH2O(IPLON,I_LAY) + STRRAT*P_COLCO2(IPLON,I_LAY)
+        Z_SPECPARM = P_COLH2O(IPLON,I_LAY)/Z_SPECCOMB 
+        IF (Z_SPECPARM >= P_ONEMINUS(IPLON)) Z_SPECPARM = P_ONEMINUS(IPLON)
+        Z_SPECMULT = 8.*(Z_SPECPARM)
+        JS = 1 + INT(Z_SPECMULT)
+        Z_FS = MOD(Z_SPECMULT, 1.0_JPRB )
+        ! Z_FAC000 = (1. - Z_FS) * P_FAC00(I_LAY)
+        ! Z_FAC010 = (1. - Z_FS) * P_FAC10(I_LAY)
+        ! Z_FAC100 = Z_FS * P_FAC00(I_LAY)
+        ! Z_FAC110 = Z_FS * P_FAC10(I_LAY)
+        ! Z_FAC001 = (1. - Z_FS) * P_FAC01(I_LAY)
+        ! Z_FAC011 = (1. - Z_FS) * P_FAC11(I_LAY)
+        ! Z_FAC101 = Z_FS * P_FAC01(I_LAY)
+        ! Z_FAC111 = Z_FS * P_FAC11(I_LAY)
+        IND0 = ((K_JP(IPLON,I_LAY)-1)*5+(K_JT(IPLON,I_LAY)-1))*NSPA(17) + JS
+        IND1 = (K_JP(IPLON,I_LAY)*5+(K_JT1(IPLON,I_LAY)-1))*NSPA(17) + JS
+        INDS = K_INDSELF(IPLON,I_LAY)
+        INDF = K_INDFOR(IPLON,I_LAY)
+        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
+
+        !  DO IG = 1, NG(17)
+!CDIR UNROLL=NG17
+        DO IG = 1, NG17
+          P_TAUG(IPLON,I_LAY,IG) = Z_SPECCOMB * &
+           & (&
+           & (1. - Z_FS) * ( ABSA(IND0,IG) * P_FAC00(IPLON,I_LAY) + &
+           &                 ABSA(IND0+9,IG) * P_FAC10(IPLON,I_LAY) + &
+           &                 ABSA(IND1,IG) * P_FAC01(IPLON,I_LAY) + &
+           &                 ABSA(IND1+9,IG) * P_FAC11(IPLON,I_LAY) ) + &
+           & Z_FS        * ( ABSA(IND0+1,IG) * P_FAC00(IPLON,I_LAY) + &
+           &                 ABSA(IND0+10,IG) * P_FAC10(IPLON,I_LAY) + &
+           &                 ABSA(IND1+1,IG) * P_FAC01(IPLON,I_LAY) + &
+           &                 ABSA(IND1+10,IG) * P_FAC11(IPLON,I_LAY) ) &
+           & )  + &
+           & P_COLH2O(IPLON,I_LAY) * &
+           & (P_SELFFAC(IPLON,I_LAY) * (SELFREFC(INDS,IG) + &
+           & P_SELFFRAC(IPLON,I_LAY) * &
+           & (SELFREFC(INDS+1,IG) - SELFREFC(INDS,IG))) + &
+           & P_FORFAC(IPLON,I_LAY) * (FORREFC(INDF,IG) + &
+           & P_FORFRAC(IPLON,I_LAY) * &
+           & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG))))   
+
+          !     &           + TAURAY
+          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
+          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+I_LAYSOLFR(:) = I_NLAYERS
+
+DO I_LAY = 1, I_NLAYERS
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY >= K_LAYTROP(IPLON)+1) THEN
+        IF (K_JP(IPLON,I_LAY-1) < LAYREFFR .AND. K_JP(IPLON,I_LAY) >= LAYREFFR) &
+         & I_LAYSOLFR(IPLON) = I_LAY  
+        Z_SPECCOMB = P_COLH2O(IPLON,I_LAY) + STRRAT*P_COLCO2(IPLON,I_LAY)
+        Z_SPECPARM = P_COLH2O(IPLON,I_LAY)/Z_SPECCOMB 
+        IF (Z_SPECPARM >= P_ONEMINUS(IPLON)) Z_SPECPARM = P_ONEMINUS(IPLON)
+        Z_SPECMULT = 4.*(Z_SPECPARM)
+        JS = 1 + INT(Z_SPECMULT)
+        Z_FS = MOD(Z_SPECMULT, 1.0_JPRB )
+        ! Z_FAC000 = (1. - Z_FS) * P_FAC00(I_LAY)
+        ! Z_FAC010 = (1. - Z_FS) * P_FAC10(I_LAY)
+        ! Z_FAC100 = Z_FS * P_FAC00(I_LAY)
+        ! Z_FAC110 = Z_FS * P_FAC10(I_LAY)
+        ! Z_FAC001 = (1. - Z_FS) * P_FAC01(I_LAY)
+        ! Z_FAC011 = (1. - Z_FS) * P_FAC11(I_LAY)
+        ! Z_FAC101 = Z_FS * P_FAC01(I_LAY)
+        ! Z_FAC111 = Z_FS * P_FAC11(I_LAY)
+        IND0 = ((K_JP(IPLON,I_LAY)-13)*5+(K_JT(IPLON,I_LAY)-1))*NSPB(17) + JS
+        IND1 = ((K_JP(IPLON,I_LAY)-12)*5+(K_JT1(IPLON,I_LAY)-1))*NSPB(17) + JS
+        INDF = K_INDFOR(IPLON,I_LAY)
+        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
+
+        !  DO IG = 1, NG(17)
+!CDIR UNROLL=NG17
+        DO IG = 1, NG17
+          P_TAUG(IPLON,I_LAY,IG) = Z_SPECCOMB * &
+           !    & (Z_FAC000 * ABSB(IND0,IG) + &
+           !    & Z_FAC100 * ABSB(IND0+1,IG) + &
+           !    & Z_FAC010 * ABSB(IND0+5,IG) + &
+           !    & Z_FAC110 * ABSB(IND0+6,IG) + &
+           !    & Z_FAC001 * ABSB(IND1,IG) + &
+           !    & Z_FAC101 * ABSB(IND1+1,IG) + &
+           !    & Z_FAC011 * ABSB(IND1+5,IG) + &
+           !    & Z_FAC111 * ABSB(IND1+6,IG)) + &
+           & (&
+           & (1. - Z_FS) * ( ABSB(IND0,IG) * P_FAC00(IPLON,I_LAY) + &
+           &                 ABSB(IND0+5,IG) * P_FAC10(IPLON,I_LAY) + &
+           &                 ABSB(IND1,IG) * P_FAC01(IPLON,I_LAY) + &
+           &                 ABSB(IND1+5,IG) * P_FAC11(IPLON,I_LAY) ) + &
+           & Z_FS        * ( ABSB(IND0+1,IG) * P_FAC00(IPLON,I_LAY) + &
+           &                 ABSB(IND0+6,IG) * P_FAC10(IPLON,I_LAY) + &
+           &                 ABSB(IND1+1,IG) * P_FAC01(IPLON,I_LAY) + &
+           &                 ABSB(IND1+6,IG) * P_FAC11(IPLON,I_LAY) ) &
+           & ) + &
+           & P_COLH2O(IPLON,I_LAY) * &
+           & P_FORFAC(IPLON,I_LAY) * (FORREFC(INDF,IG) + &
+           & P_FORFRAC(IPLON,I_LAY) * &
+           & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG)))   
+          !     &           + TAURAY
+          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
+          IF (I_LAY == I_LAYSOLFR(IPLON)) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG,JS) &
+           & + Z_FS * (SFLUXREFC(IG,JS+1) - SFLUXREFC(IG,JS))  
+          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+!-----------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL17',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE SRTM_TAUMOL17
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol17.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol17.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol17.intfb.h	(revision 3908)
@@ -0,0 +1,37 @@
+INTERFACE
+SUBROUTINE SRTM_TAUMOL17&
+ & ( KIDIA , KFDIA , KLEV,&
+ & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
+ & K_JP , K_JT , K_JT1 , P_ONEMINUS,&
+ & P_COLH2O , P_COLCO2 , P_COLMOL,&
+ & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF , P_FORFAC, P_FORFRAC, K_INDFOR,&
+ & P_SFLUXZEN, P_TAUG , P_TAUR , PRMU0&
+ & ) 
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE PARSRTM , ONLY : JPG
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA, KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(KIDIA:KFDIA,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KIDIA:KFDIA)
+END SUBROUTINE SRTM_TAUMOL17
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol18.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol18.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol18.F90	(revision 3908)
@@ -0,0 +1,175 @@
+SUBROUTINE SRTM_TAUMOL18 &
+ & ( KIDIA   , KFDIA    , KLEV,&
+ & P_FAC00   , P_FAC01  , P_FAC10   , P_FAC11,&
+ & K_JP      , K_JT     , K_JT1     , P_ONEMINUS,&
+ & P_COLH2O  , P_COLCH4 , P_COLMOL,&
+ & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF  , P_FORFAC, P_FORFRAC, K_INDFOR,&
+ & P_SFLUXZEN, P_TAUG   , P_TAUR    , PRMU0   &
+ & )  
+
+!     Written by Eli J. Mlawer, Atmospheric & Environmental Research.
+
+!     BAND 18:  4000-4650 cm-1 (low - H2O,CH4; high - CH4)
+
+! Modifications
+!        M.Hamrud      01-Oct-2003 CY28 Cleaning
+
+!     JJMorcrette 2003-02-24 adapted to ECMWF environment
+!        D.Salmond  31-Oct-2007 Vector version in the style of RRTM from Meteo France & NEC
+!     JJMorcrette 20110610 Flexible configuration for number of g-points
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
+USE PARSRTM  , ONLY : JPG
+USE YOESRTM  , ONLY : NG18
+USE YOESRTA18, ONLY : ABSA, ABSB, FORREFC, SELFREFC, SFLUXREFC, RAYL, LAYREFFR, STRRAT  
+USE YOESRTWN , ONLY : NSPA, NSPB
+
+IMPLICIT NONE
+
+!-- Output
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA, KFDIA 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ONEMINUS(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCH4(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLMOL(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDFOR(KIDIA:KFDIA,KLEV)
+
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SFLUXZEN(KIDIA:KFDIA,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUG(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUR(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KIDIA:KFDIA)
+!- from INTFAC      
+!- from INTIND
+!- from PRECISE             
+!- from PROFDATA             
+!- from SELF             
+INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, INDF, JS, I_LAY, I_LAYSOLFR(KIDIA:KFDIA), I_NLAYERS, IPLON
+
+INTEGER(KIND=JPIM) :: I_LAY_NEXT
+
+REAL(KIND=JPRB) :: Z_FAC000, Z_FAC001, Z_FAC010, Z_FAC011, Z_FAC100, Z_FAC101,&
+ & Z_FAC110, Z_FAC111, Z_FS, Z_SPECCOMB, Z_SPECMULT, Z_SPECPARM, &
+ & Z_TAURAY  
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL18',0,ZHOOK_HANDLE)
+I_NLAYERS = KLEV
+
+!     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.  
+
+I_LAYSOLFR(KIDIA:KFDIA) = K_LAYTROP(KIDIA:KFDIA)
+
+DO I_LAY = 1, I_NLAYERS
+  I_LAY_NEXT = MIN(I_NLAYERS, I_LAY+1)
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY <= K_LAYTROP(IPLON)) THEN
+        IF (K_JP(IPLON,I_LAY) < LAYREFFR .AND. K_JP(IPLON,I_LAY_NEXT) >= LAYREFFR) &
+         & I_LAYSOLFR(IPLON) = MIN(I_LAY+1,K_LAYTROP(IPLON))  
+        Z_SPECCOMB = P_COLH2O(IPLON,I_LAY) + STRRAT*P_COLCH4(IPLON,I_LAY)
+        Z_SPECPARM = P_COLH2O(IPLON,I_LAY)/Z_SPECCOMB 
+        IF (Z_SPECPARM >= P_ONEMINUS(IPLON)) Z_SPECPARM = P_ONEMINUS(IPLON)
+        Z_SPECMULT = 8.*(Z_SPECPARM)
+        JS = 1 + INT(Z_SPECMULT)
+        Z_FS = MOD(Z_SPECMULT, 1.0_JPRB )
+        ! Z_FAC000 = (1. - Z_FS) * P_FAC00(I_LAY)
+        ! Z_FAC010 = (1. - Z_FS) * P_FAC10(I_LAY)
+        ! Z_FAC100 = Z_FS * P_FAC00(I_LAY)
+        ! Z_FAC110 = Z_FS * P_FAC10(I_LAY)
+        ! Z_FAC001 = (1. - Z_FS) * P_FAC01(I_LAY)
+        ! Z_FAC011 = (1. - Z_FS) * P_FAC11(I_LAY)
+        ! Z_FAC101 = Z_FS * P_FAC01(I_LAY)
+        ! Z_FAC111 = Z_FS * P_FAC11(I_LAY)
+        IND0 = ((K_JP(IPLON,I_LAY)-1)*5+(K_JT(IPLON,I_LAY)-1))*NSPA(18) + JS
+        IND1 = (K_JP(IPLON,I_LAY)*5+(K_JT1(IPLON,I_LAY)-1))*NSPA(18) + JS
+        INDS = K_INDSELF(IPLON,I_LAY)
+        INDF = K_INDFOR(IPLON,I_LAY)
+        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
+
+        !  DO IG = 1, NG(18)
+!CDIR UNROLL=NG18
+        DO IG = 1, NG18
+          P_TAUG(IPLON,I_LAY,IG) = Z_SPECCOMB * &
+           !    & (Z_FAC000 * ABSA(IND0,IG) + &
+           !    & Z_FAC100 * ABSA(IND0+1,IG) + &
+           !    & Z_FAC010 * ABSA(IND0+9,IG) + &
+           !    & Z_FAC110 * ABSA(IND0+10,IG) + &
+           !    & Z_FAC001 * ABSA(IND1,IG) + &
+           !    & Z_FAC101 * ABSA(IND1+1,IG) + &
+           !    & Z_FAC011 * ABSA(IND1+9,IG) + &
+           !    & Z_FAC111 * ABSA(IND1+10,IG)) + &
+           & (&
+           & (1. - Z_FS) * ( ABSA(IND0,IG) * P_FAC00(IPLON,I_LAY) + &
+           &                 ABSA(IND0+9,IG) * P_FAC10(IPLON,I_LAY) + &
+           &                 ABSA(IND1,IG) * P_FAC01(IPLON,I_LAY) + &
+           &                 ABSA(IND1+9,IG) * P_FAC11(IPLON,I_LAY) ) + &
+           & Z_FS        * ( ABSA(IND0+1,IG) * P_FAC00(IPLON,I_LAY) + &
+           &                 ABSA(IND0+10,IG) * P_FAC10(IPLON,I_LAY) + &
+           &                 ABSA(IND1+1,IG) * P_FAC01(IPLON,I_LAY) + &
+           &                 ABSA(IND1+10,IG) * P_FAC11(IPLON,I_LAY) ) &
+           & ) + &
+           & P_COLH2O(IPLON,I_LAY) * &
+           & (P_SELFFAC(IPLON,I_LAY) * (SELFREFC(INDS,IG) + &
+           & P_SELFFRAC(IPLON,I_LAY) * &
+           & (SELFREFC(INDS+1,IG) - SELFREFC(INDS,IG))) + &
+           & P_FORFAC(IPLON,I_LAY) * (FORREFC(INDF,IG) + &
+           & P_FORFRAC(IPLON,I_LAY) * &
+           & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG))))   
+          !     &           + TAURAY
+          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
+          IF (I_LAY == I_LAYSOLFR(IPLON)) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG,JS)  &
+           & + Z_FS * (SFLUXREFC(IG,JS+1) - SFLUXREFC(IG,JS))  
+          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+DO I_LAY = 1, I_NLAYERS
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY >= K_LAYTROP(IPLON)+1) THEN
+        IND0 = ((K_JP(IPLON,I_LAY)-13)*5+(K_JT(IPLON,I_LAY)-1))*NSPB(18) + 1
+        IND1 = ((K_JP(IPLON,I_LAY)-12)*5+(K_JT1(IPLON,I_LAY)-1))*NSPB(18) + 1
+        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
+
+        !  DO IG = 1, NG(18)
+!CDIR UNROLL=NG18
+        DO IG = 1, NG18
+          P_TAUG(IPLON,I_LAY,IG) = P_COLCH4(IPLON,I_LAY) * &
+           & (P_FAC00(IPLON,I_LAY) * ABSB(IND0,IG) + &
+           & P_FAC10(IPLON,I_LAY) * ABSB(IND0+1,IG) + &
+           & P_FAC01(IPLON,I_LAY) * ABSB(IND1,IG) +       &
+           & P_FAC11(IPLON,I_LAY) * ABSB(IND1+1,IG))   
+          !     &           + TAURAY
+          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
+          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+!-----------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL18',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE SRTM_TAUMOL18
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol18.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol18.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol18.intfb.h	(revision 3908)
@@ -0,0 +1,37 @@
+INTERFACE
+SUBROUTINE SRTM_TAUMOL18&
+ & ( KIDIA , KFDIA , KLEV,&
+ & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
+ & K_JP , K_JT , K_JT1 , P_ONEMINUS,&
+ & P_COLH2O , P_COLCH4 , P_COLMOL,&
+ & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF , P_FORFAC, P_FORFRAC, K_INDFOR,&
+ & P_SFLUXZEN, P_TAUG , P_TAUR , PRMU0&
+ & ) 
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE PARSRTM , ONLY : JPG
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA, KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCH4(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(KIDIA:KFDIA,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KIDIA:KFDIA)
+END SUBROUTINE SRTM_TAUMOL18
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol19.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol19.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol19.F90	(revision 3908)
@@ -0,0 +1,176 @@
+SUBROUTINE SRTM_TAUMOL19 &
+ & ( KIDIA   , KFDIA    , KLEV,&
+ & P_FAC00   , P_FAC01  , P_FAC10   , P_FAC11,&
+ & K_JP      , K_JT     , K_JT1     , P_ONEMINUS,&
+ & P_COLH2O  , P_COLCO2 , P_COLMOL,&
+ & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF  , P_FORFAC, P_FORFRAC, K_INDFOR,&
+ & P_SFLUXZEN, P_TAUG   , P_TAUR    , PRMU0   &
+ & )  
+
+!     Written by Eli J. Mlawer, Atmospheric & Environmental Research.
+
+!     BAND 19:  4650-5150 cm-1 (low - H2O,CO2; high - CO2)
+
+! Modifications
+!        M.Hamrud      01-Oct-2003 CY28 Cleaning
+
+!     JJMorcrette 2003-02-24 adapted to ECMWF environment
+!        D.Salmond  31-Oct-2007 Vector version in the style of RRTM from Meteo France & NEC
+!     JJMorcrette 20110610 Flexible configuration for number of g-points
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
+USE PARSRTM  , ONLY : JPG
+USE YOESRTM  , ONLY : NG19
+USE YOESRTA19, ONLY : ABSA, ABSB, FORREFC, SELFREFC, SFLUXREFC, RAYL, LAYREFFR, STRRAT  
+USE YOESRTWN , ONLY : NSPA, NSPB
+
+IMPLICIT NONE
+
+!-- Output
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA, KFDIA 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ONEMINUS(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCO2(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLMOL(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDFOR(KIDIA:KFDIA,KLEV) 
+
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SFLUXZEN(KIDIA:KFDIA,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUG(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUR(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KIDIA:KFDIA)
+!- from INTFAC      
+!- from INTIND
+!- from PRECISE             
+!- from PROFDATA             
+!- from SELF             
+INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, INDF, JS, I_LAY, I_LAYSOLFR(KIDIA:KFDIA), I_NLAYERS, IPLON
+
+!REAL(KIND=JPRB) :: Z_FAC000, Z_FAC001, Z_FAC010, Z_FAC011, Z_FAC100, Z_FAC101,&
+! & Z_FAC110, Z_FAC111
+REAL(KIND=JPRB) :: Z_FS, Z_SPECCOMB, Z_SPECMULT, Z_SPECPARM, Z_TAURAY  
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+INTEGER(KIND=JPIM) :: I_LAY_NEXT
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL19',0,ZHOOK_HANDLE)
+
+I_NLAYERS = KLEV
+
+!     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.  
+
+I_LAYSOLFR(KIDIA:KFDIA) = K_LAYTROP(KIDIA:KFDIA)
+
+DO I_LAY = 1, I_NLAYERS
+  I_LAY_NEXT = MIN(I_NLAYERS, I_LAY+1)
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY <= K_LAYTROP(IPLON)) THEN
+        IF (K_JP(IPLON,I_LAY) < LAYREFFR .AND. K_JP(IPLON,I_LAY_NEXT) >= LAYREFFR) &
+         & I_LAYSOLFR(IPLON) = MIN(I_LAY+1,K_LAYTROP(IPLON))  
+        Z_SPECCOMB = P_COLH2O(IPLON,I_LAY) + STRRAT*P_COLCO2(IPLON,I_LAY)
+        Z_SPECPARM = P_COLH2O(IPLON,I_LAY)/Z_SPECCOMB 
+        IF (Z_SPECPARM >= P_ONEMINUS(IPLON)) Z_SPECPARM = P_ONEMINUS(IPLON)
+        Z_SPECMULT = 8.*(Z_SPECPARM)
+        JS = 1 + INT(Z_SPECMULT)
+        Z_FS = MOD(Z_SPECMULT, 1.0_JPRB )
+        ! Z_FAC000 = (1. - Z_FS) * P_FAC00(I_LAY)
+        ! Z_FAC010 = (1. - Z_FS) * P_FAC10(I_LAY)
+        ! Z_FAC100 = Z_FS * P_FAC00(I_LAY)
+        ! Z_FAC110 = Z_FS * P_FAC10(I_LAY)
+        ! Z_FAC001 = (1. - Z_FS) * P_FAC01(I_LAY)
+        ! Z_FAC011 = (1. - Z_FS) * P_FAC11(I_LAY)
+        ! Z_FAC101 = Z_FS * P_FAC01(I_LAY)
+        ! Z_FAC111 = Z_FS * P_FAC11(I_LAY)
+        IND0 = ((K_JP(IPLON,I_LAY)-1)*5+(K_JT(IPLON,I_LAY)-1))*NSPA(19) + JS
+        IND1 = (K_JP(IPLON,I_LAY)*5+(K_JT1(IPLON,I_LAY)-1))*NSPA(19) + JS
+        INDS = K_INDSELF(IPLON,I_LAY)
+        INDF = K_INDFOR(IPLON,I_LAY)
+        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
+
+        !  DO IG = 1, NG(19)
+!CDIR UNROLL=NG19
+        DO IG = 1 , NG19
+          P_TAUG(IPLON,I_LAY,IG) = Z_SPECCOMB * &
+           !    & (Z_FAC000 * ABSA(IND0,IG) + &
+           !    & Z_FAC100 * ABSA(IND0+1,IG) + &
+           !    & Z_FAC010 * ABSA(IND0+9,IG) + &
+           !    & Z_FAC110 * ABSA(IND0+10,IG) + &
+           !    & Z_FAC001 * ABSA(IND1,IG) + &
+           !    & Z_FAC101 * ABSA(IND1+1,IG) + &
+           !    & Z_FAC011 * ABSA(IND1+9,IG) + &
+           !    & Z_FAC111 * ABSA(IND1+10,IG)) + &
+           & (&
+           & (1. - Z_FS) * ( ABSA(IND0,IG) * P_FAC00(IPLON,I_LAY) + &
+           &                 ABSA(IND0+9,IG) * P_FAC10(IPLON,I_LAY) + &
+           &                 ABSA(IND1,IG) * P_FAC01(IPLON,I_LAY) + &
+           &                 ABSA(IND1+9,IG) * P_FAC11(IPLON,I_LAY) ) + &
+           & Z_FS        * ( ABSA(IND0+1,IG) * P_FAC00(IPLON,I_LAY) + &
+           &                 ABSA(IND0+10,IG) * P_FAC10(IPLON,I_LAY) + &
+           &                 ABSA(IND1+1,IG) * P_FAC01(IPLON,I_LAY) + &
+           &                 ABSA(IND1+10,IG) * P_FAC11(IPLON,I_LAY) ) &
+           & ) + &
+           & P_COLH2O(IPLON,I_LAY) * &
+           & (P_SELFFAC(IPLON,I_LAY) * (SELFREFC(INDS,IG) + &
+           & P_SELFFRAC(IPLON,I_LAY) * &
+           & (SELFREFC(INDS+1,IG) - SELFREFC(INDS,IG))) +  &
+           & P_FORFAC(IPLON,I_LAY) * (FORREFC(INDF,IG) + &
+           & P_FORFRAC(IPLON,I_LAY) * &
+           & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG))))   
+          !     &           + TAURAY
+          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
+          IF (I_LAY == I_LAYSOLFR(IPLON)) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG,JS) &
+           & + Z_FS * (SFLUXREFC(IG,JS+1) - SFLUXREFC(IG,JS))  
+          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY   
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+DO I_LAY = 1, I_NLAYERS
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY >= K_LAYTROP(IPLON)+1) THEN
+        IND0 = ((K_JP(IPLON,I_LAY)-13)*5+(K_JT(IPLON,I_LAY)-1))*NSPB(19) + 1
+        IND1 = ((K_JP(IPLON,I_LAY)-12)*5+(K_JT1(IPLON,I_LAY)-1))*NSPB(19) + 1
+        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
+
+        !  DO IG = 1, NG(19)
+!CDIR UNROLL=NG19
+        DO IG = 1 , NG19
+          P_TAUG(IPLON,I_LAY,IG) = P_COLCO2(IPLON,I_LAY) * &
+           & (P_FAC00(IPLON,I_LAY) * ABSB(IND0,IG) + &
+           & P_FAC10(IPLON,I_LAY) * ABSB(IND0+1,IG) + &
+           & P_FAC01(IPLON,I_LAY) * ABSB(IND1,IG) + &
+           & P_FAC11(IPLON,I_LAY) * ABSB(IND1+1,IG))   
+          !     &           + TAURAY
+          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG) 
+          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY   
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+!-----------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL19',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE SRTM_TAUMOL19
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol19.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol19.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol19.intfb.h	(revision 3908)
@@ -0,0 +1,37 @@
+INTERFACE
+SUBROUTINE SRTM_TAUMOL19&
+ & ( KIDIA , KFDIA , KLEV,&
+ & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
+ & K_JP , K_JT , K_JT1 , P_ONEMINUS,&
+ & P_COLH2O , P_COLCO2 , P_COLMOL,&
+ & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF , P_FORFAC, P_FORFRAC, K_INDFOR,&
+ & P_SFLUXZEN, P_TAUG , P_TAUR , PRMU0&
+ & ) 
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE PARSRTM , ONLY : JPG
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA, KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(KIDIA:KFDIA,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KIDIA:KFDIA)
+END SUBROUTINE SRTM_TAUMOL19
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol20.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol20.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol20.F90	(revision 3908)
@@ -0,0 +1,150 @@
+SUBROUTINE SRTM_TAUMOL20 &
+ & ( KIDIA   , KFDIA    , KLEV,&
+ & P_FAC00   , P_FAC01  , P_FAC10   , P_FAC11,&
+ & K_JP      , K_JT     , K_JT1,&
+ & P_COLH2O  , P_COLCH4 , P_COLMOL,&
+ & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF  , P_FORFAC, P_FORFRAC, K_INDFOR,&
+ & P_SFLUXZEN, P_TAUG   , P_TAUR    , PRMU0   &
+ & )  
+
+!     Written by Eli J. Mlawer, Atmospheric & Environmental Research.
+
+!     BAND 20:  5150-6150 cm-1 (low - H2O; high - H2O)
+
+! Modifications
+!        M.Hamrud      01-Oct-2003 CY28 Cleaning
+
+!     JJMorcrette 2003-02-24 adapted to ECMWF environment
+!        D.Salmond  31-Oct-2007 Vector version in the style of RRTM from Meteo France & NEC
+!     JJMorcrette 20110610 Flexible configuration for number of g-points
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
+USE PARSRTM  , ONLY : JPG
+USE YOESRTM  , ONLY : NG20
+USE YOESRTA20, ONLY : ABSA, ABSB, FORREFC, SELFREFC, SFLUXREFC, ABSCH4C, RAYL, LAYREFFR  
+USE YOESRTWN , ONLY : NSPA, NSPB
+
+IMPLICIT NONE
+
+!-- Output
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA, KFDIA 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCH4(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLMOL(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDFOR(KIDIA:KFDIA,KLEV) 
+
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SFLUXZEN(KIDIA:KFDIA,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUG(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUR(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KIDIA:KFDIA)
+!- from INTFAC      
+!- from INTIND
+!- from PRECISE             
+!- from PROFDATA             
+!- from SELF             
+INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, INDF, I_LAY, I_LAYSOLFR(KIDIA:KFDIA), I_NLAYERS, IPLON
+
+INTEGER(KIND=JPIM) :: I_LAY_NEXT
+
+REAL(KIND=JPRB) ::  &
+ & Z_TAURAY  
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL20',0,ZHOOK_HANDLE)
+
+I_NLAYERS = KLEV
+
+!     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.  
+
+I_LAYSOLFR(KIDIA:KFDIA) = K_LAYTROP(KIDIA:KFDIA)
+
+DO I_LAY = 1, I_NLAYERS
+  I_LAY_NEXT = MIN(I_NLAYERS, I_LAY+1)
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY <= K_LAYTROP(IPLON)) THEN
+        IF (K_JP(IPLON,I_LAY) < LAYREFFR .AND. K_JP(IPLON,I_LAY_NEXT) >= LAYREFFR) &
+         & I_LAYSOLFR(IPLON) = MIN(I_LAY+1,K_LAYTROP(IPLON))  
+        IND0 = ((K_JP(IPLON,I_LAY)-1)*5+(K_JT(IPLON,I_LAY)-1))*NSPA(20) + 1
+        IND1 = (K_JP(IPLON,I_LAY)*5+(K_JT1(IPLON,I_LAY)-1))*NSPA(20) + 1
+        INDS = K_INDSELF(IPLON,I_LAY)
+        INDF = K_INDFOR(IPLON,I_LAY)
+        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
+
+        !  DO IG = 1, NG(20)
+!CDIR UNROLL=NG20
+        DO IG = 1 , NG20
+          P_TAUG(IPLON,I_LAY,IG) = P_COLH2O(IPLON,I_LAY) * &
+           & ((P_FAC00(IPLON,I_LAY) * ABSA(IND0,IG) + &
+           & P_FAC10(IPLON,I_LAY) * ABSA(IND0+1,IG) + &
+           & P_FAC01(IPLON,I_LAY) * ABSA(IND1,IG) + &
+           & P_FAC11(IPLON,I_LAY) * ABSA(IND1+1,IG)) + &
+           & P_SELFFAC(IPLON,I_LAY) * (SELFREFC(INDS,IG) +  &
+           & P_SELFFRAC(IPLON,I_LAY) * &
+           & (SELFREFC(INDS+1,IG) - SELFREFC(INDS,IG))) + &
+           & P_FORFAC(IPLON,I_LAY) * (FORREFC(INDF,IG) + &
+           & P_FORFRAC(IPLON,I_LAY) * &
+           & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG)))) &
+           & + P_COLCH4(IPLON,I_LAY) * ABSCH4C(IG)  
+          !     &           + TAURAY &
+          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
+          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY 
+          IF (I_LAY == I_LAYSOLFR(IPLON)) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG) 
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+DO I_LAY = 1, I_NLAYERS
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY >= K_LAYTROP(IPLON)+1) THEN
+        IND0 = ((K_JP(IPLON,I_LAY)-13)*5+(K_JT(IPLON,I_LAY)-1))*NSPB(20) + 1
+        IND1 = ((K_JP(IPLON,I_LAY)-12)*5+(K_JT1(IPLON,I_LAY)-1))*NSPB(20) + 1
+        INDF = K_INDFOR(IPLON,I_LAY)
+        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
+
+        !  DO IG = 1, NG(20)
+!CDIR UNROLL=NG20
+        DO IG = 1 , NG20
+          P_TAUG(IPLON,I_LAY,IG) = P_COLH2O(IPLON,I_LAY) * &
+           & (P_FAC00(IPLON,I_LAY) * ABSB(IND0,IG) + &
+           & P_FAC10(IPLON,I_LAY) * ABSB(IND0+1,IG) + &
+           & P_FAC01(IPLON,I_LAY) * ABSB(IND1,IG) + &
+           & P_FAC11(IPLON,I_LAY) * ABSB(IND1+1,IG) + &
+           & P_FORFAC(IPLON,I_LAY) * (FORREFC(INDF,IG) + &
+           & P_FORFRAC(IPLON,I_LAY) * &
+           & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG)))) + &
+           & P_COLCH4(IPLON,I_LAY) * ABSCH4C(IG)  
+          !     &           TAURAY + &
+          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
+          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY 
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+!-----------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL20',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE SRTM_TAUMOL20
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol20.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol20.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol20.intfb.h	(revision 3908)
@@ -0,0 +1,36 @@
+INTERFACE
+SUBROUTINE SRTM_TAUMOL20&
+ & ( KIDIA , KFDIA , KLEV,&
+ & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
+ & K_JP , K_JT , K_JT1,&
+ & P_COLH2O , P_COLCH4 , P_COLMOL,&
+ & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF , P_FORFAC, P_FORFRAC, K_INDFOR,&
+ & P_SFLUXZEN, P_TAUG , P_TAUR , PRMU0&
+ & ) 
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE PARSRTM , ONLY : JPG
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA, KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCH4(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(KIDIA:KFDIA,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KIDIA:KFDIA)
+END SUBROUTINE SRTM_TAUMOL20
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol21.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol21.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol21.F90	(revision 3908)
@@ -0,0 +1,209 @@
+SUBROUTINE SRTM_TAUMOL21 &
+ & ( KIDIA   , KFDIA    , KLEV,&
+ & P_FAC00   , P_FAC01  , P_FAC10   , P_FAC11,&
+ & K_JP      , K_JT     , K_JT1     , P_ONEMINUS,&
+ & P_COLH2O  , P_COLCO2 , P_COLMOL,&
+ & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF  , P_FORFAC, P_FORFRAC, K_INDFOR,&
+ & P_SFLUXZEN, P_TAUG   , P_TAUR    , PRMU0   &
+ & )  
+
+!     Written by Eli J. Mlawer, Atmospheric & Environmental Research.
+
+!     BAND 21:  6150-7700 cm-1 (low - H2O,CO2; high - H2O,CO2)
+
+! Modifications
+!        M.Hamrud      01-Oct-2003 CY28 Cleaning
+
+!     JJMorcrette 2003-02-24 adapted to ECMWF environment
+!        D.Salmond  31-Oct-2007 Vector version in the style of RRTM from Meteo France & NEC
+!     JJMorcrette 20110610 Flexible configuration for number of g-points
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
+USE PARSRTM  , ONLY : JPG
+USE YOESRTM  , ONLY : NG21
+USE YOESRTA21, ONLY : ABSA, ABSB, FORREFC, SELFREFC, SFLUXREFC, RAYL, LAYREFFR, STRRAT  
+USE YOESRTWN , ONLY : NSPA, NSPB
+
+IMPLICIT NONE
+
+!-- Output
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA, KFDIA 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ONEMINUS(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCO2(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLMOL(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDFOR(KIDIA:KFDIA,KLEV) 
+
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SFLUXZEN(KIDIA:KFDIA,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUG(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUR(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KIDIA:KFDIA)
+!- from INTFAC      
+!- from INTIND
+!- from PRECISE             
+!- from PROFDATA             
+!- from SELF             
+INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, INDF, JS, I_LAY, I_LAYSOLFR(KIDIA:KFDIA), I_NLAYERS, IPLON
+
+INTEGER(KIND=JPIM) :: I_LAY_NEXT
+
+REAL(KIND=JPRB) :: Z_FAC000, Z_FAC001, Z_FAC010, Z_FAC011, Z_FAC100, Z_FAC101,&
+ & Z_FAC110, Z_FAC111, Z_FS, Z_SPECCOMB, Z_SPECMULT, Z_SPECPARM, &
+ & Z_TAURAY  
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL21',0,ZHOOK_HANDLE)
+
+I_NLAYERS = KLEV
+
+!     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.  
+
+I_LAYSOLFR(KIDIA:KFDIA) = K_LAYTROP(KIDIA:KFDIA)
+
+DO I_LAY = 1, I_NLAYERS
+  I_LAY_NEXT = MIN(I_NLAYERS, I_LAY+1)
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY <= K_LAYTROP(IPLON)) THEN
+        IF (K_JP(IPLON,I_LAY) < LAYREFFR .AND. K_JP(IPLON,I_LAY_NEXT) >= LAYREFFR) &
+         & I_LAYSOLFR(IPLON) = MIN(I_LAY+1,K_LAYTROP(IPLON))  
+        Z_SPECCOMB = P_COLH2O(IPLON,I_LAY) + STRRAT*P_COLCO2(IPLON,I_LAY)
+        Z_SPECPARM = P_COLH2O(IPLON,I_LAY)/Z_SPECCOMB 
+        IF (Z_SPECPARM >= P_ONEMINUS(IPLON)) Z_SPECPARM = P_ONEMINUS(IPLON)
+        Z_SPECMULT = 8.*(Z_SPECPARM)
+        JS = 1 + INT(Z_SPECMULT)
+        Z_FS = MOD(Z_SPECMULT, 1.0_JPRB )
+        ! Z_FAC000 = (1. - Z_FS) * P_FAC00(I_LAY)
+        ! Z_FAC010 = (1. - Z_FS) * P_FAC10(I_LAY)
+        ! Z_FAC100 = Z_FS * P_FAC00(I_LAY)
+        ! Z_FAC110 = Z_FS * P_FAC10(I_LAY)
+        ! Z_FAC001 = (1. - Z_FS) * P_FAC01(I_LAY)
+        ! Z_FAC011 = (1. - Z_FS) * P_FAC11(I_LAY)
+        ! Z_FAC101 = Z_FS * P_FAC01(I_LAY)
+        ! Z_FAC111 = Z_FS * P_FAC11(I_LAY)
+        IND0 = ((K_JP(IPLON,I_LAY)-1)*5+(K_JT(IPLON,I_LAY)-1))*NSPA(21) + JS
+        IND1 = (K_JP(IPLON,I_LAY)*5+(K_JT1(IPLON,I_LAY)-1))*NSPA(21) + JS
+        INDS = K_INDSELF(IPLON,I_LAY)
+        INDF = K_INDFOR(IPLON,I_LAY)
+        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
+
+        !  DO IG = 1, NG(21)
+!CDIR UNROLL=NG21
+        DO IG = 1 , NG21
+          P_TAUG(IPLON,I_LAY,IG) = Z_SPECCOMB * &
+           !    & (Z_FAC000 * ABSA(IND0,IG) + &
+           !    & Z_FAC100 * ABSA(IND0+1,IG) + &
+           !    & Z_FAC010 * ABSA(IND0+9,IG) + &
+           !    & Z_FAC110 * ABSA(IND0+10,IG) + &
+           !    & Z_FAC001 * ABSA(IND1,IG) + &
+           !    & Z_FAC101 * ABSA(IND1+1,IG) + &
+           !    & Z_FAC011 * ABSA(IND1+9,IG) + &
+           !    & Z_FAC111 * ABSA(IND1+10,IG)) + &
+           & (&
+           & (1. - Z_FS) * ( ABSA(IND0,IG) * P_FAC00(IPLON,I_LAY) + &
+           &                 ABSA(IND0+9,IG) * P_FAC10(IPLON,I_LAY) + &
+           &                 ABSA(IND1,IG) * P_FAC01(IPLON,I_LAY) + &
+           &                 ABSA(IND1+9,IG) * P_FAC11(IPLON,I_LAY) ) + &
+           & Z_FS        * ( ABSA(IND0+1,IG) * P_FAC00(IPLON,I_LAY) + &
+           &                 ABSA(IND0+10,IG) * P_FAC10(IPLON,I_LAY) + &
+           &                 ABSA(IND1+1,IG) * P_FAC01(IPLON,I_LAY) + &
+           &                 ABSA(IND1+10,IG) * P_FAC11(IPLON,I_LAY) ) &
+           & ) + &
+           & P_COLH2O(IPLON,I_LAY) * &
+           & (P_SELFFAC(IPLON,I_LAY) * (SELFREFC(INDS,IG) + &
+           & P_SELFFRAC(IPLON,I_LAY) * &
+           & (SELFREFC(INDS+1,IG) - SELFREFC(INDS,IG))) + &
+           & P_FORFAC(IPLON,I_LAY) * (FORREFC(INDF,IG) + &
+           & P_FORFRAC(IPLON,I_LAY) * &
+           & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG))))  
+          !     &           + TAURAY
+          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
+          IF (I_LAY == I_LAYSOLFR(IPLON)) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG,JS) &
+           & + Z_FS * (SFLUXREFC(IG,JS+1) - SFLUXREFC(IG,JS))  
+          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+DO I_LAY = 1, I_NLAYERS
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY >= K_LAYTROP(IPLON)+1) THEN
+        Z_SPECCOMB = P_COLH2O(IPLON,I_LAY) + STRRAT*P_COLCO2(IPLON,I_LAY)
+        Z_SPECPARM = P_COLH2O(IPLON,I_LAY)/Z_SPECCOMB 
+        IF (Z_SPECPARM >= P_ONEMINUS(IPLON)) Z_SPECPARM = P_ONEMINUS(IPLON)
+        Z_SPECMULT = 4.*(Z_SPECPARM)
+        JS = 1 + INT(Z_SPECMULT)
+        Z_FS = MOD(Z_SPECMULT, 1.0_JPRB )
+        ! Z_FAC000 = (1. - Z_FS) * P_FAC00(I_LAY)
+        ! Z_FAC010 = (1. - Z_FS) * P_FAC10(I_LAY)
+        ! Z_FAC100 = Z_FS * P_FAC00(I_LAY)
+        ! Z_FAC110 = Z_FS * P_FAC10(I_LAY)
+        ! Z_FAC001 = (1. - Z_FS) * P_FAC01(I_LAY)
+        ! Z_FAC011 = (1. - Z_FS) * P_FAC11(I_LAY)
+        ! Z_FAC101 = Z_FS * P_FAC01(I_LAY)
+        ! Z_FAC111 = Z_FS * P_FAC11(I_LAY)
+        IND0 = ((K_JP(IPLON,I_LAY)-13)*5+(K_JT(IPLON,I_LAY)-1))*NSPB(21) + JS
+        IND1 = ((K_JP(IPLON,I_LAY)-12)*5+(K_JT1(IPLON,I_LAY)-1))*NSPB(21) + JS
+        INDF = K_INDFOR(IPLON,I_LAY)
+        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
+
+        !  DO IG = 1, NG(21)
+!CDIR UNROLL=NG21
+        DO IG = 1 , NG21
+          P_TAUG(IPLON,I_LAY,IG) = Z_SPECCOMB * &
+           !    & (Z_FAC000 * ABSB(IND0,IG) + &
+           !    & Z_FAC100 * ABSB(IND0+1,IG) + &
+           !    & Z_FAC010 * ABSB(IND0+5,IG) + &
+           !    & Z_FAC110 * ABSB(IND0+6,IG) + &
+           !    & Z_FAC001 * ABSB(IND1,IG) + &
+           !    & Z_FAC101 * ABSB(IND1+1,IG) + &
+           !    & Z_FAC011 * ABSB(IND1+5,IG) + &
+           !    & Z_FAC111 * ABSB(IND1+6,IG)) + &
+           & (&
+           & (1. - Z_FS) * ( ABSB(IND0,IG) * P_FAC00(IPLON,I_LAY) + &
+           &                 ABSB(IND0+5,IG) * P_FAC10(IPLON,I_LAY) + &
+           &                 ABSB(IND1,IG) * P_FAC01(IPLON,I_LAY) + &
+           &                 ABSB(IND1+5,IG) * P_FAC11(IPLON,I_LAY) ) + &
+           & Z_FS        * ( ABSB(IND0+1,IG) * P_FAC00(IPLON,I_LAY) + &
+           &                 ABSB(IND0+6,IG) * P_FAC10(IPLON,I_LAY) + &
+           &                 ABSB(IND1+1,IG) * P_FAC01(IPLON,I_LAY) + &
+           &                 ABSB(IND1+6,IG) * P_FAC11(IPLON,I_LAY) ) &
+           & ) + &
+           & P_COLH2O(IPLON,I_LAY) * &
+           & P_FORFAC(IPLON,I_LAY) * (FORREFC(INDF,IG) + &
+           & P_FORFRAC(IPLON,I_LAY) * &
+           & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG)))  
+          !     &           + TAURAY 
+          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
+          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+!-----------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL21',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE SRTM_TAUMOL21
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol21.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol21.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol21.intfb.h	(revision 3908)
@@ -0,0 +1,37 @@
+INTERFACE
+SUBROUTINE SRTM_TAUMOL21&
+ & ( KIDIA , KFDIA , KLEV,&
+ & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
+ & K_JP , K_JT , K_JT1 , P_ONEMINUS,&
+ & P_COLH2O , P_COLCO2 , P_COLMOL,&
+ & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF , P_FORFAC, P_FORFRAC, K_INDFOR,&
+ & P_SFLUXZEN, P_TAUG , P_TAUR , PRMU0&
+ & ) 
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE PARSRTM , ONLY : JPG
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA, KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(KIDIA:KFDIA,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KIDIA:KFDIA)
+END SUBROUTINE SRTM_TAUMOL21
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol22.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol22.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol22.F90	(revision 3908)
@@ -0,0 +1,186 @@
+SUBROUTINE SRTM_TAUMOL22 &
+ & ( KIDIA   , KFDIA    , KLEV,&
+ & P_FAC00   , P_FAC01  , P_FAC10   , P_FAC11,&
+ & K_JP      , K_JT     , K_JT1     , P_ONEMINUS,&
+ & P_COLH2O  , P_COLMOL , P_COLO2,&
+ & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF  , P_FORFAC, P_FORFRAC, K_INDFOR,&
+ & P_SFLUXZEN, P_TAUG   , P_TAUR    , PRMU0   &
+ & )  
+
+!     Written by Eli J. Mlawer, Atmospheric & Environmental Research.
+
+!     BAND 22:  7700-8050 cm-1 (low - H2O,O2; high - O2)
+
+! Modifications
+!        M.Hamrud      01-Oct-2003 CY28 Cleaning
+
+!     JJMorcrette 2003-02-24 adapted to ECMWF environment
+!        D.Salmond  31-Oct-2007 Vector version in the style of RRTM from Meteo France & NEC
+!     JJMorcrette 20110610 Flexible configuration for number of g-points
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
+USE PARSRTM  , ONLY : JPG
+USE YOESRTM  , ONLY : NG22
+USE YOESRTA22, ONLY : ABSA, ABSB, FORREFC, SELFREFC, SFLUXREFC, RAYL, LAYREFFR, STRRAT  
+USE YOESRTWN , ONLY : NSPA, NSPB
+
+IMPLICIT NONE
+
+!-- Output
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA, KFDIA 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ONEMINUS(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLMOL(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLO2(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDFOR(KIDIA:KFDIA,KLEV) 
+
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SFLUXZEN(KIDIA:KFDIA,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUG(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUR(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KIDIA:KFDIA)
+!- from INTFAC      
+!- from INTIND
+!- from PRECISE             
+!- from PROFDATA             
+!- from SELF             
+INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, INDF, JS, I_LAY, I_LAYSOLFR(KIDIA:KFDIA), I_NLAYERS, IPLON
+
+INTEGER(KIND=JPIM) :: I_LAY_NEXT
+
+REAL(KIND=JPRB) :: Z_FAC000, Z_FAC001, Z_FAC010, Z_FAC011, Z_FAC100, Z_FAC101,&
+ & Z_FAC110, Z_FAC111, Z_FS, Z_SPECCOMB, Z_SPECMULT, Z_SPECPARM, &
+ & Z_TAURAY, Z_O2ADJ , Z_O2CONT  
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL22',0,ZHOOK_HANDLE)
+
+I_NLAYERS = KLEV
+
+!     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.
+Z_O2ADJ = 1.6_JPRB
+
+!     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.  
+
+I_LAYSOLFR(KIDIA:KFDIA) = K_LAYTROP(KIDIA:KFDIA)
+
+DO I_LAY = 1, I_NLAYERS
+  I_LAY_NEXT = MIN(I_NLAYERS, I_LAY+1)
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY <= K_LAYTROP(IPLON)) THEN
+        IF (K_JP(IPLON,I_LAY) < LAYREFFR .AND. K_JP(IPLON,I_LAY_NEXT) >= LAYREFFR) &
+         & I_LAYSOLFR(IPLON) = MIN(I_LAY+1,K_LAYTROP(IPLON))  
+        Z_O2CONT = 4.35e-4*P_COLO2(IPLON,I_LAY)/(350.0*2.0)
+        Z_SPECCOMB = P_COLH2O(IPLON,I_LAY) + Z_O2ADJ*STRRAT*P_COLO2(IPLON,I_LAY)
+        Z_SPECPARM = P_COLH2O(IPLON,I_LAY)/Z_SPECCOMB 
+        IF (Z_SPECPARM >= P_ONEMINUS(IPLON)) Z_SPECPARM = P_ONEMINUS(IPLON)
+        Z_SPECMULT = 8.*(Z_SPECPARM)
+        !         ODADJ = SPECPARM + O2ADJ * (1. - SPECPARM)
+        JS = 1 + INT(Z_SPECMULT)
+        Z_FS = MOD(Z_SPECMULT, 1.0_JPRB )
+        ! Z_FAC000 = (1. - Z_FS) * P_FAC00(I_LAY)
+        ! Z_FAC010 = (1. - Z_FS) * P_FAC10(I_LAY)
+        ! Z_FAC100 = Z_FS * P_FAC00(I_LAY)
+        ! Z_FAC110 = Z_FS * P_FAC10(I_LAY)
+        ! Z_FAC001 = (1. - Z_FS) * P_FAC01(I_LAY)
+        ! Z_FAC011 = (1. - Z_FS) * P_FAC11(I_LAY)
+        ! Z_FAC101 = Z_FS * P_FAC01(I_LAY)
+        ! Z_FAC111 = Z_FS * P_FAC11(I_LAY)
+        IND0 = ((K_JP(IPLON,I_LAY)-1)*5+(K_JT(IPLON,I_LAY)-1))*NSPA(22) + JS
+        IND1 = (K_JP(IPLON,I_LAY)*5+(K_JT1(IPLON,I_LAY)-1))*NSPA(22) + JS
+        INDS = K_INDSELF(IPLON,I_LAY)
+        INDF = K_INDFOR(IPLON,I_LAY)
+        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
+
+        !  DO IG = 1, NG(22)
+!CDIR UNROLL=NG22
+        DO IG = 1 , NG22
+          P_TAUG(IPLON,I_LAY,IG) = Z_SPECCOMB * &
+           !    & (Z_FAC000 * ABSA(IND0,IG) + &
+           !    & Z_FAC100 * ABSA(IND0+1,IG) + &
+           !    & Z_FAC010 * ABSA(IND0+9,IG) + &
+           !    & Z_FAC110 * ABSA(IND0+10,IG) + &
+           !    & Z_FAC001 * ABSA(IND1,IG) + &
+           !    & Z_FAC101 * ABSA(IND1+1,IG) + &
+           !    & Z_FAC011 * ABSA(IND1+9,IG) + &
+           !    & Z_FAC111 * ABSA(IND1+10,IG)) + &
+           & (&
+           & (1. - Z_FS) * ( ABSA(IND0,IG) * P_FAC00(IPLON,I_LAY) + &
+           &                 ABSA(IND0+9,IG) * P_FAC10(IPLON,I_LAY) + &
+           &                 ABSA(IND1,IG) * P_FAC01(IPLON,I_LAY) + &
+           &                 ABSA(IND1+9,IG) * P_FAC11(IPLON,I_LAY) ) + &
+           & Z_FS        * ( ABSA(IND0+1,IG) * P_FAC00(IPLON,I_LAY) + &
+           &                 ABSA(IND0+10,IG) * P_FAC10(IPLON,I_LAY) + &
+           &                 ABSA(IND1+1,IG) * P_FAC01(IPLON,I_LAY) + &
+           &                 ABSA(IND1+10,IG) * P_FAC11(IPLON,I_LAY) ) &
+           & ) + &
+           & P_COLH2O(IPLON,I_LAY) * &
+           & (P_SELFFAC(IPLON,I_LAY) * (SELFREFC(INDS,IG) + &
+           & P_SELFFRAC(IPLON,I_LAY) * &
+           & (SELFREFC(INDS+1,IG) - SELFREFC(INDS,IG))) + &
+           & P_FORFAC(IPLON,I_LAY) * (FORREFC(INDF,IG) + &
+           & P_FORFRAC(IPLON,I_LAY) * &
+           & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG)))) &
+           & + Z_O2CONT  
+          !     &          + TAURAY
+          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
+          IF (I_LAY == I_LAYSOLFR(IPLON)) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG,JS) &
+           & + Z_FS * (SFLUXREFC(IG,JS+1) - SFLUXREFC(IG,JS))  
+          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+DO I_LAY = 1, I_NLAYERS
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY >= K_LAYTROP(IPLON)+1) THEN
+        Z_O2CONT = 4.35e-4*P_COLO2(IPLON,I_LAY)/(350.0*2.0)
+        IND0 = ((K_JP(IPLON,I_LAY)-13)*5+(K_JT(IPLON,I_LAY)-1))*NSPB(22) + 1
+        IND1 = ((K_JP(IPLON,I_LAY)-12)*5+(K_JT1(IPLON,I_LAY)-1))*NSPB(22) + 1
+        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
+
+        !  DO IG = 1, NG(22)
+!CDIR UNROLL=NG22
+        DO IG = 1 , NG22
+          P_TAUG(IPLON,I_LAY,IG) = P_COLO2(IPLON,I_LAY) * Z_O2ADJ * &
+           & (P_FAC00(IPLON,I_LAY) * ABSB(IND0,IG) + &
+           & P_FAC10(IPLON,I_LAY) * ABSB(IND0+1,IG) + &
+           & P_FAC01(IPLON,I_LAY) * ABSB(IND1,IG) + &
+           & P_FAC11(IPLON,I_LAY) * ABSB(IND1+1,IG)) + &
+           & Z_O2CONT  
+          !     &           + TAURAY
+          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
+          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+!-----------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL22',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE SRTM_TAUMOL22
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol22.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol22.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol22.intfb.h	(revision 3908)
@@ -0,0 +1,37 @@
+INTERFACE
+SUBROUTINE SRTM_TAUMOL22&
+ & ( KIDIA , KFDIA , KLEV,&
+ & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
+ & K_JP , K_JT , K_JT1 , P_ONEMINUS,&
+ & P_COLH2O , P_COLMOL , P_COLO2,&
+ & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF , P_FORFAC, P_FORFRAC, K_INDFOR,&
+ & P_SFLUXZEN, P_TAUG , P_TAUR , PRMU0&
+ & ) 
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE PARSRTM , ONLY : JPG
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA, KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLO2(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(KIDIA:KFDIA,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KIDIA:KFDIA)
+END SUBROUTINE SRTM_TAUMOL22
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol23.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol23.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol23.F90	(revision 3908)
@@ -0,0 +1,135 @@
+SUBROUTINE SRTM_TAUMOL23 &
+ & ( KIDIA   , KFDIA    , KLEV,&
+ & P_FAC00   , P_FAC01  , P_FAC10   , P_FAC11,&
+ & K_JP      , K_JT     , K_JT1,&
+ & P_COLH2O  , P_COLMOL,&
+ & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF  , P_FORFAC, P_FORFRAC, K_INDFOR,&
+ & P_SFLUXZEN, P_TAUG   , P_TAUR    , PRMU0   &
+ & )  
+
+!     Written by Eli J. Mlawer, Atmospheric & Environmental Research.
+
+!     BAND 23:  8050-12850 cm-1 (low - H2O; high - nothing)
+
+! Modifications
+!        M.Hamrud      01-Oct-2003 CY28 Cleaning
+
+!     JJMorcrette 2003-02-24 adapted to ECMWF environment
+!        D.Salmond  31-Oct-2007 Vector version in the style of RRTM from Meteo France & NEC
+!     JJMorcrette 20110610 Flexible configuration for number of g-points
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
+USE PARSRTM  , ONLY : JPG
+USE YOESRTM  , ONLY : NG23
+USE YOESRTA23, ONLY : ABSA, FORREFC, SELFREFC, SFLUXREFC, RAYLC, LAYREFFR, GIVFAC   
+USE YOESRTWN , ONLY : NSPA
+
+IMPLICIT NONE
+
+!-- Output
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA, KFDIA 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLMOL(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDFOR(KIDIA:KFDIA,KLEV)
+
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SFLUXZEN(KIDIA:KFDIA,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUG(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUR(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KIDIA:KFDIA)
+!- from INTFAC      
+!- from INTIND
+!- from PRECISE             
+!- from PROFDATA             
+!- from SELF             
+INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, INDF, I_LAY, I_LAYSOLFR(KIDIA:KFDIA), I_NLAYERS, IPLON
+
+INTEGER(KIND=JPIM) :: I_LAY_NEXT
+
+REAL(KIND=JPRB) ::  &
+ & Z_TAURAY  
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL23',0,ZHOOK_HANDLE)
+
+I_NLAYERS = KLEV
+
+!     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.  
+
+I_LAYSOLFR(KIDIA:KFDIA) = K_LAYTROP(KIDIA:KFDIA)
+
+DO I_LAY = 1, I_NLAYERS
+  I_LAY_NEXT = MIN(I_NLAYERS, I_LAY+1)
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY <= K_LAYTROP(IPLON)) THEN
+        IF (K_JP(IPLON,I_LAY) < LAYREFFR .AND. K_JP(IPLON,I_LAY_NEXT) >= LAYREFFR) &
+         & I_LAYSOLFR(IPLON) = MIN(I_LAY+1,K_LAYTROP(IPLON))  
+        IND0 = ((K_JP(IPLON,I_LAY)-1)*5+(K_JT(IPLON,I_LAY)-1))*NSPA(23) + 1
+        IND1 = (K_JP(IPLON,I_LAY)*5+(K_JT1(IPLON,I_LAY)-1))*NSPA(23) + 1
+        INDS = K_INDSELF(IPLON,I_LAY)
+        INDF = K_INDFOR(IPLON,I_LAY)
+
+        !  DO IG = 1, NG(23)
+!CDIR UNROLL=NG23
+        DO IG = 1 , NG23
+          Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYLC(IG)
+          P_TAUG(IPLON,I_LAY,IG) = P_COLH2O(IPLON,I_LAY) * &
+           & (GIVFAC * (P_FAC00(IPLON,I_LAY) * ABSA(IND0,IG) + &
+           & P_FAC10(IPLON,I_LAY) * ABSA(IND0+1,IG) + &
+           & P_FAC01(IPLON,I_LAY) * ABSA(IND1,IG) + &
+           & P_FAC11(IPLON,I_LAY) * ABSA(IND1+1,IG)) + &
+           & P_SELFFAC(IPLON,I_LAY) * (SELFREFC(INDS,IG) + &
+           & P_SELFFRAC(IPLON,I_LAY) * &
+           & (SELFREFC(INDS+1,IG) - SELFREFC(INDS,IG))) + &
+           & P_FORFAC(IPLON,I_LAY) * (FORREFC(INDF,IG) + &
+           & P_FORFRAC(IPLON,I_LAY) * &
+           & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG))))   
+          !     &          + TAURAY
+          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
+          IF (I_LAY == I_LAYSOLFR(IPLON)) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG) 
+          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+DO I_LAY = 1, I_NLAYERS
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY >= K_LAYTROP(IPLON)+1) THEN
+        !  DO IG = 1, NG(23)
+!CDIR UNROLL=NG23
+        DO IG = 1 , NG23
+          !    TAUG(LAY,IG) = COLMOL(LAY) * RAYLC(IG)
+          !    SSA(LAY,IG) = 1.0
+          P_TAUG(IPLON,I_LAY,IG) = 0.0_JPRB
+          P_TAUR(IPLON,I_LAY,IG) = P_COLMOL(IPLON,I_LAY) * RAYLC(IG) 
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+!-----------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL23',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE SRTM_TAUMOL23
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol23.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol23.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol23.intfb.h	(revision 3908)
@@ -0,0 +1,35 @@
+INTERFACE
+SUBROUTINE SRTM_TAUMOL23&
+ & ( KIDIA , KFDIA , KLEV,&
+ & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
+ & K_JP , K_JT , K_JT1,&
+ & P_COLH2O , P_COLMOL,&
+ & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF , P_FORFAC, P_FORFRAC, K_INDFOR,&
+ & P_SFLUXZEN, P_TAUG , P_TAUR , PRMU0&
+ & ) 
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE PARSRTM , ONLY : JPG
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA, KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(KIDIA:KFDIA,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KIDIA:KFDIA)
+END SUBROUTINE SRTM_TAUMOL23
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol24.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol24.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol24.F90	(revision 3908)
@@ -0,0 +1,181 @@
+SUBROUTINE SRTM_TAUMOL24 &
+ & ( KIDIA   , KFDIA    , KLEV,&
+ & P_FAC00   , P_FAC01  , P_FAC10   , P_FAC11,&
+ & K_JP      , K_JT     , K_JT1     , P_ONEMINUS,&
+ & P_COLH2O  , P_COLMOL , P_COLO2   , P_COLO3,&
+ & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF  , P_FORFAC, P_FORFRAC, K_INDFOR,&
+ & P_SFLUXZEN, P_TAUG   , P_TAUR    , PRMU0   &
+ & )  
+
+!     Written by Eli J. Mlawer, Atmospheric & Environmental Research.
+
+!     BAND 24:  12850-16000 cm-1 (low - H2O,O2; high - O2)
+
+! Modifications
+!        M.Hamrud      01-Oct-2003 CY28 Cleaning
+
+!     JJMorcrette 2003-02-24 adapted to ECMWF environment
+!        D.Salmond  31-Oct-2007 Vector version in the style of RRTM from Meteo France & NEC
+!     JJMorcrette 20110610 Flexible configuration for number of g-points
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
+USE PARSRTM  , ONLY : JPG
+USE YOESRTM  , ONLY : NG24
+USE YOESRTA24, ONLY : ABSA, ABSB, FORREFC, SELFREFC, SFLUXREFC, &
+ & ABSO3AC, ABSO3BC, RAYLAC, RAYLBC, LAYREFFR, STRRAT  
+USE YOESRTWN , ONLY : NSPA, NSPB
+
+IMPLICIT NONE
+
+!-- Output
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA, KFDIA 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ONEMINUS(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLMOL(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLO2(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLO3(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDFOR(KIDIA:KFDIA,KLEV) 
+
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SFLUXZEN(KIDIA:KFDIA,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUG(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUR(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KIDIA:KFDIA)
+!- from INTFAC      
+!- from INTIND
+!- from PRECISE             
+!- from PROFDATA             
+!- from SELF             
+INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, INDF, JS, I_LAY, I_LAYSOLFR(KIDIA:KFDIA), I_NLAYERS, IPLON
+
+INTEGER(KIND=JPIM) :: I_LAY_NEXT
+
+REAL(KIND=JPRB) :: Z_FAC000, Z_FAC001, Z_FAC010, Z_FAC011, Z_FAC100, Z_FAC101,&
+ & Z_FAC110, Z_FAC111, Z_FS, Z_SPECCOMB, Z_SPECMULT, Z_SPECPARM, &
+ & Z_TAURAY  
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL24',0,ZHOOK_HANDLE)
+
+I_NLAYERS = KLEV
+
+!     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.  
+
+I_LAYSOLFR(KIDIA:KFDIA) = K_LAYTROP(KIDIA:KFDIA)
+
+DO I_LAY = 1, I_NLAYERS
+  I_LAY_NEXT = MIN(I_NLAYERS, I_LAY+1)
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY <= K_LAYTROP(IPLON)) THEN
+        IF (K_JP(IPLON,I_LAY) < LAYREFFR .AND. K_JP(IPLON,I_LAY_NEXT) >= LAYREFFR) &
+         & I_LAYSOLFR(IPLON) = MIN(I_LAY+1,K_LAYTROP(IPLON))  
+        Z_SPECCOMB = P_COLH2O(IPLON,I_LAY) + STRRAT*P_COLO2(IPLON,I_LAY)
+        Z_SPECPARM = P_COLH2O(IPLON,I_LAY)/Z_SPECCOMB 
+        IF (Z_SPECPARM >= P_ONEMINUS(IPLON)) Z_SPECPARM = P_ONEMINUS(IPLON)
+        Z_SPECMULT = 8.*(Z_SPECPARM)
+        JS = 1 + INT(Z_SPECMULT)
+        Z_FS = MOD(Z_SPECMULT, 1.0_JPRB )
+        ! Z_FAC000 = (1. - Z_FS) * P_FAC00(I_LAY)
+        ! Z_FAC010 = (1. - Z_FS) * P_FAC10(I_LAY)
+        ! Z_FAC100 = Z_FS * P_FAC00(I_LAY)
+        ! Z_FAC110 = Z_FS * P_FAC10(I_LAY)
+        ! Z_FAC001 = (1. - Z_FS) * P_FAC01(I_LAY)
+        ! Z_FAC011 = (1. - Z_FS) * P_FAC11(I_LAY)
+        ! Z_FAC101 = Z_FS * P_FAC01(I_LAY)
+        ! Z_FAC111 = Z_FS * P_FAC11(I_LAY)
+        IND0 = ((K_JP(IPLON,I_LAY)-1)*5+(K_JT(IPLON,I_LAY)-1))*NSPA(24) + JS
+        IND1 = (K_JP(IPLON,I_LAY)*5+(K_JT1(IPLON,I_LAY)-1))*NSPA(24) + JS
+        INDS = K_INDSELF(IPLON,I_LAY)
+        INDF = K_INDFOR(IPLON,I_LAY)
+
+        !  DO IG = 1, NG(24)
+!CDIR UNROLL=NG24
+        DO IG = 1 , NG24
+          Z_TAURAY = P_COLMOL(IPLON,I_LAY) * (RAYLAC(IG,JS) + &
+           & Z_FS * (RAYLAC(IG,JS+1) - RAYLAC(IG,JS)))  
+          P_TAUG(IPLON,I_LAY,IG) = Z_SPECCOMB * &
+           !    & (Z_FAC000 * ABSA(IND0,IG) + &
+           !    & Z_FAC100 * ABSA(IND0+1,IG) + &
+           !    & Z_FAC010 * ABSA(IND0+9,IG) + &
+           !    & Z_FAC110 * ABSA(IND0+10,IG) + &
+           !    & Z_FAC001 * ABSA(IND1,IG) + &
+           !    & Z_FAC101 * ABSA(IND1+1,IG) + &
+           !    & Z_FAC011 * ABSA(IND1+9,IG) + &
+           !    & Z_FAC111 * ABSA(IND1+10,IG)) + &
+           & (&
+           & (1. - Z_FS) * ( ABSA(IND0,IG) * P_FAC00(IPLON,I_LAY) + &
+           &                 ABSA(IND0+9,IG) * P_FAC10(IPLON,I_LAY) + &
+           &                 ABSA(IND1,IG) * P_FAC01(IPLON,I_LAY) + &
+           &                 ABSA(IND1+9,IG) * P_FAC11(IPLON,I_LAY) ) + &
+           & Z_FS        * ( ABSA(IND0+1,IG) * P_FAC00(IPLON,I_LAY) + &
+           &                 ABSA(IND0+10,IG) * P_FAC10(IPLON,I_LAY) + &
+           &                 ABSA(IND1+1,IG) * P_FAC01(IPLON,I_LAY) + &
+           &                 ABSA(IND1+10,IG) * P_FAC11(IPLON,I_LAY) ) &
+           & ) + &
+           & P_COLO3(IPLON,I_LAY) * ABSO3AC(IG) + &
+           & P_COLH2O(IPLON,I_LAY) *  &
+           & (P_SELFFAC(IPLON,I_LAY) * (SELFREFC(INDS,IG) + &
+           & P_SELFFRAC(IPLON,I_LAY) * &
+           & (SELFREFC(INDS+1,IG) - SELFREFC(INDS,IG))) + &
+           & P_FORFAC(IPLON,I_LAY) * (FORREFC(INDF,IG) +  &
+           & P_FORFRAC(IPLON,I_LAY) * &
+           & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG))))  
+          !     &           + TAURAY
+          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
+          IF (I_LAY == I_LAYSOLFR(IPLON)) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG,JS) &
+           & + Z_FS * (SFLUXREFC(IG,JS+1) - SFLUXREFC(IG,JS))  
+          P_TAUR(IPLON,I_LAY,IG) =  Z_TAURAY
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+DO I_LAY = 1, I_NLAYERS
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY >= K_LAYTROP(IPLON)+1) THEN
+        IND0 = ((K_JP(IPLON,I_LAY)-13)*5+(K_JT(IPLON,I_LAY)-1))*NSPB(24) + 1
+        IND1 = ((K_JP(IPLON,I_LAY)-12)*5+(K_JT1(IPLON,I_LAY)-1))*NSPB(24) + 1
+
+        !  DO IG = 1, NG(24)
+!CDIR UNROLL=NG24
+        DO IG = 1 , NG24
+          Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYLBC(IG)
+          P_TAUG(IPLON,I_LAY,IG) = P_COLO2(IPLON,I_LAY) * &
+           & (P_FAC00(IPLON,I_LAY) * ABSB(IND0,IG) + &
+           & P_FAC10(IPLON,I_LAY) * ABSB(IND0+1,IG) + &
+           & P_FAC01(IPLON,I_LAY) * ABSB(IND1,IG) + &
+           & P_FAC11(IPLON,I_LAY) * ABSB(IND1+1,IG)) + &
+           & P_COLO3(IPLON,I_LAY) * ABSO3BC(IG)  
+          !     &          + TAURAY
+          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
+          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+!-----------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL24',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE SRTM_TAUMOL24
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol24.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol24.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol24.intfb.h	(revision 3908)
@@ -0,0 +1,38 @@
+INTERFACE
+SUBROUTINE SRTM_TAUMOL24&
+ & ( KIDIA , KFDIA , KLEV,&
+ & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
+ & K_JP , K_JT , K_JT1 , P_ONEMINUS,&
+ & P_COLH2O , P_COLMOL , P_COLO2 , P_COLO3,&
+ & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF , P_FORFAC, P_FORFRAC, K_INDFOR,&
+ & P_SFLUXZEN, P_TAUG , P_TAUR , PRMU0&
+ & ) 
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE PARSRTM , ONLY : JPG
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA, KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLO3(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(KIDIA:KFDIA,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KIDIA:KFDIA)
+END SUBROUTINE SRTM_TAUMOL24
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol25.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol25.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol25.F90	(revision 3908)
@@ -0,0 +1,126 @@
+SUBROUTINE SRTM_TAUMOL25 &
+ & ( KIDIA   , KFDIA    , KLEV,&
+ & P_FAC00   , P_FAC01  , P_FAC10   , P_FAC11,&
+ & K_JP      , K_JT     , K_JT1,&
+ & P_COLH2O  , P_COLMOL , P_COLO3,&
+ & K_LAYTROP,&
+ & P_SFLUXZEN, P_TAUG   , P_TAUR    , PRMU0   &
+ & )  
+
+!     Written by Eli J. Mlawer, Atmospheric & Environmental Research.
+
+!     BAND 25:  16000-22650 cm-1 (low - H2O; high - nothing)
+
+!      PARAMETER (MG=16, MXLAY=203, NBANDS=14)
+
+! Modifications
+!        M.Hamrud      01-Oct-2003 CY28 Cleaning
+
+!     JJMorcrette 2003-02-24 adapted to ECMWF environment
+!        D.Salmond  31-Oct-2007 Vector version in the style of RRTM from Meteo France & NEC
+!     JJMorcrette 20110610 Flexible configuration for number of g-points
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
+USE PARSRTM  , ONLY : JPG
+USE YOESRTM  , ONLY : NG25
+USE YOESRTA25, ONLY : ABSA, SFLUXREFC, ABSO3AC, ABSO3BC, RAYLC, LAYREFFR  
+USE YOESRTWN , ONLY : NSPA
+
+IMPLICIT NONE
+
+!-- Output
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA, KFDIA 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLMOL(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLO3(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SFLUXZEN(KIDIA:KFDIA,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUG(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUR(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KIDIA:KFDIA)
+!- from INTFAC      
+!- from INTIND
+!- from PRECISE             
+!- from PROFDATA             
+!- from SELF             
+INTEGER(KIND=JPIM) :: IG, IND0, IND1, I_LAY, I_LAYSOLFR(KIDIA:KFDIA), I_NLAYERS, IPLON
+
+INTEGER(KIND=JPIM) :: I_LAY_NEXT
+
+REAL(KIND=JPRB) ::  &
+ & Z_TAURAY  
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL25',0,ZHOOK_HANDLE)
+
+I_NLAYERS = KLEV
+
+!     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.  
+
+I_LAYSOLFR(KIDIA:KFDIA) = K_LAYTROP(KIDIA:KFDIA)
+
+DO I_LAY = 1, I_NLAYERS
+  I_LAY_NEXT = MIN(I_NLAYERS, I_LAY+1)
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY <= K_LAYTROP(IPLON)) THEN
+        IF (K_JP(IPLON,I_LAY) < LAYREFFR .AND. K_JP(IPLON,I_LAY_NEXT) >= LAYREFFR) &
+         & I_LAYSOLFR(IPLON) = MIN(I_LAY+1,K_LAYTROP(IPLON))  
+        IND0 = ((K_JP(IPLON,I_LAY)-1)*5+(K_JT(IPLON,I_LAY)-1))*NSPA(25) + 1
+        IND1 = (K_JP(IPLON,I_LAY)*5+(K_JT1(IPLON,I_LAY)-1))*NSPA(25) + 1
+
+        !  DO IG = 1, NG(25)
+!CDIR UNROLL=NG25
+        DO IG = 1 , NG25
+          Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYLC(IG)
+          P_TAUG(IPLON,I_LAY,IG) = P_COLH2O(IPLON,I_LAY) * &
+           & (P_FAC00(IPLON,I_LAY) * ABSA(IND0,IG) + &
+           & P_FAC10(IPLON,I_LAY) * ABSA(IND0+1,IG) + &
+           & P_FAC01(IPLON,I_LAY) * ABSA(IND1,IG) + &
+           & P_FAC11(IPLON,I_LAY) * ABSA(IND1+1,IG)) + &
+           & P_COLO3(IPLON,I_LAY) * ABSO3AC(IG)   
+          !     &          + TAURAY
+          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
+          IF (I_LAY == I_LAYSOLFR(IPLON)) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG) 
+          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+DO I_LAY = 1, I_NLAYERS
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY >= K_LAYTROP(IPLON)+1) THEN
+        !  DO IG = 1, NG(25)
+!CDIR UNROLL=NG25
+        DO IG = 1 , NG25
+          Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYLC(IG)
+          P_TAUG(IPLON,I_LAY,IG) = P_COLO3(IPLON,I_LAY) * ABSO3BC(IG) 
+          !     &          + TAURAY
+          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
+          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+!-----------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL25',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE SRTM_TAUMOL25
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol25.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol25.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol25.intfb.h	(revision 3908)
@@ -0,0 +1,30 @@
+INTERFACE
+SUBROUTINE SRTM_TAUMOL25&
+ & ( KIDIA , KFDIA , KLEV,&
+ & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
+ & K_JP , K_JT , K_JT1,&
+ & P_COLH2O , P_COLMOL , P_COLO3,&
+ & K_LAYTROP,&
+ & P_SFLUXZEN, P_TAUG , P_TAUR , PRMU0&
+ & ) 
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE PARSRTM , ONLY : JPG
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA, KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLO3(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(KIDIA:KFDIA,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KIDIA:KFDIA)
+END SUBROUTINE SRTM_TAUMOL25
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol26.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol26.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol26.F90	(revision 3908)
@@ -0,0 +1,97 @@
+SUBROUTINE SRTM_TAUMOL26 &
+ & ( KIDIA   , KFDIA    , KLEV,&
+ & P_COLMOL  ,K_LAYTROP,&
+ & P_SFLUXZEN, P_TAUG   , P_TAUR    , PRMU0   &
+ & )  
+
+!     Written by Eli J. Mlawer, Atmospheric & Environmental Research.
+
+!     BAND 26:  22650-29000 cm-1 (low - nothing; high - nothing)
+
+!      PARAMETER (MG=16, MXLAY=203, NBANDS=14)
+
+! Modifications
+!        M.Hamrud      01-Oct-2003 CY28 Cleaning
+
+!     JJMorcrette 2003-02-24 adapted to ECMWF environment
+!        D.Salmond  31-Oct-2007 Vector version in the style of RRTM from Meteo France & NEC
+!     JJMorcrette 20110610 Flexible configuration for number of g-points
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
+USE PARSRTM  , ONLY : JPG
+USE YOESRTM  , ONLY : NG26
+USE YOESRTA26, ONLY : SFLUXREFC, RAYLC
+
+IMPLICIT NONE
+
+!-- Output
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA, KFDIA 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLMOL(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SFLUXZEN(KIDIA:KFDIA,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUG(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUR(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KIDIA:KFDIA)
+!- from AER
+!- from INTFAC      
+!- from INTIND
+!- from PRECISE             
+!- from PROFDATA             
+!- from SELF             
+INTEGER(KIND=JPIM) :: IG, I_LAY, I_LAYSOLFR(KIDIA:KFDIA), I_NLAYERS, IPLON
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL26',0,ZHOOK_HANDLE)
+
+I_NLAYERS = KLEV
+
+!     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.  
+
+I_LAYSOLFR(KIDIA:KFDIA) = K_LAYTROP(KIDIA:KFDIA)
+
+DO I_LAY = 1, I_NLAYERS
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY <= K_LAYTROP(IPLON)) THEN
+        !  DO IG = 1, NG(26)
+!CDIR UNROLL=NG26
+        DO IG = 1 , NG26 
+          !    TAUG(LAY,IG) = COLMOL(LAY) * RAYLC(IG)
+          !    SSA(LAY,IG) = 1.0
+          IF (I_LAY == I_LAYSOLFR(IPLON)) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG) 
+          P_TAUG(IPLON,I_LAY,IG) = 0.0_JPRB
+          P_TAUR(IPLON,I_LAY,IG) = P_COLMOL(IPLON,I_LAY) * RAYLC(IG) 
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+DO I_LAY = 1, I_NLAYERS
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY >= K_LAYTROP(IPLON)+1) THEN
+        !  DO IG = 1, NG(26)
+!CDIR UNROLL=NG26
+        DO IG = 1 , NG26
+          !    TAUG(LAY,IG) = COLMOL(LAY) * RAYLC(IG)
+          !    SSA(LAY,IG) = 1.0
+          P_TAUG(IPLON,I_LAY,IG) = 0.0_JPRB
+          P_TAUR(IPLON,I_LAY,IG) = P_COLMOL(IPLON,I_LAY) * RAYLC(IG) 
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+!-----------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL26',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE SRTM_TAUMOL26
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol26.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol26.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol26.intfb.h	(revision 3908)
@@ -0,0 +1,18 @@
+INTERFACE
+SUBROUTINE SRTM_TAUMOL26&
+ & ( KIDIA , KFDIA , KLEV,&
+ & P_COLMOL ,K_LAYTROP,&
+ & P_SFLUXZEN, P_TAUG , P_TAUR , PRMU0&
+ & ) 
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE PARSRTM , ONLY : JPG
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA, KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(KIDIA:KFDIA,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KIDIA:KFDIA)
+END SUBROUTINE SRTM_TAUMOL26
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol27.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol27.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol27.F90	(revision 3908)
@@ -0,0 +1,125 @@
+SUBROUTINE SRTM_TAUMOL27 &
+ & ( KIDIA   , KFDIA    , KLEV,&
+ & P_FAC00   , P_FAC01  , P_FAC10   , P_FAC11,&
+ & K_JP      , K_JT     , K_JT1,&
+ & P_COLMOL  , P_COLO3,&
+ & K_LAYTROP,&
+ & P_SFLUXZEN, P_TAUG   , P_TAUR    , PRMU0   &
+ & )  
+
+!     Written by Eli J. Mlawer, Atmospheric & Environmental Research.
+
+!     BAND 27:  29000-38000 cm-1 (low - O3; high - O3)
+
+! Modifications
+!        M.Hamrud      01-Oct-2003 CY28 Cleaning
+
+!     JJMorcrette 2003-02-24 adapted to ECMWF environment
+!        D.Salmond  31-Oct-2007 Vector version in the style of RRTM from Meteo France & NEC
+!     JJMorcrette 20110610 Flexible configuration for number of g-points
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
+USE PARSRTM  , ONLY : JPG
+USE YOESRTM  , ONLY : NG27
+USE YOESRTA27, ONLY : ABSA, ABSB, SFLUXREFC, RAYLC, LAYREFFR, SCALEKUR  
+USE YOESRTWN , ONLY : NSPA, NSPB
+
+IMPLICIT NONE
+
+!-- Output
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA, KFDIA 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLMOL(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLO3(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SFLUXZEN(KIDIA:KFDIA,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUG(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUR(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KIDIA:KFDIA)
+!- from INTFAC      
+!- from INTIND
+!- from PRECISE             
+!- from PROFDATA             
+!- from SELF             
+INTEGER(KIND=JPIM) :: IG, IND0, IND1, I_LAY, I_LAYSOLFR(KIDIA:KFDIA), I_NLAYERS, IPLON
+
+REAL(KIND=JPRB) ::  &
+ & Z_TAURAY  
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL27',0,ZHOOK_HANDLE)
+
+I_NLAYERS = KLEV
+
+!     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.  
+DO I_LAY = 1, I_NLAYERS
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY <= K_LAYTROP(IPLON)) THEN
+        IND0 = ((K_JP(IPLON,I_LAY)-1)*5+(K_JT(IPLON,I_LAY)-1))*NSPA(27) + 1
+        IND1 = (K_JP(IPLON,I_LAY)*5+(K_JT1(IPLON,I_LAY)-1))*NSPA(27) + 1
+
+        !  DO IG = 1, NG(27)
+!CDIR UNROLL=NG27
+        DO IG = 1 , NG27
+          Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYLC(IG)
+          P_TAUG(IPLON,I_LAY,IG) = P_COLO3(IPLON,I_LAY) * &
+           & (P_FAC00(IPLON,I_LAY) * ABSA(IND0,IG) + &
+           & P_FAC10(IPLON,I_LAY) * ABSA(IND0+1,IG) + &
+           & P_FAC01(IPLON,I_LAY) * ABSA(IND1,IG) + &
+           & P_FAC11(IPLON,I_LAY) * ABSA(IND1+1,IG))  
+          !     &          + TAURAY
+          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
+          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+I_LAYSOLFR(:) = I_NLAYERS
+
+DO I_LAY = 1, I_NLAYERS
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY >= K_LAYTROP(IPLON)+1) THEN
+        IF (K_JP(IPLON,I_LAY-1) < LAYREFFR .AND. K_JP(IPLON,I_LAY) >= LAYREFFR) &
+         & I_LAYSOLFR(IPLON) = I_LAY  
+        IND0 = ((K_JP(IPLON,I_LAY)-13)*5+(K_JT(IPLON,I_LAY)-1))*NSPB(27) + 1
+        IND1 = ((K_JP(IPLON,I_LAY)-12)*5+(K_JT1(IPLON,I_LAY)-1))*NSPB(27) + 1
+
+        !  DO IG = 1, NG(27)
+!CDIR UNROLL=NG27
+        DO IG = 1 , NG27
+          Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYLC(IG)
+          P_TAUG(IPLON,I_LAY,IG) = P_COLO3(IPLON,I_LAY) * &
+           & (P_FAC00(IPLON,I_LAY) * ABSB(IND0,IG) + &
+           & P_FAC10(IPLON,I_LAY) * ABSB(IND0+1,IG) + &
+           & P_FAC01(IPLON,I_LAY) * ABSB(IND1,IG) +  &
+           & P_FAC11(IPLON,I_LAY) * ABSB(IND1+1,IG))  
+          !     &          + TAURAY
+          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
+          IF (I_LAY == I_LAYSOLFR(IPLON)) P_SFLUXZEN(IPLON,IG) = SCALEKUR * SFLUXREFC(IG) 
+          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+!-----------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL27',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE SRTM_TAUMOL27
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol27.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol27.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol27.intfb.h	(revision 3908)
@@ -0,0 +1,29 @@
+INTERFACE
+SUBROUTINE SRTM_TAUMOL27&
+ & ( KIDIA , KFDIA , KLEV,&
+ & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
+ & K_JP , K_JT , K_JT1,&
+ & P_COLMOL , P_COLO3,&
+ & K_LAYTROP,&
+ & P_SFLUXZEN, P_TAUG , P_TAUR , PRMU0&
+ & ) 
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE PARSRTM , ONLY : JPG
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA, KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLO3(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(KIDIA:KFDIA,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KIDIA:KFDIA)
+END SUBROUTINE SRTM_TAUMOL27
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol28.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol28.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol28.F90	(revision 3908)
@@ -0,0 +1,191 @@
+SUBROUTINE SRTM_TAUMOL28 &
+ & ( KIDIA   , KFDIA    , KLEV,&
+ & P_FAC00   , P_FAC01  , P_FAC10   , P_FAC11,&
+ & K_JP      , K_JT     , K_JT1     , P_ONEMINUS,&
+ & P_COLMOL  , P_COLO2  , P_COLO3,&
+ & K_LAYTROP,&
+ & P_SFLUXZEN, P_TAUG   , P_TAUR    , PRMU0   &
+ & )  
+
+!     Written by Eli J. Mlawer, Atmospheric & Environmental Research.
+
+!     BAND 28:  38000-50000 cm-1 (low - O3,O2; high - O3,O2)
+
+! Modifications
+!        M.Hamrud      01-Oct-2003 CY28 Cleaning
+
+!     JJMorcrette 2003-02-24 adapted to ECMWF environment
+!        D.Salmond  31-Oct-2007 Vector version in the style of RRTM from Meteo France & NEC
+!     JJMorcrette 20010610 Flexible configuration for number of g-points
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
+USE PARSRTM  , ONLY : JPG
+USE YOESRTM  , ONLY : NG28
+USE YOESRTA28, ONLY : ABSA, ABSB, SFLUXREFC, RAYL, LAYREFFR, STRRAT  
+USE YOESRTWN , ONLY : NSPA, NSPB
+
+IMPLICIT NONE
+
+!-- Output
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA, KFDIA 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ONEMINUS(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLMOL(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLO2(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLO3(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SFLUXZEN(KIDIA:KFDIA,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUG(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUR(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KIDIA:KFDIA)
+!- from INTFAC      
+!- from INTIND
+!- from PRECISE             
+!- from PROFDATA             
+!- from SELF             
+INTEGER(KIND=JPIM) :: IG, IND0, IND1, JS, I_LAY, I_LAYSOLFR(KIDIA:KFDIA), I_NLAYERS, IPLON
+
+REAL(KIND=JPRB) :: Z_FAC000, Z_FAC001, Z_FAC010, Z_FAC011, Z_FAC100, Z_FAC101,&
+ & Z_FAC110, Z_FAC111, Z_FS, Z_SPECCOMB, Z_SPECMULT, Z_SPECPARM, &
+ & Z_TAURAY  
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL28',0,ZHOOK_HANDLE)
+
+I_NLAYERS = KLEV
+
+!     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.  
+
+DO I_LAY = 1, I_NLAYERS
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY <= K_LAYTROP(IPLON)) THEN
+        Z_SPECCOMB = P_COLO3(IPLON,I_LAY) + STRRAT*P_COLO2(IPLON,I_LAY)
+        Z_SPECPARM = P_COLO3(IPLON,I_LAY)/Z_SPECCOMB 
+        IF (Z_SPECPARM >= P_ONEMINUS(IPLON)) Z_SPECPARM = P_ONEMINUS(IPLON)
+        Z_SPECMULT = 8.*(Z_SPECPARM)
+        JS = 1 + INT(Z_SPECMULT)
+        Z_FS = MOD(Z_SPECMULT, 1.0_JPRB )
+        ! Z_FAC000 = (1. - Z_FS) * P_FAC00(I_LAY)
+        ! Z_FAC010 = (1. - Z_FS) * P_FAC10(I_LAY)
+        ! Z_FAC100 = Z_FS * P_FAC00(I_LAY)
+        ! Z_FAC110 = Z_FS * P_FAC10(I_LAY)
+        ! Z_FAC001 = (1. - Z_FS) * P_FAC01(I_LAY)
+        ! Z_FAC011 = (1. - Z_FS) * P_FAC11(I_LAY)
+        ! Z_FAC101 = Z_FS * P_FAC01(I_LAY)
+        ! Z_FAC111 = Z_FS * P_FAC11(I_LAY)
+        IND0 = ((K_JP(IPLON,I_LAY)-1)*5+(K_JT(IPLON,I_LAY)-1))*NSPA(28) + JS
+        IND1 = (K_JP(IPLON,I_LAY)*5+(K_JT1(IPLON,I_LAY)-1))*NSPA(28) + JS
+        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
+
+        !  DO IG = 1, NG(28)
+!CDIR UNROLL=NG28
+        DO IG = 1 , NG28
+          P_TAUG(IPLON,I_LAY,IG) = Z_SPECCOMB * &
+           !    & (Z_FAC000 * ABSA(IND0,IG) + &
+           !    & Z_FAC100 * ABSA(IND0+1,IG) + &
+           !    & Z_FAC010 * ABSA(IND0+9,IG) + &
+           !    & Z_FAC110 * ABSA(IND0+10,IG) + &
+           !    & Z_FAC001 * ABSA(IND1,IG) + &
+           !    & Z_FAC101 * ABSA(IND1+1,IG) + &
+           !    & Z_FAC011 * ABSA(IND1+9,IG) + &
+           !    & Z_FAC111 * ABSA(IND1+10,IG))   
+           & (&
+           & (1. - Z_FS) * ( ABSA(IND0,IG) * P_FAC00(IPLON,I_LAY) + &
+           &                 ABSA(IND0+9,IG) * P_FAC10(IPLON,I_LAY) + &
+           &                 ABSA(IND1,IG) * P_FAC01(IPLON,I_LAY) + &
+           &                 ABSA(IND1+9,IG) * P_FAC11(IPLON,I_LAY) ) + &
+           & Z_FS        * ( ABSA(IND0+1,IG) * P_FAC00(IPLON,I_LAY) + &
+           &                 ABSA(IND0+10,IG) * P_FAC10(IPLON,I_LAY) + &
+           &                 ABSA(IND1+1,IG) * P_FAC01(IPLON,I_LAY) + &
+           &                 ABSA(IND1+10,IG) * P_FAC11(IPLON,I_LAY) ) &
+           & ) 
+          !     &           + TAURAY
+          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
+          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+I_LAYSOLFR(:) = I_NLAYERS
+
+DO I_LAY = 1, I_NLAYERS
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY >= K_LAYTROP(IPLON)+1) THEN
+        IF (K_JP(IPLON,I_LAY-1) < LAYREFFR .AND. K_JP(IPLON,I_LAY) >= LAYREFFR) &
+         & I_LAYSOLFR(IPLON) = I_LAY  
+        Z_SPECCOMB = P_COLO3(IPLON,I_LAY) + STRRAT*P_COLO2(IPLON,I_LAY)
+        Z_SPECPARM = P_COLO3(IPLON,I_LAY)/Z_SPECCOMB 
+        IF (Z_SPECPARM >= P_ONEMINUS(IPLON)) Z_SPECPARM = P_ONEMINUS(IPLON)
+        Z_SPECMULT = 4.*(Z_SPECPARM)
+        JS = 1 + INT(Z_SPECMULT)
+        Z_FS = MOD(Z_SPECMULT, 1.0_JPRB )
+        ! Z_FAC000 = (1. - Z_FS) * P_FAC00(I_LAY)
+        ! Z_FAC010 = (1. - Z_FS) * P_FAC10(I_LAY)
+        ! Z_FAC100 = Z_FS * P_FAC00(I_LAY)
+        ! Z_FAC110 = Z_FS * P_FAC10(I_LAY)
+        ! Z_FAC001 = (1. - Z_FS) * P_FAC01(I_LAY)
+        ! Z_FAC011 = (1. - Z_FS) * P_FAC11(I_LAY)
+        ! Z_FAC101 = Z_FS * P_FAC01(I_LAY)
+        ! Z_FAC111 = Z_FS * P_FAC11(I_LAY)
+        IND0 = ((K_JP(IPLON,I_LAY)-13)*5+(K_JT(IPLON,I_LAY)-1))*NSPB(28) + JS
+        IND1 = ((K_JP(IPLON,I_LAY)-12)*5+(K_JT1(IPLON,I_LAY)-1))*NSPB(28) + JS
+        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
+
+        !  DO IG = 1, NG(28)
+!CDIR UNROLL=NG28
+        DO IG = 1 , NG28
+          P_TAUG(IPLON,I_LAY,IG) = Z_SPECCOMB * &
+           !    & (Z_FAC000 * ABSB(IND0,IG) + &
+           !    & Z_FAC100 * ABSB(IND0+1,IG) + &
+           !    & Z_FAC010 * ABSB(IND0+5,IG) + &
+           !    & Z_FAC110 * ABSB(IND0+6,IG) + &
+           !    & Z_FAC001 * ABSB(IND1,IG) + &
+           !    & Z_FAC101 * ABSB(IND1+1,IG) + &
+           !    & Z_FAC011 * ABSB(IND1+5,IG) + &
+           !    & Z_FAC111 * ABSB(IND1+6,IG))   
+           & (&
+           & (1. - Z_FS) * ( ABSB(IND0,IG) * P_FAC00(IPLON,I_LAY) + &
+           &                 ABSB(IND0+5,IG) * P_FAC10(IPLON,I_LAY) + &
+           &                 ABSB(IND1,IG) * P_FAC01(IPLON,I_LAY) + &
+           &                 ABSB(IND1+5,IG) * P_FAC11(IPLON,I_LAY) ) + &
+           & Z_FS        * ( ABSB(IND0+1,IG) * P_FAC00(IPLON,I_LAY) + &
+           &                 ABSB(IND0+6,IG) * P_FAC10(IPLON,I_LAY) + &
+           &                 ABSB(IND1+1,IG) * P_FAC01(IPLON,I_LAY) + &
+           &                 ABSB(IND1+6,IG) * P_FAC11(IPLON,I_LAY) ) &
+           & ) 
+          !     &           + TAURAY
+          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
+          IF (I_LAY == I_LAYSOLFR(IPLON)) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG,JS) &
+           & + Z_FS * (SFLUXREFC(IG,JS+1) - SFLUXREFC(IG,JS))  
+! The following actually improves this band by setting the solar
+! spectrum at each g point equal to what would be computed if
+! molecular oxygen was set to zero. But it is worse overall due to a
+! compensating error with the previous band 27.
+!          IF (I_LAY == I_LAYSOLFR) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG,5)
+          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+!-----------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL28',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE SRTM_TAUMOL28
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol28.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol28.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol28.intfb.h	(revision 3908)
@@ -0,0 +1,31 @@
+INTERFACE
+SUBROUTINE SRTM_TAUMOL28&
+ & ( KIDIA , KFDIA , KLEV,&
+ & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
+ & K_JP , K_JT , K_JT1 , P_ONEMINUS,&
+ & P_COLMOL , P_COLO2 , P_COLO3,&
+ & K_LAYTROP,&
+ & P_SFLUXZEN, P_TAUG , P_TAUR , PRMU0&
+ & ) 
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE PARSRTM , ONLY : JPG
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA, KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLO3(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(KIDIA:KFDIA,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KIDIA:KFDIA)
+END SUBROUTINE SRTM_TAUMOL28
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol29.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol29.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol29.F90	(revision 3908)
@@ -0,0 +1,145 @@
+SUBROUTINE SRTM_TAUMOL29 &
+ & ( KIDIA   , KFDIA    , KLEV,&
+ & P_FAC00   , P_FAC01  , P_FAC10   , P_FAC11,&
+ & K_JP      , K_JT     , K_JT1,&
+ & P_COLH2O  , P_COLCO2 , P_COLMOL,&
+ & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF  , P_FORFAC, P_FORFRAC, K_INDFOR,&
+ & P_SFLUXZEN, P_TAUG   , P_TAUR    , PRMU0   &
+ & )  
+
+!     Written by Eli J. Mlawer, Atmospheric & Environmental Research.
+
+!     BAND 29:  820-2600 cm-1 (low - H2O; high - CO2)
+
+! Modifications
+!        M.Hamrud      01-Oct-2003 CY28 Cleaning
+
+!     JJMorcrette 2002-10-03 adapted to ECMWF environment
+!        D.Salmond  31-Oct-2007 Vector version in the style of RRTM from Meteo France & NEC
+!     JJMorcrette 20110610 Flexible configuration for number of g-points
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
+USE PARSRTM  , ONLY : JPG
+USE YOESRTM  , ONLY : NG29
+USE YOESRTA29, ONLY : ABSA, ABSB, FORREFC, SELFREFC, SFLUXREFC, &
+ & ABSH2OC, ABSCO2C, RAYL, LAYREFFR  
+USE YOESRTWN , ONLY : NSPA, NSPB
+
+IMPLICIT NONE
+
+!-- Output
+INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA, KFDIA 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCO2(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLMOL(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFAC(KIDIA:KFDIA,KLEV) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFRAC(KIDIA:KFDIA,KLEV) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDFOR(KIDIA:KFDIA,KLEV)
+
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SFLUXZEN(KIDIA:KFDIA,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUG(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUR(KIDIA:KFDIA,KLEV,JPG) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KIDIA:KFDIA)
+!- from INTFAC      
+!- from INTIND
+!- from PRECISE             
+!- from PROFDATA             
+!- from SELF             
+!-- from FOREIGN
+INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, INDF, I_LAY, I_LAYSOLFR(KIDIA:KFDIA), I_NLAYERS, IPLON
+
+REAL(KIND=JPRB) ::  &
+ & Z_TAURAY  
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL29',0,ZHOOK_HANDLE)
+
+I_NLAYERS = KLEV
+
+! 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.  
+
+DO I_LAY = 1, I_NLAYERS
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY <= K_LAYTROP(IPLON)) THEN
+        IND0 = ((K_JP(IPLON,I_LAY)-1)*5+(K_JT(IPLON,I_LAY)-1))*NSPA(29) + 1
+        IND1 = (K_JP(IPLON,I_LAY)*5+(K_JT1(IPLON,I_LAY)-1))*NSPA(29) + 1
+        INDS = K_INDSELF(IPLON,I_LAY)
+        INDF = K_INDFOR(IPLON,I_LAY)
+        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
+
+        !  DO IG = 1, NG(29)
+!CDIR UNROLL=NG29
+        DO IG = 1, NG29
+          P_TAUG(IPLON,I_LAY,IG) = P_COLH2O(IPLON,I_LAY) * &
+           & ((P_FAC00(IPLON,I_LAY) * ABSA(IND0,IG) + &
+           & P_FAC10(IPLON,I_LAY) * ABSA(IND0+1,IG) + &
+           & P_FAC01(IPLON,I_LAY) * ABSA(IND1,IG) + &
+           & P_FAC11(IPLON,I_LAY) * ABSA(IND1+1,IG)) + &
+           & P_SELFFAC(IPLON,I_LAY) * (SELFREFC(INDS,IG) + &
+           & P_SELFFRAC(IPLON,I_LAY) * &
+           & (SELFREFC(INDS+1,IG) - SELFREFC(INDS,IG))) + &
+           & P_FORFAC(IPLON,I_LAY) * (FORREFC(INDF,IG) +  &
+           & P_FORFRAC(IPLON,I_LAY) * &
+           & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG)))) &
+           & + P_COLCO2(IPLON,I_LAY) * ABSCO2C(IG)   
+          !     &           + TAURAY &
+          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
+          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+I_LAYSOLFR(:) = I_NLAYERS
+
+DO I_LAY = 1, I_NLAYERS
+  DO IPLON = KIDIA, KFDIA
+    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
+      IF (I_LAY >= K_LAYTROP(IPLON)+1) THEN
+        IF (K_JP(IPLON,I_LAY-1) < LAYREFFR .AND. K_JP(IPLON,I_LAY) >= LAYREFFR) &
+         & I_LAYSOLFR(IPLON) = I_LAY  
+        IND0 = ((K_JP(IPLON,I_LAY)-13)*5+(K_JT(IPLON,I_LAY)-1))*NSPB(29) + 1
+        IND1 = ((K_JP(IPLON,I_LAY)-12)*5+(K_JT1(IPLON,I_LAY)-1))*NSPB(29) + 1
+        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
+
+        !  DO IG = 1, NG(29)
+!CDIR UNROLL=NG29
+        DO IG = 1 , NG29
+          P_TAUG(IPLON,I_LAY,IG) = P_COLCO2(IPLON,I_LAY) * &
+           & (P_FAC00(IPLON,I_LAY) * ABSB(IND0,IG) + &
+           & P_FAC10(IPLON,I_LAY) * ABSB(IND0+1,IG) + &
+           & P_FAC01(IPLON,I_LAY) * ABSB(IND1,IG) + &
+           & P_FAC11(IPLON,I_LAY) * ABSB(IND1+1,IG))   &
+           & + P_COLH2O(IPLON,I_LAY) * ABSH2OC(IG)   
+          !     &           + TAURAY
+          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
+          IF (I_LAY == I_LAYSOLFR(IPLON)) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG) 
+          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
+        ENDDO
+      ENDIF
+    ENDIF
+  ENDDO
+ENDDO
+
+!-----------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL29',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE SRTM_TAUMOL29
Index: LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol29.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol29.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/srtm_taumol29.intfb.h	(revision 3908)
@@ -0,0 +1,36 @@
+INTERFACE
+SUBROUTINE SRTM_TAUMOL29&
+ & ( KIDIA , KFDIA , KLEV,&
+ & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
+ & K_JP , K_JT , K_JT1,&
+ & P_COLH2O , P_COLCO2 , P_COLMOL,&
+ & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF , P_FORFAC, P_FORFRAC, K_INDFOR,&
+ & P_SFLUXZEN, P_TAUG , P_TAUR , PRMU0&
+ & ) 
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE PARSRTM , ONLY : JPG
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA, KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(KIDIA:KFDIA,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(KIDIA:KFDIA,KLEV,JPG)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KIDIA:KFDIA)
+END SUBROUTINE SRTM_TAUMOL29
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/surdi.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/surdi.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/surdi.F90	(revision 3908)
@@ -0,0 +1,129 @@
+SUBROUTINE SURDI
+
+!**** *SURDI*   - INITIALIZE COMMON YOERDI CONTROLLING RADINT
+
+!     PURPOSE.
+!     --------
+!           INITIALIZE YOERDI, THE COMMON THAT CONTROLS THE
+!           RADIATION INTERFACE
+
+!**   INTERFACE.
+!     ----------
+!        CALL *SURDI* FROM *SURAD*
+!              -----        -----
+
+!        EXPLICIT ARGUMENTS :
+!        --------------------
+!        NONE
+
+!        IMPLICIT ARGUMENTS :
+!        --------------------
+!        COMMON YOERDI
+
+!     METHOD.
+!     -------
+!        SEE DOCUMENTATION
+
+!     EXTERNALS.
+!     ----------
+!        NONE
+
+!     REFERENCE.
+!     ----------
+!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS MODEL
+
+!     AUTHOR.
+!     -------
+!      Original  JEAN-JACQUES MORCRETTE  *ECMWF*
+!      ORIGINAL : 88-12-15
+
+!     MODIFICATIONS.
+!     --------------
+!      M.Hamrud      01-Oct-2003 CY28 Cleaning
+!      Modified   P. Viterbo   24-05-2004  surf library
+!      JJMorcrette   2004-10-07 Gas concentrations
+!     ------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE YOERDI   , ONLY : RRAE     ,&
+ & RCARDI   ,RCH4     ,RN2O     ,RNO2     ,RO3      ,&
+ & RCFC11   ,RCFC12   ,RCFC22   ,RCCL4    ,&
+ & REPCLC   ,REPH2O   ,RSUNDUR  ,&
+ & RCCO2    ,RCCH4    ,RCN2O    ,RCNO2    ,RCCFC11  ,&
+ & RCCFC12  ,RCCFC22  ,RCCCL4
+USE YOMDYNCORE, ONLY : LAQUA
+
+IMPLICIT NONE
+
+REAL(KIND=JPRB) :: ZAIRMWG, ZC11MWG, ZC12MWG, ZCH4MWG, ZCO2MWG,&
+ & ZN2OMWG, ZNO2MWG, ZO3MWG, ZC22MWG, ZCL4MWG
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+!      ----------------------------------------------------------------
+
+!*       1.    SET DEFAULT VALUES.
+!              -------------------
+
+IF (LHOOK) CALL DR_HOOK('SURDI',0,ZHOOK_HANDLE)
+RRAE = 0.1277E-02_JPRB
+
+!* Threshold for computing sunshine duration (W/m2)
+RSUNDUR=120._JPRB
+
+!*  For sea ice, monthly values are based on Ebert and Curry, 1993, Table 2.
+!   We take dry snow albedo as the representative value for non-summer
+!   months, and bare sea-ice as the representative value for summer
+!   months. The values for Antarctic are shifted six-months.
+! All computations brought back to *SUSWN*
+
+!*  Concentration of the various trace gases (IPCC/SACC values for 1990)
+!        CO2         CH4        N2O        CFC11       CFC12
+!      353ppmv     1.72ppmv   310ppbv     280pptv     484pptv
+
+ZAIRMWG = 28.970_JPRB
+ZCO2MWG = 44.011_JPRB
+ZCH4MWG = 16.043_JPRB
+ZN2OMWG = 44.013_JPRB
+ZNO2MWG = 46.006_JPRB
+ZO3MWG  = 47.9982_JPRB
+ZC11MWG = 137.3686_JPRB
+ZC12MWG = 120.9140_JPRB
+ZC22MWG =  86.4690_JPRB
+ZCL4MWG = 153.8230_JPRB
+
+!RCARDI  = 353.E-06_JPRB*ZCO2MWG/ZAIRMWG
+!RCH4    = 1.72E-06_JPRB*ZCH4MWG/ZAIRMWG
+!RN2O    = 310.E-09_JPRB*ZN2OMWG/ZAIRMWG
+!RNO2    = 500.E-13_JPRB*ZNO2MWG/ZAIRMWG
+!RO3     =   1.E-06_JPRB*ZO3MWG /ZAIRMWG
+!RCFC11  = 280.E-12_JPRB*ZC11MWG/ZAIRMWG
+!RCFC12  = 484.E-12_JPRB*ZC12MWG/ZAIRMWG
+!RCFC22  =   1.E-12_JPRB*ZC22MWG/ZAIRMWG
+!RCCL4   =   1.E-12_JPRB*ZCL4MWG/ZAIRMWG
+
+IF( LAQUA ) THEN
+  RCARDI  = 348.E-06_JPRB*ZCO2MWG/ZAIRMWG
+  RCH4    = 1.65E-06_JPRB*ZCH4MWG/ZAIRMWG
+  RN2O    = 306.E-09_JPRB*ZN2OMWG/ZAIRMWG
+ELSE
+  RCARDI  = RCCO2   * ZCO2MWG/ZAIRMWG
+  RCH4    = RCCH4   * ZCH4MWG/ZAIRMWG
+  RN2O    = RCN2O   * ZN2OMWG/ZAIRMWG
+ENDIF
+
+RNO2    = RCNO2   * ZNO2MWG/ZAIRMWG 
+RO3     = 1.E-06_JPRB*ZO3MWG /ZAIRMWG
+RCFC11  = RCCFC11 * ZC11MWG/ZAIRMWG
+RCFC12  = RCCFC12 * ZC12MWG/ZAIRMWG
+RCFC22  = RCCFC22 * ZC22MWG/ZAIRMWG
+RCCL4   = RCCCL4  * ZCL4MWG/ZAIRMWG
+
+REPCLC=1.E-12_JPRB
+REPH2O=1.E-12_JPRB
+
+!     -----------------------------------------------------------------
+
+IF (LHOOK) CALL DR_HOOK('SURDI',1,ZHOOK_HANDLE)
+END SUBROUTINE SURDI
Index: LMDZ6/trunk/libf/phylmd/ecrad/surdi.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/surdi.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/surdi.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SURDI
+END SUBROUTINE SURDI
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/surrtab.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/surrtab.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/surrtab.F90	(revision 3908)
@@ -0,0 +1,35 @@
+SUBROUTINE SURRTAB
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** AER'S RRTM LW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!     -----------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE YOERRTAB , ONLY : TRANS, BPADE
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM) :: ITR
+
+REAL(KIND=JPRB) :: ZTAU, ZTFN
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+IF (LHOOK) CALL DR_HOOK('SURRTAB',0,ZHOOK_HANDLE)
+BPADE=1.0_JPRB/0.278_JPRB
+TRANS(0)   =1.0_JPRB
+TRANS(5000)=0.0_JPRB
+DO ITR=1,4999
+  ZTFN=REAL(ITR)/5000._JPRB
+  ZTAU=BPADE*ZTFN/(1.0_JPRB-ZTFN)
+  TRANS(ITR)=EXP(-ZTAU)
+ENDDO
+
+!     -----------------------------------------------------------------
+
+IF (LHOOK) CALL DR_HOOK('SURRTAB',1,ZHOOK_HANDLE)
+END SUBROUTINE SURRTAB
Index: LMDZ6/trunk/libf/phylmd/ecrad/surrtab.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/surrtab.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/surrtab.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SURRTAB
+END SUBROUTINE SURRTAB
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/surrtftr.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/surrtftr.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/surrtftr.F90	(revision 3908)
@@ -0,0 +1,279 @@
+SUBROUTINE SURRTFTR
+
+!     Adapted from Eli J. Mlawer, Atmospheric & Environmental Research.
+!     by JJMorcrette, ECMWF
+!
+!     JJMorcrette 20110613 flexible number of g-points
+!     ABozzo 201306 updated to rrtmg v4.85
+!
+!     ------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM ,   JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+!USE PARRRTM   ,ONLY : JPBAND  ,JPG
+USE YOERRTFTR ,ONLY : NGC     ,NGS      ,NGN      ,NGB       ,NGM     , WT
+!USE YOERAD    ,ONLY : NREDGLW
+USE YOERRTM   ,ONLY : JPGPT
+!USE YOERRTM   ,ONLY : JPGPT, &
+!                    & NG1 , NG2 , NG3 , NG4 , NG5 , NG6 , NG7 , NG8 ,&
+!                    & NG9 , NG10, NG11, NG12, NG13, NG14, NG15, NG16,&
+!                    & NGS1, NGS2, NGS3, NGS4, NGS5, NGS6, NGS7, NGS8,&
+!                    & NGS9, NGS10,NGS11,NGS12,NGS13,NGS14,NGS15,NGS16
+!
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+
+!INTEGER(KIND=JPIM) :: KGC(16), KGS(16), KGM(256), KGN(JPGPT), KGB(JPGPT)
+!!INTEGER(KIND=JPIM) :: KGC(JPG), KGS(JPG), KGM(JPG*JPBAND), KGN(JPGPT), KGB(JPGPT)
+
+INTEGER(KIND=JPIM) :: IGC70(16) , IGC140(16) , IGC256(16)
+INTEGER(KIND=JPIM) :: IGS70(16) , IGS140(16) , IGS256(16)
+
+INTEGER(KIND=JPIM) :: IGM70(256), IGM140(256), IGM256(256)
+
+INTEGER(KIND=JPIM) :: IGN70(70) , IGN140(140), IGN256(256)
+INTEGER(KIND=JPIM) :: IGB70(70) , IGB140(140), IGB256(256)
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('SURRTFTR',0,ZHOOK_HANDLE)
+
+!-------------------------------------------------------------------------------
+!-- configuration for EPS with 70 g-points
+
+IGC70( :) = (/4,  7,  8,  7,  8, 4,  6, 4,  6, 3, 4, 4, 2, 1, 1, 1 /)
+
+IGS70(:) = (/  4, 11,  19,  26,  34,  38,  44,  48, &
+            & 54, 57,  61,  65,  67,  68,  69,  70 /)
+   
+IGM70(:) = (/&
+ & 1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,             &! Band 1
+ & 1,1,2,2,3,3,4,4,5,5,6,6,7,7,7,7,             &! Band 2
+ & 1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,             &! Band 3
+ & 1,1,2,2,3,3,4,4,5,5,6,6,7,7,7,7,             &! Band 4
+ & 1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,             &! Band 5
+ & 1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,             &! Band 6
+ & 1,1,1,1,2,2,3,3,4,4,5,5,6,6,6,6,             &! Band 7
+ & 1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,             &! Band 8
+ & 1,1,2,2,3,3,4,4,5,5,5,5,6,6,6,6,             &! Band 9
+ & 1,1,1,1,2,2,2,2,3,3,3,3,3,3,3,3,             &! Band 10
+ & 1,1,2,2,2,2,3,3,3,3,4,4,4,4,4,4,             &! Band 11
+ & 1,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4,             &! Band 12
+ & 1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,             &! Band 13
+ & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,             &! Band 14
+ & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,             &! Band 15
+ & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1/)             ! Band 16  
+
+IGN70(:) = (/&
+ & 4,4,4,4,                                     &! Band 1
+ & 2,2,2,2,2,2,4,                               &! Band 2
+ & 2,2,2,2,2,2,2,2,                             &! Band 3
+ & 2,2,2,2,2,2,4,                               &! Band 4
+ & 2,2,2,2,2,2,2,2,                             &! Band 5
+ & 4,4,4,4,                                     &! Band 6
+ & 4,2,2,2,2,4,                                 &! Band 7
+ & 4,4,4,4,                                     &! Band 8
+ & 2,2,2,2,4,4,                                 &! Band 9
+ & 4,4,8,                                       &! Band 10
+ & 2,4,4,6,                                     &! Band 11
+ & 2,2,4,8,                                     &! Band 12
+ & 6,10,                                        &! Band 13
+ & 16,                                          &! Band 14
+ & 16,                                          &! Band 15
+ & 16/)                                          ! Band 16  
+
+IGB70(:) = (/&
+ & 1,1,1,1,                                      &! Band 1
+ & 2,2,2,2,2,2,2,                                &! Band 2
+ & 3,3,3,3,3,3,3,3,                              &! Band 3
+ & 4,4,4,4,4,4,4,                                &! Band 4
+ & 5,5,5,5,5,5,5,5,                              &! Band 5
+ & 6,6,6,6,                                      &! Band 6
+ & 7,7,7,7,7,7,                                  &! Band 7
+ & 8,8,8,8,                                      &! Band 8
+ & 9,9,9,9,9,9,                                  &! Band 9
+ & 10,10,10,                                     &! Band 10
+ & 11,11,11,11,                                  &! Band 11
+ & 12,12,12,12,                                  &! Band 12
+ & 13,13,                                        &! Band 13
+ & 14,                                           &! Band 14
+ & 15,                                           &! Band 15
+ & 16/)                                           ! Band 16  
+
+
+!------------------------------------------------------------------------------
+!-- configuration with 140 g-points
+
+IGC140(:) = (/10, 12, 16, 14, 16, 8, 12, 8, 12, 6, 8, 8, 4, 2, 2, 2 /)
+
+IGS140(:) = (/  10,  22,  38,  52,  68,  76,  88,  96, &
+            & 108, 114, 122, 130, 134, 136, 138, 140 /)  
+
+IGM140(:) = (/&
+ & 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  
+
+IGN140(:) = (/&
+ & 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  
+
+IGB140( :) = (/&
+ & 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  
+
+
+
+!------------------------------------------------------------------------------
+!-- configuration with 256 g-points
+
+IGC256(:) = (/16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16 /)
+
+IGS256(:) = (/ 16,  32,  48,  64,  80,  96, 112, 128, &
+            & 144, 160, 176, 192, 208, 224, 240, 256 /)  
+
+IGM256(:) = (/&
+ & 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,      &! Band 1
+ & 1,2,3,4,5,6,7,8,9,10,11,12,13,13,14,14,      &! 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,15,16,      &! Band 4
+ & 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,      &! Band 5
+ & 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,      &! Band 6
+ & 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,      &! Band 7
+ & 1,2,3,4,5,6,7,8,9,10,11,12,13,13,14,14,      &! Band 8
+ & 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,      &! Band 9
+ & 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,      &! Band 10
+ & 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,      &! Band 11
+ & 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,      &! Band 12
+ & 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,      &! Band 13
+ & 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,      &! Band 14
+ & 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,      &! Band 15
+ & 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16 /)     ! Band 16
+
+IGN256(:) = (/&
+ & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,             &! Band 1
+ & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,             &! 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,1,1,1,             &! Band 4
+ & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,             &! Band 5
+ & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,             &! Band 6
+ & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,             &! Band 7
+ & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,             &! Band 8
+ & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,             &! Band 9
+ & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,             &! Band 10
+ & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,             &! Band 11
+ & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,             &! Band 12
+ & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,             &! Band 13
+ & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,             &! Band 14
+ & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,             &! Band 15
+ & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 /)            ! Band 16
+
+IGB256( :) = (/&
+ & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,             &! Band 1
+ & 2,2,2,2,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,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,6,6,6,6,6,6,6,6,             &! Band 6
+ & 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,             &! Band 7
+ & 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,             &! Band 8
+ & 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,             &! Band 9
+ & 10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10, &! Band 10
+ & 11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11, &! Band 11
+ & 12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12, &! Band 12
+ & 13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13, &! Band 13
+ & 14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14, &! Band 14
+ & 15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15, &! Band 15
+ & 16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16/) ! Band 16  
+
+!-------------------------------------------------------------------------------
+!
+WT( :) = (/&
+ & 0.1527534276_JPRB,0.1491729617_JPRB,0.1420961469_JPRB,0.1316886544_JPRB,&
+ & 0.1181945205_JPRB,0.1019300893_JPRB,0.0832767040_JPRB,0.0626720116_JPRB,&
+ & 0.0424925_JPRB   ,0.0046269894_JPRB,0.0038279891_JPRB,0.0030260086_JPRB,&
+ & 0.0022199750_JPRB,0.0014140010_JPRB,0.000533_JPRB    ,0.000075_JPRB    /)  
+
+!-------------------------------------------------------------------------------
+
+IF (JPGPT == 70) THEN
+
+!-- 16
+  NGC(:)=IGC70(:)
+  NGS(:)=IGS70(:)
+
+!-- 16*16=256
+  NGM(:)=IGM70(:)
+
+  NGN(1:70)=IGN70(1:70)
+  NGB(1:70)=IGB70(1:70)
+
+ELSEIF (JPGPT == 140) THEN
+!- 16
+  NGC(:)=IGC140(:)
+  NGS(:)=IGS140(:)
+
+!- 16*16=256
+  NGM(:)=IGM140(:)
+
+  NGN(1:140)=IGN140(1:140)
+  NGB(1:140)=IGB140(1:140)
+
+ELSEIF (JPGPT == 256) THEN
+!- 16
+  NGC(:)=IGC256(:)
+  NGS(:)=IGS256(:)
+
+!- 16*16=256
+  NGM(:)=IGM256(:)
+
+  NGN(1:256)=IGN256(1:256)
+  NGB(1:256)=IGB256(1:256)
+
+ENDIF
+   
+!     -----------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SURRTFTR',1,ZHOOK_HANDLE)
+END SUBROUTINE SURRTFTR
Index: LMDZ6/trunk/libf/phylmd/ecrad/surrtftr.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/surrtftr.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/surrtftr.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SURRTFTR
+END SUBROUTINE SURRTFTR
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/surrtpk.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/surrtpk.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/surrtpk.F90	(revision 3908)
@@ -0,0 +1,668 @@
+SUBROUTINE SURRTPK
+
+!     Adapted from Eli J. Mlawer, Atmospheric & Environmental Research.
+!     by JJMorcrette, ECMWF
+!     ABozzo 201306 updated to rrtmg v4.85
+!     changes in nspa (band 3 from 10 to 9 and band 9 from 11 to 9)
+!     changes in nspb (band 4 from 6 to 5)
+!     ------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE YOERRTWN , ONLY : NG        ,NSPA      ,NSPB      ,&
+ & DELWAVE    , TOTPLNK  !       ,WAVENUM1  ,WAVENUM2 
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('SURRTPK',0,ZHOOK_HANDLE)
+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/)
+!WAVENUM1( :) = (/&
+! & 10._JPRB, 250._JPRB, 500._JPRB, 630._JPRB, 700._JPRB, 820._JPRB, 980._JPRB,1080._JPRB &
+! & ,1180._JPRB,1390._JPRB,1480._JPRB,1800._JPRB,2080._JPRB,2250._JPRB,2380._JPRB,2600._JPRB/)  
+!WAVENUM2( :) = (/&
+! & 250._JPRB, 500._JPRB, 630._JPRB, 700._JPRB, 820._JPRB, 980._JPRB,1080._JPRB,1180._JPRB &
+! & ,1390._JPRB,1480._JPRB,1800._JPRB,2080._JPRB,2250._JPRB,2380._JPRB,2600._JPRB,3000._JPRB/)  
+DELWAVE( :) = (/&
+ & 340._JPRB, 150._JPRB, 130._JPRB,  70._JPRB, 120._JPRB, 160._JPRB, 100._JPRB, 100._JPRB &
+ & , 210._JPRB,  90._JPRB, 320._JPRB, 280._JPRB, 170._JPRB, 130._JPRB, 220._JPRB, 650._JPRB/)  
+
+TOTPLNK(1:50,  1) = (/ &
+   &  0.14783E-05_JPRB,0.15006E-05_JPRB,0.15230E-05_JPRB,0.15455E-05_JPRB,0.15681E-05_JPRB, &
+   &  0.15908E-05_JPRB,0.16136E-05_JPRB,0.16365E-05_JPRB,0.16595E-05_JPRB,0.16826E-05_JPRB, &
+   &  0.17059E-05_JPRB,0.17292E-05_JPRB,0.17526E-05_JPRB,0.17762E-05_JPRB,0.17998E-05_JPRB, &
+   &  0.18235E-05_JPRB,0.18473E-05_JPRB,0.18712E-05_JPRB,0.18953E-05_JPRB,0.19194E-05_JPRB, &
+   &  0.19435E-05_JPRB,0.19678E-05_JPRB,0.19922E-05_JPRB,0.20166E-05_JPRB,0.20412E-05_JPRB, &
+   &  0.20658E-05_JPRB,0.20905E-05_JPRB,0.21153E-05_JPRB,0.21402E-05_JPRB,0.21652E-05_JPRB, &
+   &  0.21902E-05_JPRB,0.22154E-05_JPRB,0.22406E-05_JPRB,0.22659E-05_JPRB,0.22912E-05_JPRB, &
+   &  0.23167E-05_JPRB,0.23422E-05_JPRB,0.23678E-05_JPRB,0.23934E-05_JPRB,0.24192E-05_JPRB, &
+   &  0.24450E-05_JPRB,0.24709E-05_JPRB,0.24968E-05_JPRB,0.25229E-05_JPRB,0.25490E-05_JPRB, &
+   &  0.25751E-05_JPRB,0.26014E-05_JPRB,0.26277E-05_JPRB,0.26540E-05_JPRB,0.26805E-05_JPRB/)
+TOTPLNK(51:100,  1) = (/ &
+   &  0.27070E-05_JPRB,0.27335E-05_JPRB,0.27602E-05_JPRB,0.27869E-05_JPRB,0.28136E-05_JPRB, &
+   &  0.28404E-05_JPRB,0.28673E-05_JPRB,0.28943E-05_JPRB,0.29213E-05_JPRB,0.29483E-05_JPRB, &
+   &  0.29754E-05_JPRB,0.30026E-05_JPRB,0.30298E-05_JPRB,0.30571E-05_JPRB,0.30845E-05_JPRB, &
+   &  0.31119E-05_JPRB,0.31393E-05_JPRB,0.31669E-05_JPRB,0.31944E-05_JPRB,0.32220E-05_JPRB, &
+   &  0.32497E-05_JPRB,0.32774E-05_JPRB,0.33052E-05_JPRB,0.33330E-05_JPRB,0.33609E-05_JPRB, &
+   &  0.33888E-05_JPRB,0.34168E-05_JPRB,0.34448E-05_JPRB,0.34729E-05_JPRB,0.35010E-05_JPRB, &
+   &  0.35292E-05_JPRB,0.35574E-05_JPRB,0.35857E-05_JPRB,0.36140E-05_JPRB,0.36424E-05_JPRB, &
+   &  0.36708E-05_JPRB,0.36992E-05_JPRB,0.37277E-05_JPRB,0.37563E-05_JPRB,0.37848E-05_JPRB, &
+   &  0.38135E-05_JPRB,0.38421E-05_JPRB,0.38708E-05_JPRB,0.38996E-05_JPRB,0.39284E-05_JPRB, &
+   &  0.39572E-05_JPRB,0.39861E-05_JPRB,0.40150E-05_JPRB,0.40440E-05_JPRB,0.40730E-05_JPRB/)
+TOTPLNK(101:150,  1) = (/ &
+   &  0.41020E-05_JPRB,0.41311E-05_JPRB,0.41602E-05_JPRB,0.41893E-05_JPRB,0.42185E-05_JPRB, &
+   &  0.42477E-05_JPRB,0.42770E-05_JPRB,0.43063E-05_JPRB,0.43356E-05_JPRB,0.43650E-05_JPRB, &
+   &  0.43944E-05_JPRB,0.44238E-05_JPRB,0.44533E-05_JPRB,0.44828E-05_JPRB,0.45124E-05_JPRB, &
+   &  0.45419E-05_JPRB,0.45715E-05_JPRB,0.46012E-05_JPRB,0.46309E-05_JPRB,0.46606E-05_JPRB, &
+   &  0.46903E-05_JPRB,0.47201E-05_JPRB,0.47499E-05_JPRB,0.47797E-05_JPRB,0.48096E-05_JPRB, &
+   &  0.48395E-05_JPRB,0.48695E-05_JPRB,0.48994E-05_JPRB,0.49294E-05_JPRB,0.49594E-05_JPRB, &
+   &  0.49895E-05_JPRB,0.50196E-05_JPRB,0.50497E-05_JPRB,0.50798E-05_JPRB,0.51100E-05_JPRB, &
+   &  0.51402E-05_JPRB,0.51704E-05_JPRB,0.52007E-05_JPRB,0.52309E-05_JPRB,0.52612E-05_JPRB, &
+   &  0.52916E-05_JPRB,0.53219E-05_JPRB,0.53523E-05_JPRB,0.53827E-05_JPRB,0.54132E-05_JPRB, &
+   &  0.54436E-05_JPRB,0.54741E-05_JPRB,0.55047E-05_JPRB,0.55352E-05_JPRB,0.55658E-05_JPRB/)
+TOTPLNK(151:181,  1) = (/ &
+   &  0.55964E-05_JPRB,0.56270E-05_JPRB,0.56576E-05_JPRB,0.56883E-05_JPRB,0.57190E-05_JPRB, &
+   &  0.57497E-05_JPRB,0.57804E-05_JPRB,0.58112E-05_JPRB,0.58420E-05_JPRB,0.58728E-05_JPRB, &
+   &  0.59036E-05_JPRB,0.59345E-05_JPRB,0.59653E-05_JPRB,0.59962E-05_JPRB,0.60272E-05_JPRB, &
+   &  0.60581E-05_JPRB,0.60891E-05_JPRB,0.61201E-05_JPRB,0.61511E-05_JPRB,0.61821E-05_JPRB, &
+   &  0.62131E-05_JPRB,0.62442E-05_JPRB,0.62753E-05_JPRB,0.63064E-05_JPRB,0.63376E-05_JPRB, &
+   &  0.63687E-05_JPRB,0.63998E-05_JPRB,0.64310E-05_JPRB,0.64622E-05_JPRB,0.64935E-05_JPRB, &
+   &  0.65247E-05_JPRB/)
+TOTPLNK(1:50,  2) = (/ &
+   &  0.20262E-05_JPRB,0.20757E-05_JPRB,0.21257E-05_JPRB,0.21763E-05_JPRB,0.22276E-05_JPRB, &
+   &  0.22794E-05_JPRB,0.23319E-05_JPRB,0.23849E-05_JPRB,0.24386E-05_JPRB,0.24928E-05_JPRB, &
+   &  0.25477E-05_JPRB,0.26031E-05_JPRB,0.26591E-05_JPRB,0.27157E-05_JPRB,0.27728E-05_JPRB, &
+   &  0.28306E-05_JPRB,0.28889E-05_JPRB,0.29478E-05_JPRB,0.30073E-05_JPRB,0.30673E-05_JPRB, &
+   &  0.31279E-05_JPRB,0.31890E-05_JPRB,0.32507E-05_JPRB,0.33129E-05_JPRB,0.33757E-05_JPRB, &
+   &  0.34391E-05_JPRB,0.35029E-05_JPRB,0.35674E-05_JPRB,0.36323E-05_JPRB,0.36978E-05_JPRB, &
+   &  0.37638E-05_JPRB,0.38304E-05_JPRB,0.38974E-05_JPRB,0.39650E-05_JPRB,0.40331E-05_JPRB, &
+   &  0.41017E-05_JPRB,0.41708E-05_JPRB,0.42405E-05_JPRB,0.43106E-05_JPRB,0.43812E-05_JPRB, &
+   &  0.44524E-05_JPRB,0.45240E-05_JPRB,0.45961E-05_JPRB,0.46687E-05_JPRB,0.47418E-05_JPRB, &
+   &  0.48153E-05_JPRB,0.48894E-05_JPRB,0.49639E-05_JPRB,0.50389E-05_JPRB,0.51143E-05_JPRB/)
+TOTPLNK(51:100,  2) = (/ &
+   &  0.51902E-05_JPRB,0.52666E-05_JPRB,0.53434E-05_JPRB,0.54207E-05_JPRB,0.54985E-05_JPRB, &
+   &  0.55767E-05_JPRB,0.56553E-05_JPRB,0.57343E-05_JPRB,0.58139E-05_JPRB,0.58938E-05_JPRB, &
+   &  0.59742E-05_JPRB,0.60550E-05_JPRB,0.61362E-05_JPRB,0.62179E-05_JPRB,0.63000E-05_JPRB, &
+   &  0.63825E-05_JPRB,0.64654E-05_JPRB,0.65487E-05_JPRB,0.66324E-05_JPRB,0.67166E-05_JPRB, &
+   &  0.68011E-05_JPRB,0.68860E-05_JPRB,0.69714E-05_JPRB,0.70571E-05_JPRB,0.71432E-05_JPRB, &
+   &  0.72297E-05_JPRB,0.73166E-05_JPRB,0.74039E-05_JPRB,0.74915E-05_JPRB,0.75796E-05_JPRB, &
+   &  0.76680E-05_JPRB,0.77567E-05_JPRB,0.78459E-05_JPRB,0.79354E-05_JPRB,0.80252E-05_JPRB, &
+   &  0.81155E-05_JPRB,0.82061E-05_JPRB,0.82970E-05_JPRB,0.83883E-05_JPRB,0.84799E-05_JPRB, &
+   &  0.85719E-05_JPRB,0.86643E-05_JPRB,0.87569E-05_JPRB,0.88499E-05_JPRB,0.89433E-05_JPRB, &
+   &  0.90370E-05_JPRB,0.91310E-05_JPRB,0.92254E-05_JPRB,0.93200E-05_JPRB,0.94150E-05_JPRB/)
+TOTPLNK(101:150,  2) = (/ &
+   &  0.95104E-05_JPRB,0.96060E-05_JPRB,0.97020E-05_JPRB,0.97982E-05_JPRB,0.98948E-05_JPRB, &
+   &  0.99917E-05_JPRB,0.10089E-04_JPRB,0.10186E-04_JPRB,0.10284E-04_JPRB,0.10382E-04_JPRB, &
+   &  0.10481E-04_JPRB,0.10580E-04_JPRB,0.10679E-04_JPRB,0.10778E-04_JPRB,0.10877E-04_JPRB, &
+   &  0.10977E-04_JPRB,0.11077E-04_JPRB,0.11178E-04_JPRB,0.11279E-04_JPRB,0.11380E-04_JPRB, &
+   &  0.11481E-04_JPRB,0.11583E-04_JPRB,0.11684E-04_JPRB,0.11786E-04_JPRB,0.11889E-04_JPRB, &
+   &  0.11992E-04_JPRB,0.12094E-04_JPRB,0.12198E-04_JPRB,0.12301E-04_JPRB,0.12405E-04_JPRB, &
+   &  0.12509E-04_JPRB,0.12613E-04_JPRB,0.12717E-04_JPRB,0.12822E-04_JPRB,0.12927E-04_JPRB, &
+   &  0.13032E-04_JPRB,0.13138E-04_JPRB,0.13244E-04_JPRB,0.13349E-04_JPRB,0.13456E-04_JPRB, &
+   &  0.13562E-04_JPRB,0.13669E-04_JPRB,0.13776E-04_JPRB,0.13883E-04_JPRB,0.13990E-04_JPRB, &
+   &  0.14098E-04_JPRB,0.14206E-04_JPRB,0.14314E-04_JPRB,0.14422E-04_JPRB,0.14531E-04_JPRB/)
+TOTPLNK(151:181,  2) = (/ &
+   &  0.14639E-04_JPRB,0.14748E-04_JPRB,0.14857E-04_JPRB,0.14967E-04_JPRB,0.15076E-04_JPRB, &
+   &  0.15186E-04_JPRB,0.15296E-04_JPRB,0.15407E-04_JPRB,0.15517E-04_JPRB,0.15628E-04_JPRB, &
+   &  0.15739E-04_JPRB,0.15850E-04_JPRB,0.15961E-04_JPRB,0.16072E-04_JPRB,0.16184E-04_JPRB, &
+   &  0.16296E-04_JPRB,0.16408E-04_JPRB,0.16521E-04_JPRB,0.16633E-04_JPRB,0.16746E-04_JPRB, &
+   &  0.16859E-04_JPRB,0.16972E-04_JPRB,0.17085E-04_JPRB,0.17198E-04_JPRB,0.17312E-04_JPRB, &
+   &  0.17426E-04_JPRB,0.17540E-04_JPRB,0.17654E-04_JPRB,0.17769E-04_JPRB,0.17883E-04_JPRB, &
+   &  0.17998E-04_JPRB/)
+
+TOTPLNK( :, 3) = (/&
+ & 1.34822E-06_JPRB,1.39134E-06_JPRB,1.43530E-06_JPRB,1.48010E-06_JPRB,1.52574E-06_JPRB,&
+ & 1.57222E-06_JPRB,1.61956E-06_JPRB,1.66774E-06_JPRB,1.71678E-06_JPRB,1.76666E-06_JPRB,&
+ & 1.81741E-06_JPRB,1.86901E-06_JPRB,1.92147E-06_JPRB,1.97479E-06_JPRB,2.02898E-06_JPRB,&
+ & 2.08402E-06_JPRB,2.13993E-06_JPRB,2.19671E-06_JPRB,2.25435E-06_JPRB,2.31285E-06_JPRB,&
+ & 2.37222E-06_JPRB,2.43246E-06_JPRB,2.49356E-06_JPRB,2.55553E-06_JPRB,2.61837E-06_JPRB,&
+ & 2.68207E-06_JPRB,2.74664E-06_JPRB,2.81207E-06_JPRB,2.87837E-06_JPRB,2.94554E-06_JPRB,&
+ & 3.01356E-06_JPRB,3.08245E-06_JPRB,3.15221E-06_JPRB,3.22282E-06_JPRB,3.29429E-06_JPRB,&
+ & 3.36662E-06_JPRB,3.43982E-06_JPRB,3.51386E-06_JPRB,3.58876E-06_JPRB,3.66451E-06_JPRB,&
+ & 3.74112E-06_JPRB,3.81857E-06_JPRB,3.89688E-06_JPRB,3.97602E-06_JPRB,4.05601E-06_JPRB,&
+ & 4.13685E-06_JPRB,4.21852E-06_JPRB,4.30104E-06_JPRB,4.38438E-06_JPRB,4.46857E-06_JPRB,&
+ & 4.55358E-06_JPRB,4.63943E-06_JPRB,4.72610E-06_JPRB,4.81359E-06_JPRB,4.90191E-06_JPRB,&
+ & 4.99105E-06_JPRB,5.08100E-06_JPRB,5.17176E-06_JPRB,5.26335E-06_JPRB,5.35573E-06_JPRB,&
+ & 5.44892E-06_JPRB,5.54292E-06_JPRB,5.63772E-06_JPRB,5.73331E-06_JPRB,5.82970E-06_JPRB,&
+ & 5.92688E-06_JPRB,6.02485E-06_JPRB,6.12360E-06_JPRB,6.22314E-06_JPRB,6.32346E-06_JPRB,&
+ & 6.42455E-06_JPRB,6.52641E-06_JPRB,6.62906E-06_JPRB,6.73247E-06_JPRB,6.83664E-06_JPRB,&
+ & 6.94156E-06_JPRB,7.04725E-06_JPRB,7.15370E-06_JPRB,7.26089E-06_JPRB,7.36883E-06_JPRB,&
+ & 7.47752E-06_JPRB,7.58695E-06_JPRB,7.69712E-06_JPRB,7.80801E-06_JPRB,7.91965E-06_JPRB,&
+ & 8.03201E-06_JPRB,8.14510E-06_JPRB,8.25891E-06_JPRB,8.37343E-06_JPRB,8.48867E-06_JPRB,&
+ & 8.60463E-06_JPRB,8.72128E-06_JPRB,8.83865E-06_JPRB,8.95672E-06_JPRB,9.07548E-06_JPRB,&
+ & 9.19495E-06_JPRB,9.31510E-06_JPRB,9.43594E-06_JPRB,9.55745E-06_JPRB,9.67966E-06_JPRB,&
+ & 9.80254E-06_JPRB,9.92609E-06_JPRB,1.00503E-05_JPRB,1.01752E-05_JPRB,1.03008E-05_JPRB,&
+ & 1.04270E-05_JPRB,1.05539E-05_JPRB,1.06814E-05_JPRB,1.08096E-05_JPRB,1.09384E-05_JPRB,&
+ & 1.10679E-05_JPRB,1.11980E-05_JPRB,1.13288E-05_JPRB,1.14601E-05_JPRB,1.15922E-05_JPRB,&
+ & 1.17248E-05_JPRB,1.18581E-05_JPRB,1.19920E-05_JPRB,1.21265E-05_JPRB,1.22616E-05_JPRB,&
+ & 1.23973E-05_JPRB,1.25337E-05_JPRB,1.26706E-05_JPRB,1.28081E-05_JPRB,1.29463E-05_JPRB,&
+ & 1.30850E-05_JPRB,1.32243E-05_JPRB,1.33642E-05_JPRB,1.35047E-05_JPRB,1.36458E-05_JPRB,&
+ & 1.37875E-05_JPRB,1.39297E-05_JPRB,1.40725E-05_JPRB,1.42159E-05_JPRB,1.43598E-05_JPRB,&
+ & 1.45044E-05_JPRB,1.46494E-05_JPRB,1.47950E-05_JPRB,1.49412E-05_JPRB,1.50879E-05_JPRB,&
+ & 1.52352E-05_JPRB,1.53830E-05_JPRB,1.55314E-05_JPRB,1.56803E-05_JPRB,1.58297E-05_JPRB,&
+ & 1.59797E-05_JPRB,1.61302E-05_JPRB,1.62812E-05_JPRB,1.64327E-05_JPRB,1.65848E-05_JPRB,&
+ & 1.67374E-05_JPRB,1.68904E-05_JPRB,1.70441E-05_JPRB,1.71982E-05_JPRB,1.73528E-05_JPRB,&
+ & 1.75079E-05_JPRB,1.76635E-05_JPRB,1.78197E-05_JPRB,1.79763E-05_JPRB,1.81334E-05_JPRB,&
+ & 1.82910E-05_JPRB,1.84491E-05_JPRB,1.86076E-05_JPRB,1.87667E-05_JPRB,1.89262E-05_JPRB,&
+ & 1.90862E-05_JPRB,1.92467E-05_JPRB,1.94076E-05_JPRB,1.95690E-05_JPRB,1.97309E-05_JPRB,&
+ & 1.98932E-05_JPRB,2.00560E-05_JPRB,2.02193E-05_JPRB,2.03830E-05_JPRB,2.05472E-05_JPRB,&
+ & 2.07118E-05_JPRB,2.08768E-05_JPRB,2.10423E-05_JPRB,2.12083E-05_JPRB,2.13747E-05_JPRB,&
+ & 2.15414E-05_JPRB/)  
+
+TOTPLNK( :, 4) = (/&
+ & 8.90528E-07_JPRB,9.24222E-07_JPRB,9.58757E-07_JPRB,9.94141E-07_JPRB,1.03038E-06_JPRB,&
+ & 1.06748E-06_JPRB,1.10545E-06_JPRB,1.14430E-06_JPRB,1.18403E-06_JPRB,1.22465E-06_JPRB,&
+ & 1.26618E-06_JPRB,1.30860E-06_JPRB,1.35193E-06_JPRB,1.39619E-06_JPRB,1.44136E-06_JPRB,&
+ & 1.48746E-06_JPRB,1.53449E-06_JPRB,1.58246E-06_JPRB,1.63138E-06_JPRB,1.68124E-06_JPRB,&
+ & 1.73206E-06_JPRB,1.78383E-06_JPRB,1.83657E-06_JPRB,1.89028E-06_JPRB,1.94495E-06_JPRB,&
+ & 2.00060E-06_JPRB,2.05724E-06_JPRB,2.11485E-06_JPRB,2.17344E-06_JPRB,2.23303E-06_JPRB,&
+ & 2.29361E-06_JPRB,2.35519E-06_JPRB,2.41777E-06_JPRB,2.48134E-06_JPRB,2.54592E-06_JPRB,&
+ & 2.61151E-06_JPRB,2.67810E-06_JPRB,2.74571E-06_JPRB,2.81433E-06_JPRB,2.88396E-06_JPRB,&
+ & 2.95461E-06_JPRB,3.02628E-06_JPRB,3.09896E-06_JPRB,3.17267E-06_JPRB,3.24741E-06_JPRB,&
+ & 3.32316E-06_JPRB,3.39994E-06_JPRB,3.47774E-06_JPRB,3.55657E-06_JPRB,3.63642E-06_JPRB,&
+ & 3.71731E-06_JPRB,3.79922E-06_JPRB,3.88216E-06_JPRB,3.96612E-06_JPRB,4.05112E-06_JPRB,&
+ & 4.13714E-06_JPRB,4.22419E-06_JPRB,4.31227E-06_JPRB,4.40137E-06_JPRB,4.49151E-06_JPRB,&
+ & 4.58266E-06_JPRB,4.67485E-06_JPRB,4.76806E-06_JPRB,4.86229E-06_JPRB,4.95754E-06_JPRB,&
+ & 5.05383E-06_JPRB,5.15113E-06_JPRB,5.24946E-06_JPRB,5.34879E-06_JPRB,5.44916E-06_JPRB,&
+ & 5.55053E-06_JPRB,5.65292E-06_JPRB,5.75632E-06_JPRB,5.86073E-06_JPRB,5.96616E-06_JPRB,&
+ & 6.07260E-06_JPRB,6.18003E-06_JPRB,6.28848E-06_JPRB,6.39794E-06_JPRB,6.50838E-06_JPRB,&
+ & 6.61983E-06_JPRB,6.73229E-06_JPRB,6.84573E-06_JPRB,6.96016E-06_JPRB,7.07559E-06_JPRB,&
+ & 7.19200E-06_JPRB,7.30940E-06_JPRB,7.42779E-06_JPRB,7.54715E-06_JPRB,7.66749E-06_JPRB,&
+ & 7.78882E-06_JPRB,7.91110E-06_JPRB,8.03436E-06_JPRB,8.15859E-06_JPRB,8.28379E-06_JPRB,&
+ & 8.40994E-06_JPRB,8.53706E-06_JPRB,8.66515E-06_JPRB,8.79418E-06_JPRB,8.92416E-06_JPRB,&
+ & 9.05510E-06_JPRB,9.18697E-06_JPRB,9.31979E-06_JPRB,9.45356E-06_JPRB,9.58826E-06_JPRB,&
+ & 9.72389E-06_JPRB,9.86046E-06_JPRB,9.99793E-06_JPRB,1.01364E-05_JPRB,1.02757E-05_JPRB,&
+ & 1.04159E-05_JPRB,1.05571E-05_JPRB,1.06992E-05_JPRB,1.08422E-05_JPRB,1.09861E-05_JPRB,&
+ & 1.11309E-05_JPRB,1.12766E-05_JPRB,1.14232E-05_JPRB,1.15707E-05_JPRB,1.17190E-05_JPRB,&
+ & 1.18683E-05_JPRB,1.20184E-05_JPRB,1.21695E-05_JPRB,1.23214E-05_JPRB,1.24741E-05_JPRB,&
+ & 1.26277E-05_JPRB,1.27822E-05_JPRB,1.29376E-05_JPRB,1.30939E-05_JPRB,1.32509E-05_JPRB,&
+ & 1.34088E-05_JPRB,1.35676E-05_JPRB,1.37273E-05_JPRB,1.38877E-05_JPRB,1.40490E-05_JPRB,&
+ & 1.42112E-05_JPRB,1.43742E-05_JPRB,1.45380E-05_JPRB,1.47026E-05_JPRB,1.48680E-05_JPRB,&
+ & 1.50343E-05_JPRB,1.52014E-05_JPRB,1.53692E-05_JPRB,1.55379E-05_JPRB,1.57074E-05_JPRB,&
+ & 1.58778E-05_JPRB,1.60488E-05_JPRB,1.62207E-05_JPRB,1.63934E-05_JPRB,1.65669E-05_JPRB,&
+ & 1.67411E-05_JPRB,1.69162E-05_JPRB,1.70920E-05_JPRB,1.72685E-05_JPRB,1.74459E-05_JPRB,&
+ & 1.76240E-05_JPRB,1.78029E-05_JPRB,1.79825E-05_JPRB,1.81629E-05_JPRB,1.83440E-05_JPRB,&
+ & 1.85259E-05_JPRB,1.87086E-05_JPRB,1.88919E-05_JPRB,1.90760E-05_JPRB,1.92609E-05_JPRB,&
+ & 1.94465E-05_JPRB,1.96327E-05_JPRB,1.98199E-05_JPRB,2.00076E-05_JPRB,2.01961E-05_JPRB,&
+ & 2.03853E-05_JPRB,2.05752E-05_JPRB,2.07658E-05_JPRB,2.09571E-05_JPRB,2.11491E-05_JPRB,&
+ & 2.13418E-05_JPRB,2.15352E-05_JPRB,2.17294E-05_JPRB,2.19241E-05_JPRB,2.21196E-05_JPRB,&
+ & 2.23158E-05_JPRB/)  
+
+TOTPLNK( :, 5) = (/&
+ & 5.70230E-07_JPRB,5.94788E-07_JPRB,6.20085E-07_JPRB,6.46130E-07_JPRB,6.72936E-07_JPRB,&
+ & 7.00512E-07_JPRB,7.28869E-07_JPRB,7.58019E-07_JPRB,7.87971E-07_JPRB,8.18734E-07_JPRB,&
+ & 8.50320E-07_JPRB,8.82738E-07_JPRB,9.15999E-07_JPRB,9.50110E-07_JPRB,9.85084E-07_JPRB,&
+ & 1.02093E-06_JPRB,1.05765E-06_JPRB,1.09527E-06_JPRB,1.13378E-06_JPRB,1.17320E-06_JPRB,&
+ & 1.21353E-06_JPRB,1.25479E-06_JPRB,1.29698E-06_JPRB,1.34011E-06_JPRB,1.38419E-06_JPRB,&
+ & 1.42923E-06_JPRB,1.47523E-06_JPRB,1.52221E-06_JPRB,1.57016E-06_JPRB,1.61910E-06_JPRB,&
+ & 1.66904E-06_JPRB,1.71997E-06_JPRB,1.77192E-06_JPRB,1.82488E-06_JPRB,1.87886E-06_JPRB,&
+ & 1.93387E-06_JPRB,1.98991E-06_JPRB,2.04699E-06_JPRB,2.10512E-06_JPRB,2.16430E-06_JPRB,&
+ & 2.22454E-06_JPRB,2.28584E-06_JPRB,2.34821E-06_JPRB,2.41166E-06_JPRB,2.47618E-06_JPRB,&
+ & 2.54178E-06_JPRB,2.60847E-06_JPRB,2.67626E-06_JPRB,2.74514E-06_JPRB,2.81512E-06_JPRB,&
+ & 2.88621E-06_JPRB,2.95841E-06_JPRB,3.03172E-06_JPRB,3.10615E-06_JPRB,3.18170E-06_JPRB,&
+ & 3.25838E-06_JPRB,3.33618E-06_JPRB,3.41511E-06_JPRB,3.49518E-06_JPRB,3.57639E-06_JPRB,&
+ & 3.65873E-06_JPRB,3.74221E-06_JPRB,3.82684E-06_JPRB,3.91262E-06_JPRB,3.99955E-06_JPRB,&
+ & 4.08763E-06_JPRB,4.17686E-06_JPRB,4.26725E-06_JPRB,4.35880E-06_JPRB,4.45150E-06_JPRB,&
+ & 4.54537E-06_JPRB,4.64039E-06_JPRB,4.73659E-06_JPRB,4.83394E-06_JPRB,4.93246E-06_JPRB,&
+ & 5.03215E-06_JPRB,5.13301E-06_JPRB,5.23504E-06_JPRB,5.33823E-06_JPRB,5.44260E-06_JPRB,&
+ & 5.54814E-06_JPRB,5.65484E-06_JPRB,5.76272E-06_JPRB,5.87177E-06_JPRB,5.98199E-06_JPRB,&
+ & 6.09339E-06_JPRB,6.20596E-06_JPRB,6.31969E-06_JPRB,6.43460E-06_JPRB,6.55068E-06_JPRB,&
+ & 6.66793E-06_JPRB,6.78636E-06_JPRB,6.90595E-06_JPRB,7.02670E-06_JPRB,7.14863E-06_JPRB,&
+ & 7.27173E-06_JPRB,7.39599E-06_JPRB,7.52142E-06_JPRB,7.64802E-06_JPRB,7.77577E-06_JPRB,&
+ & 7.90469E-06_JPRB,8.03477E-06_JPRB,8.16601E-06_JPRB,8.29841E-06_JPRB,8.43198E-06_JPRB,&
+ & 8.56669E-06_JPRB,8.70256E-06_JPRB,8.83957E-06_JPRB,8.97775E-06_JPRB,9.11706E-06_JPRB,&
+ & 9.25753E-06_JPRB,9.39915E-06_JPRB,9.54190E-06_JPRB,9.68580E-06_JPRB,9.83085E-06_JPRB,&
+ & 9.97704E-06_JPRB,1.01243E-05_JPRB,1.02728E-05_JPRB,1.04224E-05_JPRB,1.05731E-05_JPRB,&
+ & 1.07249E-05_JPRB,1.08779E-05_JPRB,1.10320E-05_JPRB,1.11872E-05_JPRB,1.13435E-05_JPRB,&
+ & 1.15009E-05_JPRB,1.16595E-05_JPRB,1.18191E-05_JPRB,1.19799E-05_JPRB,1.21418E-05_JPRB,&
+ & 1.23048E-05_JPRB,1.24688E-05_JPRB,1.26340E-05_JPRB,1.28003E-05_JPRB,1.29676E-05_JPRB,&
+ & 1.31361E-05_JPRB,1.33056E-05_JPRB,1.34762E-05_JPRB,1.36479E-05_JPRB,1.38207E-05_JPRB,&
+ & 1.39945E-05_JPRB,1.41694E-05_JPRB,1.43454E-05_JPRB,1.45225E-05_JPRB,1.47006E-05_JPRB,&
+ & 1.48797E-05_JPRB,1.50600E-05_JPRB,1.52413E-05_JPRB,1.54236E-05_JPRB,1.56070E-05_JPRB,&
+ & 1.57914E-05_JPRB,1.59768E-05_JPRB,1.61633E-05_JPRB,1.63509E-05_JPRB,1.65394E-05_JPRB,&
+ & 1.67290E-05_JPRB,1.69197E-05_JPRB,1.71113E-05_JPRB,1.73040E-05_JPRB,1.74976E-05_JPRB,&
+ & 1.76923E-05_JPRB,1.78880E-05_JPRB,1.80847E-05_JPRB,1.82824E-05_JPRB,1.84811E-05_JPRB,&
+ & 1.86808E-05_JPRB,1.88814E-05_JPRB,1.90831E-05_JPRB,1.92857E-05_JPRB,1.94894E-05_JPRB,&
+ & 1.96940E-05_JPRB,1.98996E-05_JPRB,2.01061E-05_JPRB,2.03136E-05_JPRB,2.05221E-05_JPRB,&
+ & 2.07316E-05_JPRB,2.09420E-05_JPRB,2.11533E-05_JPRB,2.13657E-05_JPRB,2.15789E-05_JPRB,&
+ & 2.17931E-05_JPRB/)  
+
+TOTPLNK( :, 6) = (/&
+ & 2.73493E-07_JPRB,2.87408E-07_JPRB,3.01848E-07_JPRB,3.16825E-07_JPRB,3.32352E-07_JPRB,&
+ & 3.48439E-07_JPRB,3.65100E-07_JPRB,3.82346E-07_JPRB,4.00189E-07_JPRB,4.18641E-07_JPRB,&
+ & 4.37715E-07_JPRB,4.57422E-07_JPRB,4.77774E-07_JPRB,4.98784E-07_JPRB,5.20464E-07_JPRB,&
+ & 5.42824E-07_JPRB,5.65879E-07_JPRB,5.89638E-07_JPRB,6.14115E-07_JPRB,6.39320E-07_JPRB,&
+ & 6.65266E-07_JPRB,6.91965E-07_JPRB,7.19427E-07_JPRB,7.47666E-07_JPRB,7.76691E-07_JPRB,&
+ & 8.06516E-07_JPRB,8.37151E-07_JPRB,8.68607E-07_JPRB,9.00896E-07_JPRB,9.34029E-07_JPRB,&
+ & 9.68018E-07_JPRB,1.00287E-06_JPRB,1.03860E-06_JPRB,1.07522E-06_JPRB,1.11274E-06_JPRB,&
+ & 1.15117E-06_JPRB,1.19052E-06_JPRB,1.23079E-06_JPRB,1.27201E-06_JPRB,1.31418E-06_JPRB,&
+ & 1.35731E-06_JPRB,1.40141E-06_JPRB,1.44650E-06_JPRB,1.49257E-06_JPRB,1.53965E-06_JPRB,&
+ & 1.58773E-06_JPRB,1.63684E-06_JPRB,1.68697E-06_JPRB,1.73815E-06_JPRB,1.79037E-06_JPRB,&
+ & 1.84365E-06_JPRB,1.89799E-06_JPRB,1.95341E-06_JPRB,2.00991E-06_JPRB,2.06750E-06_JPRB,&
+ & 2.12619E-06_JPRB,2.18599E-06_JPRB,2.24691E-06_JPRB,2.30895E-06_JPRB,2.37212E-06_JPRB,&
+ & 2.43643E-06_JPRB,2.50189E-06_JPRB,2.56851E-06_JPRB,2.63628E-06_JPRB,2.70523E-06_JPRB,&
+ & 2.77536E-06_JPRB,2.84666E-06_JPRB,2.91916E-06_JPRB,2.99286E-06_JPRB,3.06776E-06_JPRB,&
+ & 3.14387E-06_JPRB,3.22120E-06_JPRB,3.29975E-06_JPRB,3.37953E-06_JPRB,3.46054E-06_JPRB,&
+ & 3.54280E-06_JPRB,3.62630E-06_JPRB,3.71105E-06_JPRB,3.79707E-06_JPRB,3.88434E-06_JPRB,&
+ & 3.97288E-06_JPRB,4.06270E-06_JPRB,4.15380E-06_JPRB,4.24617E-06_JPRB,4.33984E-06_JPRB,&
+ & 4.43479E-06_JPRB,4.53104E-06_JPRB,4.62860E-06_JPRB,4.72746E-06_JPRB,4.82763E-06_JPRB,&
+ & 4.92911E-06_JPRB,5.03191E-06_JPRB,5.13603E-06_JPRB,5.24147E-06_JPRB,5.34824E-06_JPRB,&
+ & 5.45634E-06_JPRB,5.56578E-06_JPRB,5.67656E-06_JPRB,5.78867E-06_JPRB,5.90213E-06_JPRB,&
+ & 6.01694E-06_JPRB,6.13309E-06_JPRB,6.25060E-06_JPRB,6.36947E-06_JPRB,6.48968E-06_JPRB,&
+ & 6.61126E-06_JPRB,6.73420E-06_JPRB,6.85850E-06_JPRB,6.98417E-06_JPRB,7.11120E-06_JPRB,&
+ & 7.23961E-06_JPRB,7.36938E-06_JPRB,7.50053E-06_JPRB,7.63305E-06_JPRB,7.76694E-06_JPRB,&
+ & 7.90221E-06_JPRB,8.03887E-06_JPRB,8.17690E-06_JPRB,8.31632E-06_JPRB,8.45710E-06_JPRB,&
+ & 8.59928E-06_JPRB,8.74282E-06_JPRB,8.88776E-06_JPRB,9.03409E-06_JPRB,9.18179E-06_JPRB,&
+ & 9.33088E-06_JPRB,9.48136E-06_JPRB,9.63323E-06_JPRB,9.78648E-06_JPRB,9.94111E-06_JPRB,&
+ & 1.00971E-05_JPRB,1.02545E-05_JPRB,1.04133E-05_JPRB,1.05735E-05_JPRB,1.07351E-05_JPRB,&
+ & 1.08980E-05_JPRB,1.10624E-05_JPRB,1.12281E-05_JPRB,1.13952E-05_JPRB,1.15637E-05_JPRB,&
+ & 1.17335E-05_JPRB,1.19048E-05_JPRB,1.20774E-05_JPRB,1.22514E-05_JPRB,1.24268E-05_JPRB,&
+ & 1.26036E-05_JPRB,1.27817E-05_JPRB,1.29612E-05_JPRB,1.31421E-05_JPRB,1.33244E-05_JPRB,&
+ & 1.35080E-05_JPRB,1.36930E-05_JPRB,1.38794E-05_JPRB,1.40672E-05_JPRB,1.42563E-05_JPRB,&
+ & 1.44468E-05_JPRB,1.46386E-05_JPRB,1.48318E-05_JPRB,1.50264E-05_JPRB,1.52223E-05_JPRB,&
+ & 1.54196E-05_JPRB,1.56182E-05_JPRB,1.58182E-05_JPRB,1.60196E-05_JPRB,1.62223E-05_JPRB,&
+ & 1.64263E-05_JPRB,1.66317E-05_JPRB,1.68384E-05_JPRB,1.70465E-05_JPRB,1.72559E-05_JPRB,&
+ & 1.74666E-05_JPRB,1.76787E-05_JPRB,1.78921E-05_JPRB,1.81069E-05_JPRB,1.83230E-05_JPRB,&
+ & 1.85404E-05_JPRB,1.87591E-05_JPRB,1.89791E-05_JPRB,1.92005E-05_JPRB,1.94232E-05_JPRB,&
+ & 1.96471E-05_JPRB/)  
+
+TOTPLNK( :, 7) = (/&
+ & 1.25349E-07_JPRB,1.32735E-07_JPRB,1.40458E-07_JPRB,1.48527E-07_JPRB,1.56954E-07_JPRB,&
+ & 1.65748E-07_JPRB,1.74920E-07_JPRB,1.84481E-07_JPRB,1.94443E-07_JPRB,2.04814E-07_JPRB,&
+ & 2.15608E-07_JPRB,2.26835E-07_JPRB,2.38507E-07_JPRB,2.50634E-07_JPRB,2.63229E-07_JPRB,&
+ & 2.76301E-07_JPRB,2.89864E-07_JPRB,3.03930E-07_JPRB,3.18508E-07_JPRB,3.33612E-07_JPRB,&
+ & 3.49253E-07_JPRB,3.65443E-07_JPRB,3.82195E-07_JPRB,3.99519E-07_JPRB,4.17428E-07_JPRB,&
+ & 4.35934E-07_JPRB,4.55050E-07_JPRB,4.74785E-07_JPRB,4.95155E-07_JPRB,5.16170E-07_JPRB,&
+ & 5.37844E-07_JPRB,5.60186E-07_JPRB,5.83211E-07_JPRB,6.06929E-07_JPRB,6.31355E-07_JPRB,&
+ & 6.56498E-07_JPRB,6.82373E-07_JPRB,7.08990E-07_JPRB,7.36362E-07_JPRB,7.64501E-07_JPRB,&
+ & 7.93420E-07_JPRB,8.23130E-07_JPRB,8.53643E-07_JPRB,8.84971E-07_JPRB,9.17128E-07_JPRB,&
+ & 9.50123E-07_JPRB,9.83969E-07_JPRB,1.01868E-06_JPRB,1.05426E-06_JPRB,1.09073E-06_JPRB,&
+ & 1.12810E-06_JPRB,1.16638E-06_JPRB,1.20558E-06_JPRB,1.24572E-06_JPRB,1.28680E-06_JPRB,&
+ & 1.32883E-06_JPRB,1.37183E-06_JPRB,1.41581E-06_JPRB,1.46078E-06_JPRB,1.50675E-06_JPRB,&
+ & 1.55374E-06_JPRB,1.60174E-06_JPRB,1.65078E-06_JPRB,1.70087E-06_JPRB,1.75200E-06_JPRB,&
+ & 1.80421E-06_JPRB,1.85749E-06_JPRB,1.91186E-06_JPRB,1.96732E-06_JPRB,2.02389E-06_JPRB,&
+ & 2.08159E-06_JPRB,2.14040E-06_JPRB,2.20035E-06_JPRB,2.26146E-06_JPRB,2.32372E-06_JPRB,&
+ & 2.38714E-06_JPRB,2.45174E-06_JPRB,2.51753E-06_JPRB,2.58451E-06_JPRB,2.65270E-06_JPRB,&
+ & 2.72210E-06_JPRB,2.79272E-06_JPRB,2.86457E-06_JPRB,2.93767E-06_JPRB,3.01201E-06_JPRB,&
+ & 3.08761E-06_JPRB,3.16448E-06_JPRB,3.24261E-06_JPRB,3.32204E-06_JPRB,3.40275E-06_JPRB,&
+ & 3.48476E-06_JPRB,3.56808E-06_JPRB,3.65271E-06_JPRB,3.73866E-06_JPRB,3.82595E-06_JPRB,&
+ & 3.91456E-06_JPRB,4.00453E-06_JPRB,4.09584E-06_JPRB,4.18851E-06_JPRB,4.28254E-06_JPRB,&
+ & 4.37796E-06_JPRB,4.47475E-06_JPRB,4.57293E-06_JPRB,4.67249E-06_JPRB,4.77346E-06_JPRB,&
+ & 4.87583E-06_JPRB,4.97961E-06_JPRB,5.08481E-06_JPRB,5.19143E-06_JPRB,5.29948E-06_JPRB,&
+ & 5.40896E-06_JPRB,5.51989E-06_JPRB,5.63226E-06_JPRB,5.74608E-06_JPRB,5.86136E-06_JPRB,&
+ & 5.97810E-06_JPRB,6.09631E-06_JPRB,6.21597E-06_JPRB,6.33713E-06_JPRB,6.45976E-06_JPRB,&
+ & 6.58388E-06_JPRB,6.70950E-06_JPRB,6.83661E-06_JPRB,6.96521E-06_JPRB,7.09531E-06_JPRB,&
+ & 7.22692E-06_JPRB,7.36005E-06_JPRB,7.49468E-06_JPRB,7.63084E-06_JPRB,7.76851E-06_JPRB,&
+ & 7.90773E-06_JPRB,8.04846E-06_JPRB,8.19072E-06_JPRB,8.33452E-06_JPRB,8.47985E-06_JPRB,&
+ & 8.62674E-06_JPRB,8.77517E-06_JPRB,8.92514E-06_JPRB,9.07666E-06_JPRB,9.22975E-06_JPRB,&
+ & 9.38437E-06_JPRB,9.54057E-06_JPRB,9.69832E-06_JPRB,9.85762E-06_JPRB,1.00185E-05_JPRB,&
+ & 1.01810E-05_JPRB,1.03450E-05_JPRB,1.05106E-05_JPRB,1.06777E-05_JPRB,1.08465E-05_JPRB,&
+ & 1.10168E-05_JPRB,1.11887E-05_JPRB,1.13621E-05_JPRB,1.15372E-05_JPRB,1.17138E-05_JPRB,&
+ & 1.18920E-05_JPRB,1.20718E-05_JPRB,1.22532E-05_JPRB,1.24362E-05_JPRB,1.26207E-05_JPRB,&
+ & 1.28069E-05_JPRB,1.29946E-05_JPRB,1.31839E-05_JPRB,1.33749E-05_JPRB,1.35674E-05_JPRB,&
+ & 1.37615E-05_JPRB,1.39572E-05_JPRB,1.41544E-05_JPRB,1.43533E-05_JPRB,1.45538E-05_JPRB,&
+ & 1.47558E-05_JPRB,1.49595E-05_JPRB,1.51647E-05_JPRB,1.53716E-05_JPRB,1.55800E-05_JPRB,&
+ & 1.57900E-05_JPRB,1.60017E-05_JPRB,1.62149E-05_JPRB,1.64296E-05_JPRB,1.66460E-05_JPRB,&
+ & 1.68640E-05_JPRB/)  
+
+TOTPLNK( :, 8) = (/&
+ & 6.74445E-08_JPRB,7.18176E-08_JPRB,7.64153E-08_JPRB,8.12456E-08_JPRB,8.63170E-08_JPRB,&
+ & 9.16378E-08_JPRB,9.72168E-08_JPRB,1.03063E-07_JPRB,1.09184E-07_JPRB,1.15591E-07_JPRB,&
+ & 1.22292E-07_JPRB,1.29296E-07_JPRB,1.36613E-07_JPRB,1.44253E-07_JPRB,1.52226E-07_JPRB,&
+ & 1.60540E-07_JPRB,1.69207E-07_JPRB,1.78236E-07_JPRB,1.87637E-07_JPRB,1.97421E-07_JPRB,&
+ & 2.07599E-07_JPRB,2.18181E-07_JPRB,2.29177E-07_JPRB,2.40598E-07_JPRB,2.52456E-07_JPRB,&
+ & 2.64761E-07_JPRB,2.77523E-07_JPRB,2.90755E-07_JPRB,3.04468E-07_JPRB,3.18673E-07_JPRB,&
+ & 3.33381E-07_JPRB,3.48603E-07_JPRB,3.64352E-07_JPRB,3.80638E-07_JPRB,3.97474E-07_JPRB,&
+ & 4.14871E-07_JPRB,4.32841E-07_JPRB,4.51395E-07_JPRB,4.70547E-07_JPRB,4.90306E-07_JPRB,&
+ & 5.10687E-07_JPRB,5.31699E-07_JPRB,5.53357E-07_JPRB,5.75670E-07_JPRB,5.98652E-07_JPRB,&
+ & 6.22315E-07_JPRB,6.46672E-07_JPRB,6.71731E-07_JPRB,6.97511E-07_JPRB,7.24018E-07_JPRB,&
+ & 7.51266E-07_JPRB,7.79269E-07_JPRB,8.08038E-07_JPRB,8.37584E-07_JPRB,8.67922E-07_JPRB,&
+ & 8.99061E-07_JPRB,9.31016E-07_JPRB,9.63797E-07_JPRB,9.97417E-07_JPRB,1.03189E-06_JPRB,&
+ & 1.06722E-06_JPRB,1.10343E-06_JPRB,1.14053E-06_JPRB,1.17853E-06_JPRB,1.21743E-06_JPRB,&
+ & 1.25726E-06_JPRB,1.29803E-06_JPRB,1.33974E-06_JPRB,1.38241E-06_JPRB,1.42606E-06_JPRB,&
+ & 1.47068E-06_JPRB,1.51630E-06_JPRB,1.56293E-06_JPRB,1.61056E-06_JPRB,1.65924E-06_JPRB,&
+ & 1.70894E-06_JPRB,1.75971E-06_JPRB,1.81153E-06_JPRB,1.86443E-06_JPRB,1.91841E-06_JPRB,&
+ & 1.97350E-06_JPRB,2.02968E-06_JPRB,2.08699E-06_JPRB,2.14543E-06_JPRB,2.20500E-06_JPRB,&
+ & 2.26573E-06_JPRB,2.32762E-06_JPRB,2.39068E-06_JPRB,2.45492E-06_JPRB,2.52036E-06_JPRB,&
+ & 2.58700E-06_JPRB,2.65485E-06_JPRB,2.72393E-06_JPRB,2.79424E-06_JPRB,2.86580E-06_JPRB,&
+ & 2.93861E-06_JPRB,3.01269E-06_JPRB,3.08803E-06_JPRB,3.16467E-06_JPRB,3.24259E-06_JPRB,&
+ & 3.32181E-06_JPRB,3.40235E-06_JPRB,3.48420E-06_JPRB,3.56739E-06_JPRB,3.65192E-06_JPRB,&
+ & 3.73779E-06_JPRB,3.82502E-06_JPRB,3.91362E-06_JPRB,4.00359E-06_JPRB,4.09494E-06_JPRB,&
+ & 4.18768E-06_JPRB,4.28182E-06_JPRB,4.37737E-06_JPRB,4.47434E-06_JPRB,4.57273E-06_JPRB,&
+ & 4.67254E-06_JPRB,4.77380E-06_JPRB,4.87651E-06_JPRB,4.98067E-06_JPRB,5.08630E-06_JPRB,&
+ & 5.19339E-06_JPRB,5.30196E-06_JPRB,5.41201E-06_JPRB,5.52356E-06_JPRB,5.63660E-06_JPRB,&
+ & 5.75116E-06_JPRB,5.86722E-06_JPRB,5.98479E-06_JPRB,6.10390E-06_JPRB,6.22453E-06_JPRB,&
+ & 6.34669E-06_JPRB,6.47042E-06_JPRB,6.59569E-06_JPRB,6.72252E-06_JPRB,6.85090E-06_JPRB,&
+ & 6.98085E-06_JPRB,7.11238E-06_JPRB,7.24549E-06_JPRB,7.38019E-06_JPRB,7.51646E-06_JPRB,&
+ & 7.65434E-06_JPRB,7.79382E-06_JPRB,7.93490E-06_JPRB,8.07760E-06_JPRB,8.22192E-06_JPRB,&
+ & 8.36784E-06_JPRB,8.51540E-06_JPRB,8.66459E-06_JPRB,8.81542E-06_JPRB,8.96786E-06_JPRB,&
+ & 9.12197E-06_JPRB,9.27772E-06_JPRB,9.43513E-06_JPRB,9.59419E-06_JPRB,9.75490E-06_JPRB,&
+ & 9.91728E-06_JPRB,1.00813E-05_JPRB,1.02471E-05_JPRB,1.04144E-05_JPRB,1.05835E-05_JPRB,&
+ & 1.07543E-05_JPRB,1.09267E-05_JPRB,1.11008E-05_JPRB,1.12766E-05_JPRB,1.14541E-05_JPRB,&
+ & 1.16333E-05_JPRB,1.18142E-05_JPRB,1.19969E-05_JPRB,1.21812E-05_JPRB,1.23672E-05_JPRB,&
+ & 1.25549E-05_JPRB,1.27443E-05_JPRB,1.29355E-05_JPRB,1.31284E-05_JPRB,1.33229E-05_JPRB,&
+ & 1.35193E-05_JPRB,1.37173E-05_JPRB,1.39170E-05_JPRB,1.41185E-05_JPRB,1.43217E-05_JPRB,&
+ & 1.45267E-05_JPRB/)  
+
+TOTPLNK( :, 9) = (/&
+ & 2.61522E-08_JPRB,2.80613E-08_JPRB,3.00838E-08_JPRB,3.22250E-08_JPRB,3.44899E-08_JPRB,&
+ & 3.68841E-08_JPRB,3.94129E-08_JPRB,4.20820E-08_JPRB,4.48973E-08_JPRB,4.78646E-08_JPRB,&
+ & 5.09901E-08_JPRB,5.42799E-08_JPRB,5.77405E-08_JPRB,6.13784E-08_JPRB,6.52001E-08_JPRB,&
+ & 6.92126E-08_JPRB,7.34227E-08_JPRB,7.78375E-08_JPRB,8.24643E-08_JPRB,8.73103E-08_JPRB,&
+ & 9.23832E-08_JPRB,9.76905E-08_JPRB,1.03240E-07_JPRB,1.09039E-07_JPRB,1.15097E-07_JPRB,&
+ & 1.21421E-07_JPRB,1.28020E-07_JPRB,1.34902E-07_JPRB,1.42075E-07_JPRB,1.49548E-07_JPRB,&
+ & 1.57331E-07_JPRB,1.65432E-07_JPRB,1.73860E-07_JPRB,1.82624E-07_JPRB,1.91734E-07_JPRB,&
+ & 2.01198E-07_JPRB,2.11028E-07_JPRB,2.21231E-07_JPRB,2.31818E-07_JPRB,2.42799E-07_JPRB,&
+ & 2.54184E-07_JPRB,2.65983E-07_JPRB,2.78205E-07_JPRB,2.90862E-07_JPRB,3.03963E-07_JPRB,&
+ & 3.17519E-07_JPRB,3.31541E-07_JPRB,3.46039E-07_JPRB,3.61024E-07_JPRB,3.76507E-07_JPRB,&
+ & 3.92498E-07_JPRB,4.09008E-07_JPRB,4.26050E-07_JPRB,4.43633E-07_JPRB,4.61769E-07_JPRB,&
+ & 4.80469E-07_JPRB,4.99744E-07_JPRB,5.19606E-07_JPRB,5.40067E-07_JPRB,5.61136E-07_JPRB,&
+ & 5.82828E-07_JPRB,6.05152E-07_JPRB,6.28120E-07_JPRB,6.51745E-07_JPRB,6.76038E-07_JPRB,&
+ & 7.01010E-07_JPRB,7.26674E-07_JPRB,7.53041E-07_JPRB,7.80124E-07_JPRB,8.07933E-07_JPRB,&
+ & 8.36482E-07_JPRB,8.65781E-07_JPRB,8.95845E-07_JPRB,9.26683E-07_JPRB,9.58308E-07_JPRB,&
+ & 9.90732E-07_JPRB,1.02397E-06_JPRB,1.05803E-06_JPRB,1.09292E-06_JPRB,1.12866E-06_JPRB,&
+ & 1.16526E-06_JPRB,1.20274E-06_JPRB,1.24109E-06_JPRB,1.28034E-06_JPRB,1.32050E-06_JPRB,&
+ & 1.36158E-06_JPRB,1.40359E-06_JPRB,1.44655E-06_JPRB,1.49046E-06_JPRB,1.53534E-06_JPRB,&
+ & 1.58120E-06_JPRB,1.62805E-06_JPRB,1.67591E-06_JPRB,1.72478E-06_JPRB,1.77468E-06_JPRB,&
+ & 1.82561E-06_JPRB,1.87760E-06_JPRB,1.93066E-06_JPRB,1.98479E-06_JPRB,2.04000E-06_JPRB,&
+ & 2.09631E-06_JPRB,2.15373E-06_JPRB,2.21228E-06_JPRB,2.27196E-06_JPRB,2.33278E-06_JPRB,&
+ & 2.39475E-06_JPRB,2.45790E-06_JPRB,2.52222E-06_JPRB,2.58773E-06_JPRB,2.65445E-06_JPRB,&
+ & 2.72238E-06_JPRB,2.79152E-06_JPRB,2.86191E-06_JPRB,2.93354E-06_JPRB,3.00643E-06_JPRB,&
+ & 3.08058E-06_JPRB,3.15601E-06_JPRB,3.23273E-06_JPRB,3.31075E-06_JPRB,3.39009E-06_JPRB,&
+ & 3.47074E-06_JPRB,3.55272E-06_JPRB,3.63605E-06_JPRB,3.72072E-06_JPRB,3.80676E-06_JPRB,&
+ & 3.89417E-06_JPRB,3.98297E-06_JPRB,4.07315E-06_JPRB,4.16474E-06_JPRB,4.25774E-06_JPRB,&
+ & 4.35217E-06_JPRB,4.44802E-06_JPRB,4.54532E-06_JPRB,4.64406E-06_JPRB,4.74428E-06_JPRB,&
+ & 4.84595E-06_JPRB,4.94911E-06_JPRB,5.05376E-06_JPRB,5.15990E-06_JPRB,5.26755E-06_JPRB,&
+ & 5.37671E-06_JPRB,5.48741E-06_JPRB,5.59963E-06_JPRB,5.71340E-06_JPRB,5.82871E-06_JPRB,&
+ & 5.94559E-06_JPRB,6.06403E-06_JPRB,6.18404E-06_JPRB,6.30565E-06_JPRB,6.42885E-06_JPRB,&
+ & 6.55364E-06_JPRB,6.68004E-06_JPRB,6.80806E-06_JPRB,6.93771E-06_JPRB,7.06898E-06_JPRB,&
+ & 7.20190E-06_JPRB,7.33646E-06_JPRB,7.47267E-06_JPRB,7.61056E-06_JPRB,7.75010E-06_JPRB,&
+ & 7.89133E-06_JPRB,8.03423E-06_JPRB,8.17884E-06_JPRB,8.32514E-06_JPRB,8.47314E-06_JPRB,&
+ & 8.62284E-06_JPRB,8.77427E-06_JPRB,8.92743E-06_JPRB,9.08231E-06_JPRB,9.23893E-06_JPRB,&
+ & 9.39729E-06_JPRB,9.55741E-06_JPRB,9.71927E-06_JPRB,9.88291E-06_JPRB,1.00483E-05_JPRB,&
+ & 1.02155E-05_JPRB,1.03844E-05_JPRB,1.05552E-05_JPRB,1.07277E-05_JPRB,1.09020E-05_JPRB,&
+ & 1.10781E-05_JPRB/)  
+
+TOTPLNK( :,10) = (/&
+ & 8.89300E-09_JPRB,9.63263E-09_JPRB,1.04235E-08_JPRB,1.12685E-08_JPRB,1.21703E-08_JPRB,&
+ & 1.31321E-08_JPRB,1.41570E-08_JPRB,1.52482E-08_JPRB,1.64090E-08_JPRB,1.76428E-08_JPRB,&
+ & 1.89533E-08_JPRB,2.03441E-08_JPRB,2.18190E-08_JPRB,2.33820E-08_JPRB,2.50370E-08_JPRB,&
+ & 2.67884E-08_JPRB,2.86402E-08_JPRB,3.05969E-08_JPRB,3.26632E-08_JPRB,3.48436E-08_JPRB,&
+ & 3.71429E-08_JPRB,3.95660E-08_JPRB,4.21179E-08_JPRB,4.48040E-08_JPRB,4.76294E-08_JPRB,&
+ & 5.05996E-08_JPRB,5.37201E-08_JPRB,5.69966E-08_JPRB,6.04349E-08_JPRB,6.40411E-08_JPRB,&
+ & 6.78211E-08_JPRB,7.17812E-08_JPRB,7.59276E-08_JPRB,8.02670E-08_JPRB,8.48059E-08_JPRB,&
+ & 8.95508E-08_JPRB,9.45090E-08_JPRB,9.96873E-08_JPRB,1.05093E-07_JPRB,1.10733E-07_JPRB,&
+ & 1.16614E-07_JPRB,1.22745E-07_JPRB,1.29133E-07_JPRB,1.35786E-07_JPRB,1.42711E-07_JPRB,&
+ & 1.49916E-07_JPRB,1.57410E-07_JPRB,1.65202E-07_JPRB,1.73298E-07_JPRB,1.81709E-07_JPRB,&
+ & 1.90441E-07_JPRB,1.99505E-07_JPRB,2.08908E-07_JPRB,2.18660E-07_JPRB,2.28770E-07_JPRB,&
+ & 2.39247E-07_JPRB,2.50101E-07_JPRB,2.61340E-07_JPRB,2.72974E-07_JPRB,2.85013E-07_JPRB,&
+ & 2.97467E-07_JPRB,3.10345E-07_JPRB,3.23657E-07_JPRB,3.37413E-07_JPRB,3.51623E-07_JPRB,&
+ & 3.66298E-07_JPRB,3.81448E-07_JPRB,3.97082E-07_JPRB,4.13212E-07_JPRB,4.29848E-07_JPRB,&
+ & 4.47000E-07_JPRB,4.64680E-07_JPRB,4.82898E-07_JPRB,5.01664E-07_JPRB,5.20991E-07_JPRB,&
+ & 5.40888E-07_JPRB,5.61369E-07_JPRB,5.82440E-07_JPRB,6.04118E-07_JPRB,6.26410E-07_JPRB,&
+ & 6.49329E-07_JPRB,6.72887E-07_JPRB,6.97095E-07_JPRB,7.21964E-07_JPRB,7.47506E-07_JPRB,&
+ & 7.73732E-07_JPRB,8.00655E-07_JPRB,8.28287E-07_JPRB,8.56635E-07_JPRB,8.85717E-07_JPRB,&
+ & 9.15542E-07_JPRB,9.46122E-07_JPRB,9.77469E-07_JPRB,1.00960E-06_JPRB,1.04251E-06_JPRB,&
+ & 1.07623E-06_JPRB,1.11077E-06_JPRB,1.14613E-06_JPRB,1.18233E-06_JPRB,1.21939E-06_JPRB,&
+ & 1.25730E-06_JPRB,1.29610E-06_JPRB,1.33578E-06_JPRB,1.37636E-06_JPRB,1.41785E-06_JPRB,&
+ & 1.46027E-06_JPRB,1.50362E-06_JPRB,1.54792E-06_JPRB,1.59319E-06_JPRB,1.63942E-06_JPRB,&
+ & 1.68665E-06_JPRB,1.73487E-06_JPRB,1.78410E-06_JPRB,1.83435E-06_JPRB,1.88564E-06_JPRB,&
+ & 1.93797E-06_JPRB,1.99136E-06_JPRB,2.04582E-06_JPRB,2.10137E-06_JPRB,2.15801E-06_JPRB,&
+ & 2.21576E-06_JPRB,2.27463E-06_JPRB,2.33462E-06_JPRB,2.39577E-06_JPRB,2.45806E-06_JPRB,&
+ & 2.52153E-06_JPRB,2.58617E-06_JPRB,2.65201E-06_JPRB,2.71905E-06_JPRB,2.78730E-06_JPRB,&
+ & 2.85678E-06_JPRB,2.92749E-06_JPRB,2.99946E-06_JPRB,3.07269E-06_JPRB,3.14720E-06_JPRB,&
+ & 3.22299E-06_JPRB,3.30007E-06_JPRB,3.37847E-06_JPRB,3.45818E-06_JPRB,3.53923E-06_JPRB,&
+ & 3.62161E-06_JPRB,3.70535E-06_JPRB,3.79046E-06_JPRB,3.87695E-06_JPRB,3.96481E-06_JPRB,&
+ & 4.05409E-06_JPRB,4.14477E-06_JPRB,4.23687E-06_JPRB,4.33040E-06_JPRB,4.42538E-06_JPRB,&
+ & 4.52180E-06_JPRB,4.61969E-06_JPRB,4.71905E-06_JPRB,4.81991E-06_JPRB,4.92226E-06_JPRB,&
+ & 5.02611E-06_JPRB,5.13148E-06_JPRB,5.23839E-06_JPRB,5.34681E-06_JPRB,5.45681E-06_JPRB,&
+ & 5.56835E-06_JPRB,5.68146E-06_JPRB,5.79614E-06_JPRB,5.91242E-06_JPRB,6.03030E-06_JPRB,&
+ & 6.14978E-06_JPRB,6.27088E-06_JPRB,6.39360E-06_JPRB,6.51798E-06_JPRB,6.64398E-06_JPRB,&
+ & 6.77165E-06_JPRB,6.90099E-06_JPRB,7.03198E-06_JPRB,7.16468E-06_JPRB,7.29906E-06_JPRB,&
+ & 7.43514E-06_JPRB,7.57294E-06_JPRB,7.71244E-06_JPRB,7.85369E-06_JPRB,7.99666E-06_JPRB,&
+ & 8.14138E-06_JPRB/)  
+
+TOTPLNK( :,11) = (/&
+ & 2.53767E-09_JPRB,2.77242E-09_JPRB,3.02564E-09_JPRB,3.29851E-09_JPRB,3.59228E-09_JPRB,&
+ & 3.90825E-09_JPRB,4.24777E-09_JPRB,4.61227E-09_JPRB,5.00322E-09_JPRB,5.42219E-09_JPRB,&
+ & 5.87080E-09_JPRB,6.35072E-09_JPRB,6.86370E-09_JPRB,7.41159E-09_JPRB,7.99628E-09_JPRB,&
+ & 8.61974E-09_JPRB,9.28404E-09_JPRB,9.99130E-09_JPRB,1.07437E-08_JPRB,1.15436E-08_JPRB,&
+ & 1.23933E-08_JPRB,1.32953E-08_JPRB,1.42522E-08_JPRB,1.52665E-08_JPRB,1.63410E-08_JPRB,&
+ & 1.74786E-08_JPRB,1.86820E-08_JPRB,1.99542E-08_JPRB,2.12985E-08_JPRB,2.27179E-08_JPRB,&
+ & 2.42158E-08_JPRB,2.57954E-08_JPRB,2.74604E-08_JPRB,2.92141E-08_JPRB,3.10604E-08_JPRB,&
+ & 3.30029E-08_JPRB,3.50457E-08_JPRB,3.71925E-08_JPRB,3.94476E-08_JPRB,4.18149E-08_JPRB,&
+ & 4.42991E-08_JPRB,4.69043E-08_JPRB,4.96352E-08_JPRB,5.24961E-08_JPRB,5.54921E-08_JPRB,&
+ & 5.86277E-08_JPRB,6.19081E-08_JPRB,6.53381E-08_JPRB,6.89231E-08_JPRB,7.26681E-08_JPRB,&
+ & 7.65788E-08_JPRB,8.06604E-08_JPRB,8.49187E-08_JPRB,8.93591E-08_JPRB,9.39879E-08_JPRB,&
+ & 9.88106E-08_JPRB,1.03834E-07_JPRB,1.09063E-07_JPRB,1.14504E-07_JPRB,1.20165E-07_JPRB,&
+ & 1.26051E-07_JPRB,1.32169E-07_JPRB,1.38525E-07_JPRB,1.45128E-07_JPRB,1.51982E-07_JPRB,&
+ & 1.59096E-07_JPRB,1.66477E-07_JPRB,1.74132E-07_JPRB,1.82068E-07_JPRB,1.90292E-07_JPRB,&
+ & 1.98813E-07_JPRB,2.07638E-07_JPRB,2.16775E-07_JPRB,2.26231E-07_JPRB,2.36015E-07_JPRB,&
+ & 2.46135E-07_JPRB,2.56599E-07_JPRB,2.67415E-07_JPRB,2.78592E-07_JPRB,2.90137E-07_JPRB,&
+ & 3.02061E-07_JPRB,3.14371E-07_JPRB,3.27077E-07_JPRB,3.40186E-07_JPRB,3.53710E-07_JPRB,&
+ & 3.67655E-07_JPRB,3.82031E-07_JPRB,3.96848E-07_JPRB,4.12116E-07_JPRB,4.27842E-07_JPRB,&
+ & 4.44039E-07_JPRB,4.60713E-07_JPRB,4.77876E-07_JPRB,4.95537E-07_JPRB,5.13706E-07_JPRB,&
+ & 5.32392E-07_JPRB,5.51608E-07_JPRB,5.71360E-07_JPRB,5.91662E-07_JPRB,6.12521E-07_JPRB,&
+ & 6.33950E-07_JPRB,6.55958E-07_JPRB,6.78556E-07_JPRB,7.01753E-07_JPRB,7.25562E-07_JPRB,&
+ & 7.49992E-07_JPRB,7.75055E-07_JPRB,8.00760E-07_JPRB,8.27120E-07_JPRB,8.54145E-07_JPRB,&
+ & 8.81845E-07_JPRB,9.10233E-07_JPRB,9.39318E-07_JPRB,9.69113E-07_JPRB,9.99627E-07_JPRB,&
+ & 1.03087E-06_JPRB,1.06286E-06_JPRB,1.09561E-06_JPRB,1.12912E-06_JPRB,1.16340E-06_JPRB,&
+ & 1.19848E-06_JPRB,1.23435E-06_JPRB,1.27104E-06_JPRB,1.30855E-06_JPRB,1.34690E-06_JPRB,&
+ & 1.38609E-06_JPRB,1.42614E-06_JPRB,1.46706E-06_JPRB,1.50886E-06_JPRB,1.55155E-06_JPRB,&
+ & 1.59515E-06_JPRB,1.63967E-06_JPRB,1.68512E-06_JPRB,1.73150E-06_JPRB,1.77884E-06_JPRB,&
+ & 1.82715E-06_JPRB,1.87643E-06_JPRB,1.92670E-06_JPRB,1.97797E-06_JPRB,2.03026E-06_JPRB,&
+ & 2.08356E-06_JPRB,2.13791E-06_JPRB,2.19330E-06_JPRB,2.24975E-06_JPRB,2.30728E-06_JPRB,&
+ & 2.36589E-06_JPRB,2.42560E-06_JPRB,2.48641E-06_JPRB,2.54835E-06_JPRB,2.61142E-06_JPRB,&
+ & 2.67563E-06_JPRB,2.74100E-06_JPRB,2.80754E-06_JPRB,2.87526E-06_JPRB,2.94417E-06_JPRB,&
+ & 3.01429E-06_JPRB,3.08562E-06_JPRB,3.15819E-06_JPRB,3.23199E-06_JPRB,3.30704E-06_JPRB,&
+ & 3.38336E-06_JPRB,3.46096E-06_JPRB,3.53984E-06_JPRB,3.62002E-06_JPRB,3.70151E-06_JPRB,&
+ & 3.78433E-06_JPRB,3.86848E-06_JPRB,3.95399E-06_JPRB,4.04084E-06_JPRB,4.12907E-06_JPRB,&
+ & 4.21868E-06_JPRB,4.30968E-06_JPRB,4.40209E-06_JPRB,4.49592E-06_JPRB,4.59117E-06_JPRB,&
+ & 4.68786E-06_JPRB,4.78600E-06_JPRB,4.88561E-06_JPRB,4.98669E-06_JPRB,5.08926E-06_JPRB,&
+ & 5.19332E-06_JPRB/)  
+
+TOTPLNK( :,12) = (/&
+ & 2.73921E-10_JPRB,3.04500E-10_JPRB,3.38056E-10_JPRB,3.74835E-10_JPRB,4.15099E-10_JPRB,&
+ & 4.59126E-10_JPRB,5.07214E-10_JPRB,5.59679E-10_JPRB,6.16857E-10_JPRB,6.79103E-10_JPRB,&
+ & 7.46796E-10_JPRB,8.20335E-10_JPRB,9.00144E-10_JPRB,9.86671E-10_JPRB,1.08039E-09_JPRB,&
+ & 1.18180E-09_JPRB,1.29142E-09_JPRB,1.40982E-09_JPRB,1.53757E-09_JPRB,1.67529E-09_JPRB,&
+ & 1.82363E-09_JPRB,1.98327E-09_JPRB,2.15492E-09_JPRB,2.33932E-09_JPRB,2.53726E-09_JPRB,&
+ & 2.74957E-09_JPRB,2.97710E-09_JPRB,3.22075E-09_JPRB,3.48145E-09_JPRB,3.76020E-09_JPRB,&
+ & 4.05801E-09_JPRB,4.37595E-09_JPRB,4.71513E-09_JPRB,5.07672E-09_JPRB,5.46193E-09_JPRB,&
+ & 5.87201E-09_JPRB,6.30827E-09_JPRB,6.77205E-09_JPRB,7.26480E-09_JPRB,7.78794E-09_JPRB,&
+ & 8.34304E-09_JPRB,8.93163E-09_JPRB,9.55537E-09_JPRB,1.02159E-08_JPRB,1.09151E-08_JPRB,&
+ & 1.16547E-08_JPRB,1.24365E-08_JPRB,1.32625E-08_JPRB,1.41348E-08_JPRB,1.50554E-08_JPRB,&
+ & 1.60264E-08_JPRB,1.70500E-08_JPRB,1.81285E-08_JPRB,1.92642E-08_JPRB,2.04596E-08_JPRB,&
+ & 2.17171E-08_JPRB,2.30394E-08_JPRB,2.44289E-08_JPRB,2.58885E-08_JPRB,2.74209E-08_JPRB,&
+ & 2.90290E-08_JPRB,3.07157E-08_JPRB,3.24841E-08_JPRB,3.43371E-08_JPRB,3.62782E-08_JPRB,&
+ & 3.83103E-08_JPRB,4.04371E-08_JPRB,4.26617E-08_JPRB,4.49878E-08_JPRB,4.74190E-08_JPRB,&
+ & 4.99589E-08_JPRB,5.26113E-08_JPRB,5.53801E-08_JPRB,5.82692E-08_JPRB,6.12826E-08_JPRB,&
+ & 6.44245E-08_JPRB,6.76991E-08_JPRB,7.11105E-08_JPRB,7.46634E-08_JPRB,7.83621E-08_JPRB,&
+ & 8.22112E-08_JPRB,8.62154E-08_JPRB,9.03795E-08_JPRB,9.47081E-08_JPRB,9.92066E-08_JPRB,&
+ & 1.03879E-07_JPRB,1.08732E-07_JPRB,1.13770E-07_JPRB,1.18998E-07_JPRB,1.24422E-07_JPRB,&
+ & 1.30048E-07_JPRB,1.35880E-07_JPRB,1.41924E-07_JPRB,1.48187E-07_JPRB,1.54675E-07_JPRB,&
+ & 1.61392E-07_JPRB,1.68346E-07_JPRB,1.75543E-07_JPRB,1.82988E-07_JPRB,1.90688E-07_JPRB,&
+ & 1.98650E-07_JPRB,2.06880E-07_JPRB,2.15385E-07_JPRB,2.24172E-07_JPRB,2.33247E-07_JPRB,&
+ & 2.42617E-07_JPRB,2.52289E-07_JPRB,2.62272E-07_JPRB,2.72571E-07_JPRB,2.83193E-07_JPRB,&
+ & 2.94147E-07_JPRB,3.05440E-07_JPRB,3.17080E-07_JPRB,3.29074E-07_JPRB,3.41430E-07_JPRB,&
+ & 3.54155E-07_JPRB,3.67259E-07_JPRB,3.80747E-07_JPRB,3.94631E-07_JPRB,4.08916E-07_JPRB,&
+ & 4.23611E-07_JPRB,4.38725E-07_JPRB,4.54267E-07_JPRB,4.70245E-07_JPRB,4.86666E-07_JPRB,&
+ & 5.03541E-07_JPRB,5.20879E-07_JPRB,5.38687E-07_JPRB,5.56975E-07_JPRB,5.75751E-07_JPRB,&
+ & 5.95026E-07_JPRB,6.14808E-07_JPRB,6.35107E-07_JPRB,6.55932E-07_JPRB,6.77293E-07_JPRB,&
+ & 6.99197E-07_JPRB,7.21656E-07_JPRB,7.44681E-07_JPRB,7.68278E-07_JPRB,7.92460E-07_JPRB,&
+ & 8.17235E-07_JPRB,8.42614E-07_JPRB,8.68606E-07_JPRB,8.95223E-07_JPRB,9.22473E-07_JPRB,&
+ & 9.50366E-07_JPRB,9.78915E-07_JPRB,1.00813E-06_JPRB,1.03802E-06_JPRB,1.06859E-06_JPRB,&
+ & 1.09986E-06_JPRB,1.13184E-06_JPRB,1.16453E-06_JPRB,1.19796E-06_JPRB,1.23212E-06_JPRB,&
+ & 1.26703E-06_JPRB,1.30270E-06_JPRB,1.33915E-06_JPRB,1.37637E-06_JPRB,1.41440E-06_JPRB,&
+ & 1.45322E-06_JPRB,1.49286E-06_JPRB,1.53333E-06_JPRB,1.57464E-06_JPRB,1.61679E-06_JPRB,&
+ & 1.65981E-06_JPRB,1.70370E-06_JPRB,1.74847E-06_JPRB,1.79414E-06_JPRB,1.84071E-06_JPRB,&
+ & 1.88821E-06_JPRB,1.93663E-06_JPRB,1.98599E-06_JPRB,2.03631E-06_JPRB,2.08759E-06_JPRB,&
+ & 2.13985E-06_JPRB,2.19310E-06_JPRB,2.24734E-06_JPRB,2.30260E-06_JPRB,2.35888E-06_JPRB,&
+ & 2.41619E-06_JPRB/)  
+
+TOTPLNK( :,13) = (/&
+ & 4.53634E-11_JPRB,5.11435E-11_JPRB,5.75754E-11_JPRB,6.47222E-11_JPRB,7.26531E-11_JPRB,&
+ & 8.14420E-11_JPRB,9.11690E-11_JPRB,1.01921E-10_JPRB,1.13790E-10_JPRB,1.26877E-10_JPRB,&
+ & 1.41288E-10_JPRB,1.57140E-10_JPRB,1.74555E-10_JPRB,1.93665E-10_JPRB,2.14613E-10_JPRB,&
+ & 2.37548E-10_JPRB,2.62633E-10_JPRB,2.90039E-10_JPRB,3.19948E-10_JPRB,3.52558E-10_JPRB,&
+ & 3.88073E-10_JPRB,4.26716E-10_JPRB,4.68719E-10_JPRB,5.14331E-10_JPRB,5.63815E-10_JPRB,&
+ & 6.17448E-10_JPRB,6.75526E-10_JPRB,7.38358E-10_JPRB,8.06277E-10_JPRB,8.79625E-10_JPRB,&
+ & 9.58770E-10_JPRB,1.04410E-09_JPRB,1.13602E-09_JPRB,1.23495E-09_JPRB,1.34135E-09_JPRB,&
+ & 1.45568E-09_JPRB,1.57845E-09_JPRB,1.71017E-09_JPRB,1.85139E-09_JPRB,2.00268E-09_JPRB,&
+ & 2.16464E-09_JPRB,2.33789E-09_JPRB,2.52309E-09_JPRB,2.72093E-09_JPRB,2.93212E-09_JPRB,&
+ & 3.15740E-09_JPRB,3.39757E-09_JPRB,3.65341E-09_JPRB,3.92579E-09_JPRB,4.21559E-09_JPRB,&
+ & 4.52372E-09_JPRB,4.85115E-09_JPRB,5.19886E-09_JPRB,5.56788E-09_JPRB,5.95928E-09_JPRB,&
+ & 6.37419E-09_JPRB,6.81375E-09_JPRB,7.27917E-09_JPRB,7.77168E-09_JPRB,8.29256E-09_JPRB,&
+ & 8.84317E-09_JPRB,9.42487E-09_JPRB,1.00391E-08_JPRB,1.06873E-08_JPRB,1.13710E-08_JPRB,&
+ & 1.20919E-08_JPRB,1.28515E-08_JPRB,1.36514E-08_JPRB,1.44935E-08_JPRB,1.53796E-08_JPRB,&
+ & 1.63114E-08_JPRB,1.72909E-08_JPRB,1.83201E-08_JPRB,1.94008E-08_JPRB,2.05354E-08_JPRB,&
+ & 2.17258E-08_JPRB,2.29742E-08_JPRB,2.42830E-08_JPRB,2.56545E-08_JPRB,2.70910E-08_JPRB,&
+ & 2.85950E-08_JPRB,3.01689E-08_JPRB,3.18155E-08_JPRB,3.35373E-08_JPRB,3.53372E-08_JPRB,&
+ & 3.72177E-08_JPRB,3.91818E-08_JPRB,4.12325E-08_JPRB,4.33727E-08_JPRB,4.56056E-08_JPRB,&
+ & 4.79342E-08_JPRB,5.03617E-08_JPRB,5.28915E-08_JPRB,5.55270E-08_JPRB,5.82715E-08_JPRB,&
+ & 6.11286E-08_JPRB,6.41019E-08_JPRB,6.71951E-08_JPRB,7.04119E-08_JPRB,7.37560E-08_JPRB,&
+ & 7.72315E-08_JPRB,8.08424E-08_JPRB,8.45927E-08_JPRB,8.84866E-08_JPRB,9.25281E-08_JPRB,&
+ & 9.67218E-08_JPRB,1.01072E-07_JPRB,1.05583E-07_JPRB,1.10260E-07_JPRB,1.15107E-07_JPRB,&
+ & 1.20128E-07_JPRB,1.25330E-07_JPRB,1.30716E-07_JPRB,1.36291E-07_JPRB,1.42061E-07_JPRB,&
+ & 1.48031E-07_JPRB,1.54206E-07_JPRB,1.60592E-07_JPRB,1.67192E-07_JPRB,1.74015E-07_JPRB,&
+ & 1.81064E-07_JPRB,1.88345E-07_JPRB,1.95865E-07_JPRB,2.03628E-07_JPRB,2.11643E-07_JPRB,&
+ & 2.19912E-07_JPRB,2.28443E-07_JPRB,2.37244E-07_JPRB,2.46318E-07_JPRB,2.55673E-07_JPRB,&
+ & 2.65316E-07_JPRB,2.75252E-07_JPRB,2.85489E-07_JPRB,2.96033E-07_JPRB,3.06891E-07_JPRB,&
+ & 3.18070E-07_JPRB,3.29576E-07_JPRB,3.41417E-07_JPRB,3.53600E-07_JPRB,3.66133E-07_JPRB,&
+ & 3.79021E-07_JPRB,3.92274E-07_JPRB,4.05897E-07_JPRB,4.19899E-07_JPRB,4.34288E-07_JPRB,&
+ & 4.49071E-07_JPRB,4.64255E-07_JPRB,4.79850E-07_JPRB,4.95863E-07_JPRB,5.12300E-07_JPRB,&
+ & 5.29172E-07_JPRB,5.46486E-07_JPRB,5.64250E-07_JPRB,5.82473E-07_JPRB,6.01164E-07_JPRB,&
+ & 6.20329E-07_JPRB,6.39979E-07_JPRB,6.60122E-07_JPRB,6.80767E-07_JPRB,7.01922E-07_JPRB,&
+ & 7.23596E-07_JPRB,7.45800E-07_JPRB,7.68539E-07_JPRB,7.91826E-07_JPRB,8.15669E-07_JPRB,&
+ & 8.40076E-07_JPRB,8.65058E-07_JPRB,8.90623E-07_JPRB,9.16783E-07_JPRB,9.43544E-07_JPRB,&
+ & 9.70917E-07_JPRB,9.98912E-07_JPRB,1.02754E-06_JPRB,1.05681E-06_JPRB,1.08673E-06_JPRB,&
+ & 1.11731E-06_JPRB,1.14856E-06_JPRB,1.18050E-06_JPRB,1.21312E-06_JPRB,1.24645E-06_JPRB,&
+ & 1.28049E-06_JPRB/)  
+
+TOTPLNK( :,14) = (/&
+ & 1.40113E-11_JPRB,1.59358E-11_JPRB,1.80960E-11_JPRB,2.05171E-11_JPRB,2.32266E-11_JPRB,&
+ & 2.62546E-11_JPRB,2.96335E-11_JPRB,3.33990E-11_JPRB,3.75896E-11_JPRB,4.22469E-11_JPRB,&
+ & 4.74164E-11_JPRB,5.31466E-11_JPRB,5.94905E-11_JPRB,6.65054E-11_JPRB,7.42522E-11_JPRB,&
+ & 8.27975E-11_JPRB,9.22122E-11_JPRB,1.02573E-10_JPRB,1.13961E-10_JPRB,1.26466E-10_JPRB,&
+ & 1.40181E-10_JPRB,1.55206E-10_JPRB,1.71651E-10_JPRB,1.89630E-10_JPRB,2.09265E-10_JPRB,&
+ & 2.30689E-10_JPRB,2.54040E-10_JPRB,2.79467E-10_JPRB,3.07128E-10_JPRB,3.37190E-10_JPRB,&
+ & 3.69833E-10_JPRB,4.05243E-10_JPRB,4.43623E-10_JPRB,4.85183E-10_JPRB,5.30149E-10_JPRB,&
+ & 5.78755E-10_JPRB,6.31255E-10_JPRB,6.87910E-10_JPRB,7.49002E-10_JPRB,8.14824E-10_JPRB,&
+ & 8.85687E-10_JPRB,9.61914E-10_JPRB,1.04385E-09_JPRB,1.13186E-09_JPRB,1.22631E-09_JPRB,&
+ & 1.32761E-09_JPRB,1.43617E-09_JPRB,1.55243E-09_JPRB,1.67686E-09_JPRB,1.80992E-09_JPRB,&
+ & 1.95212E-09_JPRB,2.10399E-09_JPRB,2.26607E-09_JPRB,2.43895E-09_JPRB,2.62321E-09_JPRB,&
+ & 2.81949E-09_JPRB,3.02844E-09_JPRB,3.25073E-09_JPRB,3.48707E-09_JPRB,3.73820E-09_JPRB,&
+ & 4.00490E-09_JPRB,4.28794E-09_JPRB,4.58819E-09_JPRB,4.90647E-09_JPRB,5.24371E-09_JPRB,&
+ & 5.60081E-09_JPRB,5.97875E-09_JPRB,6.37854E-09_JPRB,6.80120E-09_JPRB,7.24782E-09_JPRB,&
+ & 7.71950E-09_JPRB,8.21740E-09_JPRB,8.74271E-09_JPRB,9.29666E-09_JPRB,9.88054E-09_JPRB,&
+ & 1.04956E-08_JPRB,1.11434E-08_JPRB,1.18251E-08_JPRB,1.25422E-08_JPRB,1.32964E-08_JPRB,&
+ & 1.40890E-08_JPRB,1.49217E-08_JPRB,1.57961E-08_JPRB,1.67140E-08_JPRB,1.76771E-08_JPRB,&
+ & 1.86870E-08_JPRB,1.97458E-08_JPRB,2.08553E-08_JPRB,2.20175E-08_JPRB,2.32342E-08_JPRB,&
+ & 2.45077E-08_JPRB,2.58401E-08_JPRB,2.72334E-08_JPRB,2.86900E-08_JPRB,3.02122E-08_JPRB,&
+ & 3.18021E-08_JPRB,3.34624E-08_JPRB,3.51954E-08_JPRB,3.70037E-08_JPRB,3.88899E-08_JPRB,&
+ & 4.08568E-08_JPRB,4.29068E-08_JPRB,4.50429E-08_JPRB,4.72678E-08_JPRB,4.95847E-08_JPRB,&
+ & 5.19963E-08_JPRB,5.45058E-08_JPRB,5.71161E-08_JPRB,5.98309E-08_JPRB,6.26529E-08_JPRB,&
+ & 6.55857E-08_JPRB,6.86327E-08_JPRB,7.17971E-08_JPRB,7.50829E-08_JPRB,7.84933E-08_JPRB,&
+ & 8.20323E-08_JPRB,8.57035E-08_JPRB,8.95105E-08_JPRB,9.34579E-08_JPRB,9.75488E-08_JPRB,&
+ & 1.01788E-07_JPRB,1.06179E-07_JPRB,1.10727E-07_JPRB,1.15434E-07_JPRB,1.20307E-07_JPRB,&
+ & 1.25350E-07_JPRB,1.30566E-07_JPRB,1.35961E-07_JPRB,1.41539E-07_JPRB,1.47304E-07_JPRB,&
+ & 1.53263E-07_JPRB,1.59419E-07_JPRB,1.65778E-07_JPRB,1.72345E-07_JPRB,1.79124E-07_JPRB,&
+ & 1.86122E-07_JPRB,1.93343E-07_JPRB,2.00792E-07_JPRB,2.08476E-07_JPRB,2.16400E-07_JPRB,&
+ & 2.24568E-07_JPRB,2.32988E-07_JPRB,2.41666E-07_JPRB,2.50605E-07_JPRB,2.59813E-07_JPRB,&
+ & 2.69297E-07_JPRB,2.79060E-07_JPRB,2.89111E-07_JPRB,2.99455E-07_JPRB,3.10099E-07_JPRB,&
+ & 3.21049E-07_JPRB,3.32311E-07_JPRB,3.43893E-07_JPRB,3.55801E-07_JPRB,3.68041E-07_JPRB,&
+ & 3.80621E-07_JPRB,3.93547E-07_JPRB,4.06826E-07_JPRB,4.20465E-07_JPRB,4.34473E-07_JPRB,&
+ & 4.48856E-07_JPRB,4.63620E-07_JPRB,4.78774E-07_JPRB,4.94325E-07_JPRB,5.10280E-07_JPRB,&
+ & 5.26648E-07_JPRB,5.43436E-07_JPRB,5.60652E-07_JPRB,5.78302E-07_JPRB,5.96397E-07_JPRB,&
+ & 6.14943E-07_JPRB,6.33949E-07_JPRB,6.53421E-07_JPRB,6.73370E-07_JPRB,6.93803E-07_JPRB,&
+ & 7.14731E-07_JPRB,7.36157E-07_JPRB,7.58095E-07_JPRB,7.80549E-07_JPRB,8.03533E-07_JPRB,&
+ & 8.27050E-07_JPRB/)  
+
+TOTPLNK( :,15) = (/&
+ & 3.90483E-12_JPRB,4.47999E-12_JPRB,5.13122E-12_JPRB,5.86739E-12_JPRB,6.69829E-12_JPRB,&
+ & 7.63467E-12_JPRB,8.68833E-12_JPRB,9.87221E-12_JPRB,1.12005E-11_JPRB,1.26885E-11_JPRB,&
+ & 1.43534E-11_JPRB,1.62134E-11_JPRB,1.82888E-11_JPRB,2.06012E-11_JPRB,2.31745E-11_JPRB,&
+ & 2.60343E-11_JPRB,2.92087E-11_JPRB,3.27277E-11_JPRB,3.66242E-11_JPRB,4.09334E-11_JPRB,&
+ & 4.56935E-11_JPRB,5.09455E-11_JPRB,5.67338E-11_JPRB,6.31057E-11_JPRB,7.01127E-11_JPRB,&
+ & 7.78096E-11_JPRB,8.62554E-11_JPRB,9.55130E-11_JPRB,1.05651E-10_JPRB,1.16740E-10_JPRB,&
+ & 1.28858E-10_JPRB,1.42089E-10_JPRB,1.56519E-10_JPRB,1.72243E-10_JPRB,1.89361E-10_JPRB,&
+ & 2.07978E-10_JPRB,2.28209E-10_JPRB,2.50173E-10_JPRB,2.73999E-10_JPRB,2.99820E-10_JPRB,&
+ & 3.27782E-10_JPRB,3.58034E-10_JPRB,3.90739E-10_JPRB,4.26067E-10_JPRB,4.64196E-10_JPRB,&
+ & 5.05317E-10_JPRB,5.49631E-10_JPRB,5.97347E-10_JPRB,6.48689E-10_JPRB,7.03891E-10_JPRB,&
+ & 7.63201E-10_JPRB,8.26876E-10_JPRB,8.95192E-10_JPRB,9.68430E-10_JPRB,1.04690E-09_JPRB,&
+ & 1.13091E-09_JPRB,1.22079E-09_JPRB,1.31689E-09_JPRB,1.41957E-09_JPRB,1.52922E-09_JPRB,&
+ & 1.64623E-09_JPRB,1.77101E-09_JPRB,1.90401E-09_JPRB,2.04567E-09_JPRB,2.19647E-09_JPRB,&
+ & 2.35690E-09_JPRB,2.52749E-09_JPRB,2.70875E-09_JPRB,2.90127E-09_JPRB,3.10560E-09_JPRB,&
+ & 3.32238E-09_JPRB,3.55222E-09_JPRB,3.79578E-09_JPRB,4.05375E-09_JPRB,4.32682E-09_JPRB,&
+ & 4.61574E-09_JPRB,4.92128E-09_JPRB,5.24420E-09_JPRB,5.58536E-09_JPRB,5.94558E-09_JPRB,&
+ & 6.32575E-09_JPRB,6.72678E-09_JPRB,7.14964E-09_JPRB,7.59526E-09_JPRB,8.06470E-09_JPRB,&
+ & 8.55897E-09_JPRB,9.07916E-09_JPRB,9.62638E-09_JPRB,1.02018E-08_JPRB,1.08066E-08_JPRB,&
+ & 1.14420E-08_JPRB,1.21092E-08_JPRB,1.28097E-08_JPRB,1.35446E-08_JPRB,1.43155E-08_JPRB,&
+ & 1.51237E-08_JPRB,1.59708E-08_JPRB,1.68581E-08_JPRB,1.77873E-08_JPRB,1.87599E-08_JPRB,&
+ & 1.97777E-08_JPRB,2.08423E-08_JPRB,2.19555E-08_JPRB,2.31190E-08_JPRB,2.43348E-08_JPRB,&
+ & 2.56045E-08_JPRB,2.69302E-08_JPRB,2.83140E-08_JPRB,2.97578E-08_JPRB,3.12636E-08_JPRB,&
+ & 3.28337E-08_JPRB,3.44702E-08_JPRB,3.61755E-08_JPRB,3.79516E-08_JPRB,3.98012E-08_JPRB,&
+ & 4.17265E-08_JPRB,4.37300E-08_JPRB,4.58143E-08_JPRB,4.79819E-08_JPRB,5.02355E-08_JPRB,&
+ & 5.25777E-08_JPRB,5.50114E-08_JPRB,5.75393E-08_JPRB,6.01644E-08_JPRB,6.28896E-08_JPRB,&
+ & 6.57177E-08_JPRB,6.86521E-08_JPRB,7.16959E-08_JPRB,7.48520E-08_JPRB,7.81239E-08_JPRB,&
+ & 8.15148E-08_JPRB,8.50282E-08_JPRB,8.86675E-08_JPRB,9.24362E-08_JPRB,9.63380E-08_JPRB,&
+ & 1.00376E-07_JPRB,1.04555E-07_JPRB,1.08878E-07_JPRB,1.13349E-07_JPRB,1.17972E-07_JPRB,&
+ & 1.22751E-07_JPRB,1.27690E-07_JPRB,1.32793E-07_JPRB,1.38064E-07_JPRB,1.43508E-07_JPRB,&
+ & 1.49129E-07_JPRB,1.54931E-07_JPRB,1.60920E-07_JPRB,1.67099E-07_JPRB,1.73473E-07_JPRB,&
+ & 1.80046E-07_JPRB,1.86825E-07_JPRB,1.93812E-07_JPRB,2.01014E-07_JPRB,2.08436E-07_JPRB,&
+ & 2.16082E-07_JPRB,2.23957E-07_JPRB,2.32067E-07_JPRB,2.40418E-07_JPRB,2.49013E-07_JPRB,&
+ & 2.57860E-07_JPRB,2.66963E-07_JPRB,2.76328E-07_JPRB,2.85961E-07_JPRB,2.95868E-07_JPRB,&
+ & 3.06053E-07_JPRB,3.16524E-07_JPRB,3.27286E-07_JPRB,3.38345E-07_JPRB,3.49707E-07_JPRB,&
+ & 3.61379E-07_JPRB,3.73367E-07_JPRB,3.85676E-07_JPRB,3.98315E-07_JPRB,4.11287E-07_JPRB,&
+ & 4.24602E-07_JPRB,4.38265E-07_JPRB,4.52283E-07_JPRB,4.66662E-07_JPRB,4.81410E-07_JPRB,&
+ & 4.96535E-07_JPRB/)  
+
+TOTPLNK(1:50,16) = (/ &
+   &  0.28639E-12_JPRB,0.33349E-12_JPRB,0.38764E-12_JPRB,0.44977E-12_JPRB,0.52093E-12_JPRB, &
+   &  0.60231E-12_JPRB,0.69522E-12_JPRB,0.80111E-12_JPRB,0.92163E-12_JPRB,0.10586E-11_JPRB, &
+   &  0.12139E-11_JPRB,0.13899E-11_JPRB,0.15890E-11_JPRB,0.18138E-11_JPRB,0.20674E-11_JPRB, &
+   &  0.23531E-11_JPRB,0.26744E-11_JPRB,0.30352E-11_JPRB,0.34401E-11_JPRB,0.38936E-11_JPRB, &
+   &  0.44011E-11_JPRB,0.49681E-11_JPRB,0.56010E-11_JPRB,0.63065E-11_JPRB,0.70919E-11_JPRB, &
+   &  0.79654E-11_JPRB,0.89357E-11_JPRB,0.10012E-10_JPRB,0.11205E-10_JPRB,0.12526E-10_JPRB, &
+   &  0.13986E-10_JPRB,0.15600E-10_JPRB,0.17380E-10_JPRB,0.19342E-10_JPRB,0.21503E-10_JPRB, &
+   &  0.23881E-10_JPRB,0.26494E-10_JPRB,0.29362E-10_JPRB,0.32509E-10_JPRB,0.35958E-10_JPRB, &
+   &  0.39733E-10_JPRB,0.43863E-10_JPRB,0.48376E-10_JPRB,0.53303E-10_JPRB,0.58679E-10_JPRB, &
+   &  0.64539E-10_JPRB,0.70920E-10_JPRB,0.77864E-10_JPRB,0.85413E-10_JPRB,0.93615E-10_JPRB/)
+TOTPLNK(51:100,16) = (/ &
+   &  0.10252E-09_JPRB,0.11217E-09_JPRB,0.12264E-09_JPRB,0.13397E-09_JPRB,0.14624E-09_JPRB, &
+   &  0.15950E-09_JPRB,0.17383E-09_JPRB,0.18930E-09_JPRB,0.20599E-09_JPRB,0.22399E-09_JPRB, &
+   &  0.24339E-09_JPRB,0.26427E-09_JPRB,0.28674E-09_JPRB,0.31090E-09_JPRB,0.33686E-09_JPRB, &
+   &  0.36474E-09_JPRB,0.39466E-09_JPRB,0.42676E-09_JPRB,0.46115E-09_JPRB,0.49800E-09_JPRB, &
+   &  0.53744E-09_JPRB,0.57964E-09_JPRB,0.62476E-09_JPRB,0.67298E-09_JPRB,0.72448E-09_JPRB, &
+   &  0.77945E-09_JPRB,0.83809E-09_JPRB,0.90062E-09_JPRB,0.96725E-09_JPRB,0.10382E-08_JPRB, &
+   &  0.11138E-08_JPRB,0.11941E-08_JPRB,0.12796E-08_JPRB,0.13704E-08_JPRB,0.14669E-08_JPRB, &
+   &  0.15694E-08_JPRB,0.16781E-08_JPRB,0.17934E-08_JPRB,0.19157E-08_JPRB,0.20453E-08_JPRB, &
+   &  0.21825E-08_JPRB,0.23278E-08_JPRB,0.24815E-08_JPRB,0.26442E-08_JPRB,0.28161E-08_JPRB, &
+   &  0.29978E-08_JPRB,0.31898E-08_JPRB,0.33925E-08_JPRB,0.36064E-08_JPRB,0.38321E-08_JPRB/)
+TOTPLNK(101:150,16) = (/ &
+   &  0.40700E-08_JPRB,0.43209E-08_JPRB,0.45852E-08_JPRB,0.48636E-08_JPRB,0.51567E-08_JPRB, &
+   &  0.54652E-08_JPRB,0.57897E-08_JPRB,0.61310E-08_JPRB,0.64897E-08_JPRB,0.68667E-08_JPRB, &
+   &  0.72626E-08_JPRB,0.76784E-08_JPRB,0.81148E-08_JPRB,0.85727E-08_JPRB,0.90530E-08_JPRB, &
+   &  0.95566E-08_JPRB,0.10084E-07_JPRB,0.10638E-07_JPRB,0.11217E-07_JPRB,0.11824E-07_JPRB, &
+   &  0.12458E-07_JPRB,0.13123E-07_JPRB,0.13818E-07_JPRB,0.14545E-07_JPRB,0.15305E-07_JPRB, &
+   &  0.16099E-07_JPRB,0.16928E-07_JPRB,0.17795E-07_JPRB,0.18699E-07_JPRB,0.19643E-07_JPRB, &
+   &  0.20629E-07_JPRB,0.21656E-07_JPRB,0.22728E-07_JPRB,0.23845E-07_JPRB,0.25010E-07_JPRB, &
+   &  0.26223E-07_JPRB,0.27487E-07_JPRB,0.28804E-07_JPRB,0.30174E-07_JPRB,0.31600E-07_JPRB, &
+   &  0.33084E-07_JPRB,0.34628E-07_JPRB,0.36233E-07_JPRB,0.37902E-07_JPRB,0.39637E-07_JPRB, &
+   &  0.41440E-07_JPRB,0.43313E-07_JPRB,0.45259E-07_JPRB,0.47279E-07_JPRB,0.49376E-07_JPRB/)
+TOTPLNK(151:181,16) = (/ &
+   &  0.51552E-07_JPRB,0.53810E-07_JPRB,0.56153E-07_JPRB,0.58583E-07_JPRB,0.61102E-07_JPRB, &
+   &  0.63713E-07_JPRB,0.66420E-07_JPRB,0.69224E-07_JPRB,0.72129E-07_JPRB,0.75138E-07_JPRB, &
+   &  0.78254E-07_JPRB,0.81479E-07_JPRB,0.84818E-07_JPRB,0.88272E-07_JPRB,0.91846E-07_JPRB, &
+   &  0.95543E-07_JPRB,0.99366E-07_JPRB,0.10332E-06_JPRB,0.10740E-06_JPRB,0.11163E-06_JPRB, &
+   &  0.11599E-06_JPRB,0.12050E-06_JPRB,0.12515E-06_JPRB,0.12996E-06_JPRB,0.13493E-06_JPRB, &
+   &  0.14005E-06_JPRB,0.14534E-06_JPRB,0.15080E-06_JPRB,0.15643E-06_JPRB,0.16224E-06_JPRB, &
+   &  0.16823E-06_JPRB/)
+
+!     -----------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SURRTPK',1,ZHOOK_HANDLE)
+END SUBROUTINE SURRTPK
Index: LMDZ6/trunk/libf/phylmd/ecrad/surrtpk.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/surrtpk.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/surrtpk.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SURRTPK
+END SUBROUTINE SURRTPK
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/surrtrf.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/surrtrf.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/surrtrf.F90	(revision 3908)
@@ -0,0 +1,174 @@
+SUBROUTINE SURRTRF
+
+!     Adapted from Eli J. Mlawer, Atmospheric & Environmental Research.
+!     by JJMorcrette, ECMWF
+!     ------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE YOERRTRF , ONLY : PREF      ,PREFLOG   ,TREF,CHI_MLS
+
+!     ------------------------------------------------------------------
+
+!     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.
+
+IMPLICIT NONE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('SURRTRF',0,ZHOOK_HANDLE)
+PREF( :) = (/&
+ & 1.05363E+03_JPRB,8.62642E+02_JPRB,7.06272E+02_JPRB,5.78246E+02_JPRB,4.73428E+02_JPRB,&
+ & 3.87610E+02_JPRB,3.17348E+02_JPRB,2.59823E+02_JPRB,2.12725E+02_JPRB,1.74164E+02_JPRB,&
+ & 1.42594E+02_JPRB,1.16746E+02_JPRB,9.55835E+01_JPRB,7.82571E+01_JPRB,6.40715E+01_JPRB,&
+ & 5.24573E+01_JPRB,4.29484E+01_JPRB,3.51632E+01_JPRB,2.87892E+01_JPRB,2.35706E+01_JPRB,&
+ & 1.92980E+01_JPRB,1.57998E+01_JPRB,1.29358E+01_JPRB,1.05910E+01_JPRB,8.67114E+00_JPRB,&
+ & 7.09933E+00_JPRB,5.81244E+00_JPRB,4.75882E+00_JPRB,3.89619E+00_JPRB,3.18993E+00_JPRB,&
+ & 2.61170E+00_JPRB,2.13828E+00_JPRB,1.75067E+00_JPRB,1.43333E+00_JPRB,1.17351E+00_JPRB,&
+ & 9.60789E-01_JPRB,7.86628E-01_JPRB,6.44036E-01_JPRB,5.27292E-01_JPRB,4.31710E-01_JPRB,&
+ & 3.53455E-01_JPRB,2.89384E-01_JPRB,2.36928E-01_JPRB,1.93980E-01_JPRB,1.58817E-01_JPRB,&
+ & 1.30029E-01_JPRB,1.06458E-01_JPRB,8.71608E-02_JPRB,7.13612E-02_JPRB,5.84256E-02_JPRB,&
+ & 4.78349E-02_JPRB,3.91639E-02_JPRB,3.20647E-02_JPRB,2.62523E-02_JPRB,2.14936E-02_JPRB,&
+ & 1.75975E-02_JPRB,1.44076E-02_JPRB,1.17959E-02_JPRB,9.65769E-03_JPRB/)  
+
+PREFLOG( :) = (/&
+ & 6.9600E+00_JPRB, 6.7600E+00_JPRB, 6.5600E+00_JPRB, 6.3600E+00_JPRB, 6.1600E+00_JPRB,&
+ & 5.9600E+00_JPRB, 5.7600E+00_JPRB, 5.5600E+00_JPRB, 5.3600E+00_JPRB, 5.1600E+00_JPRB,&
+ & 4.9600E+00_JPRB, 4.7600E+00_JPRB, 4.5600E+00_JPRB, 4.3600E+00_JPRB, 4.1600E+00_JPRB,&
+ & 3.9600E+00_JPRB, 3.7600E+00_JPRB, 3.5600E+00_JPRB, 3.3600E+00_JPRB, 3.1600E+00_JPRB,&
+ & 2.9600E+00_JPRB, 2.7600E+00_JPRB, 2.5600E+00_JPRB, 2.3600E+00_JPRB, 2.1600E+00_JPRB,&
+ & 1.9600E+00_JPRB, 1.7600E+00_JPRB, 1.5600E+00_JPRB, 1.3600E+00_JPRB, 1.1600E+00_JPRB,&
+ & 9.6000E-01_JPRB, 7.6000E-01_JPRB, 5.6000E-01_JPRB, 3.6000E-01_JPRB, 1.6000E-01_JPRB,&
+ & -4.0000E-02_JPRB,-2.4000E-01_JPRB,-4.4000E-01_JPRB,-6.4000E-01_JPRB,-8.4000E-01_JPRB,&
+ & -1.0400E+00_JPRB,-1.2400E+00_JPRB,-1.4400E+00_JPRB,-1.6400E+00_JPRB,-1.8400E+00_JPRB,&
+ & -2.0400E+00_JPRB,-2.2400E+00_JPRB,-2.4400E+00_JPRB,-2.6400E+00_JPRB,-2.8400E+00_JPRB,&
+ & -3.0400E+00_JPRB,-3.2400E+00_JPRB,-3.4400E+00_JPRB,-3.6400E+00_JPRB,-3.8400E+00_JPRB,&
+ & -4.0400E+00_JPRB,-4.2400E+00_JPRB,-4.4400E+00_JPRB,-4.6400E+00_JPRB/)  
+
+!     These are the temperatures associated with the respective 
+!     pressures for the MLS standard atmosphere. 
+TREF( :) = (/&
+ & 2.9420E+02_JPRB, 2.8799E+02_JPRB, 2.7894E+02_JPRB, 2.6925E+02_JPRB, 2.5983E+02_JPRB,&
+ & 2.5017E+02_JPRB, 2.4077E+02_JPRB, 2.3179E+02_JPRB, 2.2306E+02_JPRB, 2.1578E+02_JPRB,&
+ & 2.1570E+02_JPRB, 2.1570E+02_JPRB, 2.1570E+02_JPRB, 2.1706E+02_JPRB, 2.1858E+02_JPRB,&
+ & 2.2018E+02_JPRB, 2.2174E+02_JPRB, 2.2328E+02_JPRB, 2.2479E+02_JPRB, 2.2655E+02_JPRB,&
+ & 2.2834E+02_JPRB, 2.3113E+02_JPRB, 2.3401E+02_JPRB, 2.3703E+02_JPRB, 2.4022E+02_JPRB,&
+ & 2.4371E+02_JPRB, 2.4726E+02_JPRB, 2.5085E+02_JPRB, 2.5457E+02_JPRB, 2.5832E+02_JPRB,&
+ & 2.6216E+02_JPRB, 2.6606E+02_JPRB, 2.6999E+02_JPRB, 2.7340E+02_JPRB, 2.7536E+02_JPRB,&
+ & 2.7568E+02_JPRB, 2.7372E+02_JPRB, 2.7163E+02_JPRB, 2.6955E+02_JPRB, 2.6593E+02_JPRB,&
+ & 2.6211E+02_JPRB, 2.5828E+02_JPRB, 2.5360E+02_JPRB, 2.4854E+02_JPRB, 2.4348E+02_JPRB,&
+ & 2.3809E+02_JPRB, 2.3206E+02_JPRB, 2.2603E+02_JPRB, 2.2000E+02_JPRB, 2.1435E+02_JPRB,&
+ & 2.0887E+02_JPRB, 2.0340E+02_JPRB, 1.9792E+02_JPRB, 1.9290E+02_JPRB, 1.8809E+02_JPRB,&
+ & 1.8329E+02_JPRB, 1.7849E+02_JPRB, 1.7394E+02_JPRB, 1.7212E+02_JPRB/)  
+
+  CHI_MLS(1,1:12) = (/ &
+     &  1.8760E-02_JPRB, 1.2223E-02_JPRB, 5.8909E-03_JPRB, 2.7675E-03_JPRB, 1.4065E-03_JPRB, &
+     &  7.5970E-04_JPRB, 3.8876E-04_JPRB, 1.6542E-04_JPRB, 3.7190E-05_JPRB, 7.4765E-06_JPRB, &
+     &  4.3082E-06_JPRB, 3.3319E-06_JPRB/)
+  CHI_MLS(1,13:59) = (/ &
+     &  3.2039E-06_JPRB,  3.1619E-06_JPRB,  3.2524E-06_JPRB,  3.4226E-06_JPRB,  3.6288E-06_JPRB, &
+     &  3.9148E-06_JPRB,  4.1488E-06_JPRB,  4.3081E-06_JPRB,  4.4420E-06_JPRB,  4.5778E-06_JPRB, &
+     &  4.7087E-06_JPRB,  4.7943E-06_JPRB,  4.8697E-06_JPRB,  4.9260E-06_JPRB,  4.9669E-06_JPRB, &
+     &  4.9963E-06_JPRB,  5.0527E-06_JPRB,  5.1266E-06_JPRB,  5.2503E-06_JPRB,  5.3571E-06_JPRB, &
+     &  5.4509E-06_JPRB,  5.4830E-06_JPRB,  5.5000E-06_JPRB,  5.5000E-06_JPRB,  5.4536E-06_JPRB, &
+     &  5.4047E-06_JPRB,  5.3558E-06_JPRB,  5.2533E-06_JPRB,  5.1436E-06_JPRB,  5.0340E-06_JPRB, &
+     &  4.8766E-06_JPRB,  4.6979E-06_JPRB,  4.5191E-06_JPRB,  4.3360E-06_JPRB,  4.1442E-06_JPRB, &
+     &  3.9523E-06_JPRB,  3.7605E-06_JPRB,  3.5722E-06_JPRB,  3.3855E-06_JPRB,  3.1988E-06_JPRB, &
+     &  3.0121E-06_JPRB,  2.8262E-06_JPRB,  2.6407E-06_JPRB,  2.4552E-06_JPRB,  2.2696E-06_JPRB, &
+     &  4.3360E-06_JPRB,  4.1442E-06_JPRB/)
+  CHI_MLS(2,1:12) = (/ &
+     &  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB, &
+     &  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB, &
+     &  3.5500E-04_JPRB,  3.5500E-04_JPRB/)
+  CHI_MLS(2,13:59) = (/ &
+     &  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB, &
+     &  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB, &
+     &  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB, &
+     &  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB, &
+     &  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB, &
+     &  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB, &
+     &  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB, &
+     &  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB,  3.5500E-04_JPRB, &
+     &  3.5500E-04_JPRB,  3.5471E-04_JPRB,  3.5427E-04_JPRB,  3.5384E-04_JPRB,  3.5340E-04_JPRB, &
+     &  3.5500E-04_JPRB,  3.5500E-04_JPRB/)
+  CHI_MLS(3,1:12) = (/ &
+     &  3.0170E-08_JPRB,  3.4725E-08_JPRB,  4.2477E-08_JPRB,  5.2759E-08_JPRB,  6.6944E-08_JPRB, &
+     &  8.7130E-08_JPRB,  1.1391E-07_JPRB,  1.5677E-07_JPRB,  2.1788E-07_JPRB,  3.2443E-07_JPRB, &
+     &  4.6594E-07_JPRB,  5.6806E-07_JPRB/)
+  CHI_MLS(3,13:59) = (/ &
+     &  6.9607E-07_JPRB,  1.1186E-06_JPRB,  1.7618E-06_JPRB,  2.3269E-06_JPRB,  2.9577E-06_JPRB, &
+     &  3.6593E-06_JPRB,  4.5950E-06_JPRB,  5.3189E-06_JPRB,  5.9618E-06_JPRB,  6.5113E-06_JPRB, &
+     &  7.0635E-06_JPRB,  7.6917E-06_JPRB,  8.2577E-06_JPRB,  8.7082E-06_JPRB,  8.8325E-06_JPRB, &
+     &  8.7149E-06_JPRB,  8.0943E-06_JPRB,  7.3307E-06_JPRB,  6.3101E-06_JPRB,  5.3672E-06_JPRB, &
+     &  4.4829E-06_JPRB,  3.8391E-06_JPRB,  3.2827E-06_JPRB,  2.8235E-06_JPRB,  2.4906E-06_JPRB, &
+     &  2.1645E-06_JPRB,  1.8385E-06_JPRB,  1.6618E-06_JPRB,  1.5052E-06_JPRB,  1.3485E-06_JPRB, &
+     &  1.1972E-06_JPRB,  1.0482E-06_JPRB,  8.9926E-07_JPRB,  7.6343E-07_JPRB,  6.5381E-07_JPRB, &
+     &  5.4419E-07_JPRB,  4.3456E-07_JPRB,  3.6421E-07_JPRB,  3.1194E-07_JPRB,  2.5967E-07_JPRB, &
+     &  2.0740E-07_JPRB,  1.9146E-07_JPRB,  1.9364E-07_JPRB,  1.9582E-07_JPRB,  1.9800E-07_JPRB, &
+     &  7.6343E-07_JPRB,  6.5381E-07_JPRB/)
+  CHI_MLS(4,1:12) = (/ &
+     &  3.2000E-07_JPRB,  3.2000E-07_JPRB,  3.2000E-07_JPRB,  3.2000E-07_JPRB,  3.2000E-07_JPRB, &
+     &  3.1965E-07_JPRB,  3.1532E-07_JPRB,  3.0383E-07_JPRB,  2.9422E-07_JPRB,  2.8495E-07_JPRB, &
+     &  2.7671E-07_JPRB,  2.6471E-07_JPRB/)
+  CHI_MLS(4,13:59) = (/ &
+     &  2.4285E-07_JPRB,  2.0955E-07_JPRB,  1.7195E-07_JPRB,  1.3749E-07_JPRB,  1.1332E-07_JPRB, &
+     &  1.0035E-07_JPRB,  9.1281E-08_JPRB,  8.5463E-08_JPRB,  8.0363E-08_JPRB,  7.3372E-08_JPRB, &
+     &  6.5975E-08_JPRB,  5.6039E-08_JPRB,  4.7090E-08_JPRB,  3.9977E-08_JPRB,  3.2979E-08_JPRB, &
+     &  2.6064E-08_JPRB,  2.1066E-08_JPRB,  1.6592E-08_JPRB,  1.3017E-08_JPRB,  1.0090E-08_JPRB, &
+     &  7.6249E-09_JPRB,  6.1159E-09_JPRB,  4.6672E-09_JPRB,  3.2857E-09_JPRB,  2.8484E-09_JPRB, &
+     &  2.4620E-09_JPRB,  2.0756E-09_JPRB,  1.8551E-09_JPRB,  1.6568E-09_JPRB,  1.4584E-09_JPRB, &
+     &  1.3195E-09_JPRB,  1.2072E-09_JPRB,  1.0948E-09_JPRB,  9.9780E-10_JPRB,  9.3126E-10_JPRB, &
+     &  8.6472E-10_JPRB,  7.9818E-10_JPRB,  7.5138E-10_JPRB,  7.1367E-10_JPRB,  6.7596E-10_JPRB, &
+     &  6.3825E-10_JPRB,  6.0981E-10_JPRB,  5.8600E-10_JPRB,  5.6218E-10_JPRB,  5.3837E-10_JPRB, &
+     &  9.9780E-10_JPRB,  9.3126E-10_JPRB/)
+  CHI_MLS(5,1:12) = (/ &
+     &  1.5000E-07_JPRB,  1.4306E-07_JPRB,  1.3474E-07_JPRB,  1.3061E-07_JPRB,  1.2793E-07_JPRB, &
+     &  1.2038E-07_JPRB,  1.0798E-07_JPRB,  9.4238E-08_JPRB,  7.9488E-08_JPRB,  6.1386E-08_JPRB, &
+     &  4.5563E-08_JPRB,  3.3475E-08_JPRB/)
+  CHI_MLS(5,13:59) = (/ &
+     &  2.5118E-08_JPRB,  1.8671E-08_JPRB,  1.4349E-08_JPRB,  1.2501E-08_JPRB,  1.2407E-08_JPRB, &
+     &  1.3472E-08_JPRB,  1.4900E-08_JPRB,  1.6079E-08_JPRB,  1.7156E-08_JPRB,  1.8616E-08_JPRB, &
+     &  2.0106E-08_JPRB,  2.1654E-08_JPRB,  2.3096E-08_JPRB,  2.4340E-08_JPRB,  2.5643E-08_JPRB, &
+     &  2.6990E-08_JPRB,  2.8456E-08_JPRB,  2.9854E-08_JPRB,  3.0943E-08_JPRB,  3.2023E-08_JPRB, &
+     &  3.3101E-08_JPRB,  3.4260E-08_JPRB,  3.5360E-08_JPRB,  3.6397E-08_JPRB,  3.7310E-08_JPRB, &
+     &  3.8217E-08_JPRB,  3.9123E-08_JPRB,  4.1303E-08_JPRB,  4.3652E-08_JPRB,  4.6002E-08_JPRB, &
+     &  5.0289E-08_JPRB,  5.5446E-08_JPRB,  6.0603E-08_JPRB,  6.8946E-08_JPRB,  8.3652E-08_JPRB, &
+     &  9.8357E-08_JPRB,  1.1306E-07_JPRB,  1.4766E-07_JPRB,  1.9142E-07_JPRB,  2.3518E-07_JPRB, &
+     &  2.7894E-07_JPRB,  3.5001E-07_JPRB,  4.3469E-07_JPRB,  5.1938E-07_JPRB,  6.0407E-07_JPRB, &
+     &  6.8946E-08_JPRB,  8.3652E-08_JPRB/)
+  CHI_MLS(6,1:12) = (/ &
+     &  1.7000E-06_JPRB,  1.7000E-06_JPRB,  1.6999E-06_JPRB,  1.6904E-06_JPRB,  1.6671E-06_JPRB, &
+     &  1.6351E-06_JPRB,  1.6098E-06_JPRB,  1.5590E-06_JPRB,  1.5120E-06_JPRB,  1.4741E-06_JPRB, &
+     &  1.4385E-06_JPRB,  1.4002E-06_JPRB/)
+  CHI_MLS(6,13:59) = (/ &
+     &  1.3573E-06_JPRB,  1.3130E-06_JPRB,  1.2512E-06_JPRB,  1.1668E-06_JPRB,  1.0553E-06_JPRB, &
+     &  9.3281E-07_JPRB,  8.1217E-07_JPRB,  7.5239E-07_JPRB,  7.0728E-07_JPRB,  6.6722E-07_JPRB, &
+     &  6.2733E-07_JPRB,  5.8604E-07_JPRB,  5.4769E-07_JPRB,  5.1480E-07_JPRB,  4.8206E-07_JPRB, &
+     &  4.4943E-07_JPRB,  4.1702E-07_JPRB,  3.8460E-07_JPRB,  3.5200E-07_JPRB,  3.1926E-07_JPRB, &
+     &  2.8646E-07_JPRB,  2.5498E-07_JPRB,  2.2474E-07_JPRB,  1.9588E-07_JPRB,  1.8295E-07_JPRB, &
+     &  1.7089E-07_JPRB,  1.5882E-07_JPRB,  1.5536E-07_JPRB,  1.5304E-07_JPRB,  1.5072E-07_JPRB, &
+     &  1.5000E-07_JPRB,  1.5000E-07_JPRB,  1.5000E-07_JPRB,  1.5000E-07_JPRB,  1.5000E-07_JPRB, &
+     &  1.5000E-07_JPRB,  1.5000E-07_JPRB,  1.5000E-07_JPRB,  1.5000E-07_JPRB,  1.5000E-07_JPRB, &
+     &  1.5000E-07_JPRB,  1.5000E-07_JPRB,  1.5000E-07_JPRB,  1.5000E-07_JPRB,  1.5000E-07_JPRB, &
+     &  1.5000E-07_JPRB,  1.5000E-07_JPRB/)
+  CHI_MLS(7,1:12) = (/ &
+     &  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB, &
+     &  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB, &
+     &  0.2090_JPRB,  0.2090_JPRB/)
+  CHI_MLS(7,13:59) = (/ &
+     &  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB, &
+     &  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB, &
+     &  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB, &
+     &  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB, &
+     &  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB, &
+     &  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB, &
+     &  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB, &
+     &  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB, &
+     &  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB,  0.2090_JPRB, &
+     &  0.2090_JPRB,  0.2090_JPRB/)
+
+
+!     -----------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SURRTRF',1,ZHOOK_HANDLE)
+END SUBROUTINE SURRTRF
Index: LMDZ6/trunk/libf/phylmd/ecrad/surrtrf.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/surrtrf.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/surrtrf.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SURRTRF
+END SUBROUTINE SURRTRF
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/susrtm.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/susrtm.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/susrtm.F90	(revision 3908)
@@ -0,0 +1,324 @@
+SUBROUTINE SUSRTM
+
+!     Adapted from E.J. Mlawer, J. Delamere, Atmospheric & Environmental Research.
+!     by JJMorcrette, ECMWF
+!     Modified to add arrays relevant to mapping for g-point reduction,
+!     M.J. Iacono, Atmospheric & Environmental Research, Inc. 
+!     JJMorcrette 20010610 Flexible configuration for number of g-points
+!     ------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPRB ,   JPIM
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE YOESRTM  , ONLY : JPGPT, NGBSW, NGN
+USE YOESRTWN , ONLY : NG      , NSPA, NSPB   , NMPSRTM, &
+ & PREF    , PREFLOG , TREF   , &
+ & NGM     , WT      , NGC    , NGS
+! & NGM     , WT      , NGC    , NGS , NGN    , NGBSW
+! & WAVENUM1, WAVENUM2, DELWAVE, PREF, PREFLOG, TREF   , &
+
+!     ------------------------------------------------------------------
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM) :: IGC56(14), IGC112(14) , IGC224(14)
+INTEGER(KIND=JPIM) :: IGS56(14), IGS112(14) , IGS224(14)
+
+INTEGER(KIND=JPIM) :: IGM56(224),IGM112(224), IGM224(224)
+
+INTEGER(KIND=JPIM) :: IGN56(56), IGN112(112), IGN224(224)
+INTEGER(KIND=JPIM) :: IGB56(56), IGB112(112), IGB224(224)
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-----------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SUSRTM',0,ZHOOK_HANDLE)
+
+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 /)
+NMPSRTM(:)=(/  6, 6, 5, 5, 5, 5, 5, 4, 4, 3, 2, 2, 1, 6 /)
+
+!WAVENUM1( :) = (/&
+! & 2600._JPRB, 3250._JPRB, 4000._JPRB, 4650._JPRB, 5150._JPRB, 6150._JPRB, 7700._JPRB &
+! & , 8050._JPRB,12850._JPRB,16000._JPRB,22650._JPRB,29000._JPRB,38000._JPRB,  820._JPRB /)  
+!WAVENUM2( :) = (/&
+! & 3250._JPRB, 4000._JPRB, 4650._JPRB, 5150._JPRB, 6150._JPRB, 7700._JPRB, 8050._JPRB &
+! & ,12850._JPRB,16000._JPRB,22650._JPRB,29000._JPRB,38000._JPRB,50000._JPRB, 2600._JPRB /)  
+!DELWAVE( :) = (/&
+! & 650._JPRB,  750._JPRB,  650._JPRB,  500._JPRB, 1000._JPRB, 1550._JPRB,  350._JPRB &
+! & , 4800._JPRB, 3150._JPRB, 6650._JPRB, 6350._JPRB, 9000._JPRB,12000._JPRB, 1780._JPRB /)  
+
+!=====================================================================
+! Set arrays needed for the g-point reduction from 224 to 
+! - either 112 for the high-resolution forecast model configuration
+! - or 56 for the EPS-type configuration  
+! in the 14 SW bands:
+
+! NB: 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 further reduction to 56 for EPS configuration is considered 
+! acceptable, only because of the random perturbations introduced on 
+! the total heating rates produced by the physical parametrization package.
+! While a reduction to 56 obviously speeds up the model, it as obviously 
+! reduces the accuracy that could be expected from the radiation scheme.
+
+! JPGPT   The total number of new g-points (NGPT)
+! NGC     The number of new g-points in each band (14)
+! NGS     The cumulative sum of new g-points for each band (14)
+! 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. (16)
+
+!-- ECMWF EPS model RRTM_SW configuration with 56 g-points
+IGC56(:) = (/ 3, 6, 4, 4, 5, 5, 1, 5, 4, 3, 3, 4, 3, 6 /)
+IGS56(:) = (/ 3, 9,13,17,22,27,28,33,37,40,43,47, 50, 56 /)
+
+IGM56(:) = (/ 1,1,1,1,2,2,2,2,3,3,3,3,3,3,3,3, &            ! Band 16
+            & 1,1,2,2,3,3,3,4,4,4,5,5,5,6,6,6, &            ! Band 17
+            & 1,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4, &            ! Band 18
+            & 1,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4, &            ! Band 19
+            & 1,1,2,2,3,3,4,4,5,5,5,5,5,5,5,5, &            ! Band 20
+            & 1,1,2,2,3,3,4,4,5,5,5,5,5,5,5,5, &            ! Band 21
+            & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &            ! Band 22
+            & 1,1,1,1,2,2,3,3,4,4,5,5,5,5,5,5, &            ! Band 23
+            & 1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4, &            ! Band 24
+            & 1,1,2,2,2,2,3,3,3,3,3,3,3,3,3,3, &            ! Band 25
+            & 1,1,2,2,2,2,3,3,3,3,3,3,3,3,3,3, &            ! Band 26
+            & 1,1,2,2,3,3,4,4,4,4,4,4,4,4,4,4, &            ! Band 27
+            & 1,1,2,2,2,2,3,3,3,3,3,3,3,3,3,3, &            ! Band 28
+            & 1,1,2,2,3,3,3,3,4,4,4,4,5,5,6,6 /)            ! Band 29
+
+IGN56(:) = (/ 4,4,8, &                                     ! Band 16
+            & 2,2,3,3,3,3, &                               ! Band 17
+            & 2,2,4,8, &                                   ! Band 18
+            & 2,2,4,8, &                                   ! Band 19
+            & 2,2,2,2,8, &                                 ! Band 20
+            & 2,2,2,2,8, &                                 ! Band 21
+            & 16, &                                        ! Band 22
+            & 4,2,2,2,6, &                                 ! Band 23
+            & 4,4,4,4, &                                   ! Band 24
+            & 2,4,10, &                                    ! Band 25
+            & 2,4,10, &                                    ! Band 26
+            & 2,2,2,10, &                                  ! Band 27
+            & 2,4,10, &                                    ! Band 28
+            & 2,2,4,4,2,2 /)                               ! Band 29
+
+IGB56(:) = (/ 16,16,16, &                                  ! Band 16
+            & 17,17,17,17,17,17, &                         ! Band 17
+            & 18,18,18,18, &                               ! Band 18
+            & 19,19,19,19, &                               ! Band 19
+            & 20,20,20,20,20, &                            ! Band 20
+            & 21,21,21,21,21, &                            ! Band 21
+            & 22, &                                        ! Band 22
+            & 23,23,23,23,23, &                            ! Band 23
+            & 24,24,24,24, &                               ! Band 24
+            & 25,25,25, &                                  ! Band 25
+            & 26,26,26, &                                  ! Band 26
+            & 27,27,27,27, &                               ! Band 27
+            & 28,28,28, &                                  ! Band 28
+            & 29,29,29,29,29,29 /)                         ! Band 29
+
+!-------------------------------------------------------------------------------
+!-- ECMWF high-resolution model RRTM_SW configuration with 112 g-points
+! Use this NGC, NGS, NGM, and NGN for reduced (112) g-point set
+! (A related code change is required in modules parsrtm.F90 and yoesrtwn.F90)
+
+IGC112(:) = (/ 6,12, 8, 8,10,10, 2,10, 8, 6, 6, 8, 6,12 /)
+IGS112(:) = (/ 6,18,26,34,44,54,56,66,74,80,86,94,100,112 /)
+
+!NGM(:)
+IGM112(:) = (/ 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(:)
+IGN112(:) = (/ 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
+!NGBSW(:)
+IGB112(:) = (/ 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
+
+!-------------------------------------------------------------------------------
+!-- original RRTM_SW configuration with 224 (14*16 g-points)
+! Use this NGC, NGS, NGM, and NGN for full (224) g-point set
+! (A related code change is required in modules parsrtm.F90 and yoesrtwn.F90)
+IGC224(:) = (/ 16,16,16,16,16,16,16,16,16,16,16,16,16,16 /)
+IGS224(:) = (/ 16,32,48,64,80,96,112,128,144,160,176,192,208,224 /)
+
+IGM224(:) = (/ 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
+
+IGN224(:) = (/ 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
+
+IGB224(:) = (/ 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,28 /)   ! Band 29
+
+!=============================================================================
+
+WT(:) =  (/ 0.1527534276_JPRB, 0.1491729617_JPRB, 0.1420961469_JPRB, &
+          & 0.1316886544_JPRB, 0.1181945205_JPRB, 0.1019300893_JPRB, &
+          & 0.0832767040_JPRB, 0.0626720116_JPRB, 0.0424925000_JPRB, &
+          & 0.0046269894_JPRB, 0.0038279891_JPRB, 0.0030260086_JPRB, &
+          & 0.0022199750_JPRB, 0.0014140010_JPRB, 0.0005330000_JPRB, &
+          & 0.0000750000_JPRB /)
+
+!=============================================================================
+
+! 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_JPRB,8.62642E+02_JPRB,7.06272E+02_JPRB,5.78246E+02_JPRB,4.73428E+02_JPRB, &
+ & 3.87610E+02_JPRB,3.17348E+02_JPRB,2.59823E+02_JPRB,2.12725E+02_JPRB,1.74164E+02_JPRB, &
+ & 1.42594E+02_JPRB,1.16746E+02_JPRB,9.55835E+01_JPRB,7.82571E+01_JPRB,6.40715E+01_JPRB, &
+ & 5.24573E+01_JPRB,4.29484E+01_JPRB,3.51632E+01_JPRB,2.87892E+01_JPRB,2.35706E+01_JPRB, &
+ & 1.92980E+01_JPRB,1.57998E+01_JPRB,1.29358E+01_JPRB,1.05910E+01_JPRB,8.67114E+00_JPRB, &
+ & 7.09933E+00_JPRB,5.81244E+00_JPRB,4.75882E+00_JPRB,3.89619E+00_JPRB,3.18993E+00_JPRB, &
+ & 2.61170E+00_JPRB,2.13828E+00_JPRB,1.75067E+00_JPRB,1.43333E+00_JPRB,1.17351E+00_JPRB, &
+ & 9.60789E-01_JPRB,7.86628E-01_JPRB,6.44036E-01_JPRB,5.27292E-01_JPRB,4.31710E-01_JPRB, &
+ & 3.53455E-01_JPRB,2.89384E-01_JPRB,2.36928E-01_JPRB,1.93980E-01_JPRB,1.58817E-01_JPRB, &
+ & 1.30029E-01_JPRB,1.06458E-01_JPRB,8.71608E-02_JPRB,7.13612E-02_JPRB,5.84256E-02_JPRB, &
+ & 4.78349E-02_JPRB,3.91639E-02_JPRB,3.20647E-02_JPRB,2.62523E-02_JPRB,2.14936E-02_JPRB, &
+ & 1.75975E-02_JPRB,1.44076E-02_JPRB,1.17959E-02_JPRB,9.65769E-03_JPRB /)  
+PREFLOG = (/ &
+ & 6.9600E+00_JPRB, 6.7600E+00_JPRB, 6.5600E+00_JPRB, 6.3600E+00_JPRB, 6.1600E+00_JPRB, &
+ & 5.9600E+00_JPRB, 5.7600E+00_JPRB, 5.5600E+00_JPRB, 5.3600E+00_JPRB, 5.1600E+00_JPRB, &
+ & 4.9600E+00_JPRB, 4.7600E+00_JPRB, 4.5600E+00_JPRB, 4.3600E+00_JPRB, 4.1600E+00_JPRB, &
+ & 3.9600E+00_JPRB, 3.7600E+00_JPRB, 3.5600E+00_JPRB, 3.3600E+00_JPRB, 3.1600E+00_JPRB, &
+ & 2.9600E+00_JPRB, 2.7600E+00_JPRB, 2.5600E+00_JPRB, 2.3600E+00_JPRB, 2.1600E+00_JPRB, &
+ & 1.9600E+00_JPRB, 1.7600E+00_JPRB, 1.5600E+00_JPRB, 1.3600E+00_JPRB, 1.1600E+00_JPRB, &
+ & 9.6000E-01_JPRB, 7.6000E-01_JPRB, 5.6000E-01_JPRB, 3.6000E-01_JPRB, 1.6000E-01_JPRB, &
+ & -4.0000E-02_JPRB,-2.4000E-01_JPRB,-4.4000E-01_JPRB,-6.4000E-01_JPRB,-8.4000E-01_JPRB, &
+ & -1.0400E+00_JPRB,-1.2400E+00_JPRB,-1.4400E+00_JPRB,-1.6400E+00_JPRB,-1.8400E+00_JPRB, &
+ & -2.0400E+00_JPRB,-2.2400E+00_JPRB,-2.4400E+00_JPRB,-2.6400E+00_JPRB,-2.8400E+00_JPRB, &
+ & -3.0400E+00_JPRB,-3.2400E+00_JPRB,-3.4400E+00_JPRB,-3.6400E+00_JPRB,-3.8400E+00_JPRB, &
+ & -4.0400E+00_JPRB,-4.2400E+00_JPRB,-4.4400E+00_JPRB,-4.6400E+00_JPRB /)  
+! These are the temperatures associated with the respective 
+! pressures for the MLS standard atmosphere. 
+TREF = (/ &
+ & 2.9420E+02_JPRB, 2.8799E+02_JPRB, 2.7894E+02_JPRB, 2.6925E+02_JPRB, 2.5983E+02_JPRB, &
+ & 2.5017E+02_JPRB, 2.4077E+02_JPRB, 2.3179E+02_JPRB, 2.2306E+02_JPRB, 2.1578E+02_JPRB, &
+ & 2.1570E+02_JPRB, 2.1570E+02_JPRB, 2.1570E+02_JPRB, 2.1706E+02_JPRB, 2.1858E+02_JPRB, &
+ & 2.2018E+02_JPRB, 2.2174E+02_JPRB, 2.2328E+02_JPRB, 2.2479E+02_JPRB, 2.2655E+02_JPRB, &
+ & 2.2834E+02_JPRB, 2.3113E+02_JPRB, 2.3401E+02_JPRB, 2.3703E+02_JPRB, 2.4022E+02_JPRB, &
+ & 2.4371E+02_JPRB, 2.4726E+02_JPRB, 2.5085E+02_JPRB, 2.5457E+02_JPRB, 2.5832E+02_JPRB, &
+ & 2.6216E+02_JPRB, 2.6606E+02_JPRB, 2.6999E+02_JPRB, 2.7340E+02_JPRB, 2.7536E+02_JPRB, &
+ & 2.7568E+02_JPRB, 2.7372E+02_JPRB, 2.7163E+02_JPRB, 2.6955E+02_JPRB, 2.6593E+02_JPRB, &
+ & 2.6211E+02_JPRB, 2.5828E+02_JPRB, 2.5360E+02_JPRB, 2.4854E+02_JPRB, 2.4348E+02_JPRB, &
+ & 2.3809E+02_JPRB, 2.3206E+02_JPRB, 2.2603E+02_JPRB, 2.2000E+02_JPRB, 2.1435E+02_JPRB, &
+ & 2.0887E+02_JPRB, 2.0340E+02_JPRB, 1.9792E+02_JPRB, 1.9290E+02_JPRB, 1.8809E+02_JPRB, &
+ & 1.8329E+02_JPRB, 1.7849E+02_JPRB, 1.7394E+02_JPRB, 1.7212E+02_JPRB /)  
+!     -----------------------------------------------------------------
+
+IF (JPGPT == 56) THEN
+
+!- 14
+  NGC(:)=IGC56(:)
+  NGS(:)=IGS56(:)
+!- 14*16=224
+  NGM(:)=IGM56(:)
+
+  NGN(1:56)=IGN56(1:56)
+  NGBSW(1:56)=IGB56(1:56)
+
+ELSEIF (JPGPT == 112) THEN
+!- 14
+  NGC(:)=IGC112(:)
+  NGS(:)=IGS112(:)
+!- 14*16=224
+  NGM(:)=IGM112(:)
+
+  NGN(1:112)=IGN112(1:112)
+  NGBSW(1:112)=IGB112(1:112)
+
+ELSEIF (JPGPT == 224) THEN
+!- 14
+  NGC(:)=IGC224(:)
+  NGS(:)=IGS224(:)
+!- 14*16=224
+  NGM(:)=IGM224(:)
+
+  NGN(1:224)=IGN224(1:224)
+  NGBSW(1:224)=IGB224(1:224)
+
+ENDIF
+
+!     -----------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SUSRTM',1,ZHOOK_HANDLE)
+END SUBROUTINE SUSRTM
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/susrtm.intfb.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/susrtm.intfb.h	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/susrtm.intfb.h	(revision 3908)
@@ -0,0 +1,4 @@
+INTERFACE
+SUBROUTINE SUSRTM
+END SUBROUTINE SUSRTM
+END INTERFACE
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoeaeratm.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoeaeratm.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoeaeratm.F90	(revision 3908)
@@ -0,0 +1,91 @@
+MODULE YOEAERATM
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+
+IMPLICIT NONE
+
+SAVE
+
+!     ------------------------------------------------------------------
+!*    ** *YOEAERATM* - CONTROL PARAMETERS FOR AEROSOLS IN THE ATMOSPHERE
+!     ------------------------------------------------------------------
+
+INTEGER(KIND=JPIM) :: NAERCONF
+INTEGER(KIND=JPIM) :: NINIDAY   
+INTEGER(KIND=JPIM) :: NXT3DAER
+INTEGER(KIND=JPIM) :: NDD1, NSS1
+INTEGER(KIND=JPIM) :: NBCOPTP, NDDOPTP, NOMOPTP, NSSOPTP, NSUOPTP
+INTEGER(KIND=JPIM) :: NVISWL
+INTEGER(KIND=JPIM) :: NDRYDEP
+INTEGER(KIND=JPIM) :: NWHTDDEP, NTDDEP, NINDDDEP(15)
+INTEGER(KIND=JPIM) :: NWHTSCAV, NTSCAV, NINDSCAV(15)
+INTEGER(KIND=JPIM) :: NWHTSEDM, NTSEDM, NINDSEDM(15)
+INTEGER(KIND=JPIM) :: NWHTWDEP, NTWDEP, NINDWDEP(15)
+
+REAL(KIND=JPRB) :: RGRATE
+REAL(KIND=JPRB) :: RMASSE(15)
+
+REAL(KIND=JPRB) :: REPSCAER
+
+LOGICAL :: LAERCLIMG, LAERCLIMZ, LAERCLIST, LAERDRYDP, LAERHYGRO, LAERLISI 
+LOGICAL :: LAERNGAT , LAERSCAV , LAERSEDIM, LAERSURF , LAERELVS , LAER6SDIA
+LOGICAL :: LAERGTOP , LAERRAD  , LAERCCN  , LAEROPT(8),LAERINIT , LAERVOL
+LOGICAL :: LAERCSTR , LAERDIAG1, LAERDIAG2, LAERRRTM , LAERUVP  , LUVINDX   
+LOGICAL :: LAEREXTR , LAERGBUD , LAERPRNT , LAERCALIP
+
+!     ------------------------------------------------------------------
+! NDD1       : location of first bin for desert dust
+! NSS1       : location of first bin for sea-salt
+! NBCOPTP    : index for choosing the black carbon LW and SW optic.prop. (1: Boucher, 2: Bond, Bergstrom, 3: Stier et al.)
+! NDDOPTP    : index for choosing the dust LW and SW optic.prop. (1: Boucher, 2: Highwood, 3: Woodward)
+! NOMOPTP    : index for choosing the organic carbon optic.prop.
+! NSSOPTP    : index for choosing the sea salt optic.prop.
+! NSUOPTP    : index for choosing the sulphate optic.prop.
+! NVISWL     : index of wavelength for visibility computations
+! RMFMIN     : minimum mass flux for convective aerosol transport
+! RGRATE     : transformation rate from hygrophopic to hygrophilic for BC and OM aerosols
+! RMASSE     : Molar mass: N.B.: either g/mol or Avogadro number
+
+! REPSCAER   : security on aerosol concentration: always >= 1.E-15
+
+! LAERCLIMG  : .T. to start prognostic aerosols with geographical monthly 
+!                  mean climatology
+! LAERCLIMZ  : .T. to start prognostic aerosols with zonal annual mean 
+!                  climatology
+! LAERCLIST  : .T. to start prognostic aerosols with geographical monthly 
+!                  mean climatology for background stratospheric only
+! LAERDRYDP  : .T. dry deposition is active
+! LAERHYDRO  : .T. hygroscopic effects on BC and OM aerosols
+! LAERNGAT   : .T. prevents negative aerosol concentrations
+! LAERSCAV   : .T. in-cloud and below cloud scavenging is active
+! LAERSEDIM  : .T. sedimentation is active
+! LAERSURF   : .T. if surface emissions
+! LAERELVS   : .T. if "elevated" source
+! LAER6SDIA  : .T. if radiance diagnostics with 6S
+! LAERGTOP   : .T. if gas-to-particle conversion for SO2/SO4
+! LAERRAD    : .T. if there is any prognostic aerosols used for RT
+! LAEROPT(.) : .T. if a given aerosol type is radiatively interactive
+! LAERCCN    : .T. if prognostic aerosols are used to define the Re of liq.wat.clds
+! LAERUVP    : .T. if prognostic aerosols are used in UV-processor
+! LAERCSTR   : .T. if climatological stratospheric aerosols are used in radiation 
+!                  schemes with the prognostic tropospheric aerosols.
+! LAERRRTM   : .T. if RRTM schemes get the information from the prognostic aerosols
+! LAERINIT   : .T. if analysed prognostic aerosols are ONLY used as "climatological" aerosols
+! LAERVOL    : .T. if volcanic aerosol is considered
+! NDRYDEP    : dry deposition 1: a la GEMS; 2: "exp" (a la D_GRG_4.6)
+! NWHTDDEP   : =0 only SS+DU;  =1 SS+DU+VOL;  =2 SS+DU+OM+BC+SU+VOL
+! NTDDEP     : total number of aerosol species to be in- and below-cloud scavenged
+! NINDDDEP   : actual set of aerosol indices to be dry deposited
+! NWHTSEDM   : =0 only SS+DU;  =1 SS+DU+VOL;  =2 SS+DU+OM+BC+SU+VOL
+! NTSEDM     : total number of aerosol species to be in- and below-cloud scavenged
+! NINDSEDM   : actual set of aerosol indices to be sedimented
+! NWHTWDEP   : =0 only SS+DU;  =1 SS+DU+VOL;  =2 SS+DU+OM+BC+SU+VOL
+! NTWDEP     : total number of aerosol species to be in- and below-cloud scavenged
+! NINDWDEP   : actual set of aerosol indices to be scavenged
+! NWHTSCAV   : =0 only SS+DU;  =1 SS+DU+VOL;  =2 SS+DU+OM+BC+SU+VOL
+! NTSCAV     : total number of aerosol species to be in- and below-cloud scavenged
+! NINDSCAV   : actual set of aerosol indices to be scavenged
+! LAERCALIP  : .T. works with LAERLISI=t, store only the CALIOP-type profile at 532 nm
+!     ------------------------------------------------------------------
+END MODULE YOEAERATM
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerad.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerad.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerad.F90	(revision 3908)
@@ -0,0 +1,237 @@
+MODULE YOERAD
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+
+IMPLICIT NONE
+
+SAVE
+
+!     ------------------------------------------------------------------
+!*    ** *YOERAD* - CONTROL OPTIONS FOR RADIATION CONFIGURATION
+!     ------------------------------------------------------------------
+
+INTEGER(KIND=JPIM) :: NAER
+INTEGER(KIND=JPIM) :: NMODE
+INTEGER(KIND=JPIM) :: NOZOCL
+INTEGER(KIND=JPIM) :: NRADFR
+INTEGER(KIND=JPIM) :: NRADPFR
+INTEGER(KIND=JPIM) :: NRADPLA
+INTEGER(KIND=JPIM) :: NRADINT
+INTEGER(KIND=JPIM) :: NRADRES
+INTEGER(KIND=JPIM) :: NRADNFR
+INTEGER(KIND=JPIM) :: NRADSFR
+INTEGER(KIND=JPIM) :: NRADE1H, NRADE3H
+INTEGER(KIND=JPIM) :: NRADELG
+INTEGER(KIND=JPIM) :: NOVLP
+INTEGER(KIND=JPIM) :: NRPROMA
+INTEGER(KIND=JPIM) :: NSW
+INTEGER(KIND=JPIM) :: NSWNL
+INTEGER(KIND=JPIM) :: NSWTL
+INTEGER(KIND=JPIM) :: NTSW
+INTEGER(KIND=JPIM) :: NUV
+INTEGER(KIND=JPIM) :: NCSRADF
+INTEGER(KIND=JPIM) :: NICEOPT
+INTEGER(KIND=JPIM) :: NLIQOPT
+INTEGER(KIND=JPIM) :: NRADIP
+INTEGER(KIND=JPIM) :: NRADLP
+INTEGER(KIND=JPIM) :: NINHOM
+INTEGER(KIND=JPIM) :: NLAYINH
+INTEGER(KIND=JPIM) :: NLNGR1H
+INTEGER(KIND=JPIM) :: NPERTAER
+INTEGER(KIND=JPIM) :: NPERTOZ
+INTEGER(KIND=JPIM) :: NSCEN
+INTEGER(KIND=JPIM) :: NHINCSOL
+INTEGER(KIND=JPIM) :: NMCICA
+INTEGER(KIND=JPIM) :: NGHGRAD
+INTEGER(KIND=JPIM) :: NDECOLAT
+INTEGER(KIND=JPIM) :: NMINICE
+INTEGER(KIND=JPIM) :: NVOLCVERT
+INTEGER(KIND=JPIM) :: NREDGLW
+INTEGER(KIND=JPIM) :: NREDGSW
+INTEGER(KIND=JPIM) :: NSPMAPL(16), NSPMAPS(14)
+
+LOGICAL :: LERAD1H
+LOGICAL :: LEPO3RA
+LOGICAL :: LONEWSW
+LOGICAL :: LECSRAD
+LOGICAL :: LRRTM
+LOGICAL :: LSRTM
+LOGICAL :: LDIFFC
+LOGICAL :: LHVOLCA
+LOGICAL :: LNEWAER
+LOGICAL :: LNOTROAER
+LOGICAL :: LRAYL
+LOGICAL :: LOPTRPROMA
+LOGICAL :: LECO2VAR
+LOGICAL :: LHGHG
+LOGICAL :: LEMODAL
+LOGICAL :: LESO4HIS
+LOGICAL :: LETRACGMS
+LOGICAL :: LAERCLIM, LAERVISI
+LOGICAL :: LVOLCSPEC
+LOGICAL :: LVOLCDAMP
+LOGICAL :: LDIAGFORCING
+LOGICAL :: LApproxLwUpdate
+LOGICAL :: LApproxSwUpdate
+LOGICAL :: LCentredTimeSZA
+
+CHARACTER (LEN = 256) ::  CRTABLEDIR
+CHARACTER (LEN = 32) ::   CRTABLEFIL
+LOGICAL :: LCCNL
+LOGICAL :: LCCNO
+LOGICAL :: LPERPET
+
+REAL(KIND=JPRB) :: RAOVLP , RBOVLP
+REAL(KIND=JPRB) :: RCCNLND, RCCNSEA
+LOGICAL :: LEDBUG
+REAL(KIND=JPRB) :: RPERTOZ, RRe2De
+REAL(KIND=JPRB) :: RLWINHF, RSWINHF
+REAL(KIND=JPRB) :: RMINICE
+REAL(KIND=JPRB) :: RVOLCSPEC(3)
+REAL(KIND=JPRB) :: RNs, RSIGAIR
+
+!        * E.C.M.W.F. PHYSICS PACKAGE *
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      89/07/14
+! Modifications
+!    R J Hogan 20 May  2014: Added LApproxLwUpdate
+!    R J Hogan 19 June 2014: Added LApproxSwUpdate
+!    R J Hogan 19 Nov  2014: Added LCentredTimeSZA
+
+!  NAME     TYPE     PURPOSE
+!  ----  :  ----   : ---------------------------------------------------
+! LERAD1H: LOGICAL : .T. TO ALLOW MORE FREQUENT RADIATION CALCULATIONS
+!                  : DURING FIRST N HOURS OF FORECAST
+! NLNGR1H: INTEGER : NUMBER FORECAST HOURS DURING WHICH MORE FREQUENT
+!                    RADIATION CALCULATIONS ARE REQUIRED
+! LEPO3RA: LOGICAL : .T. IF PROGNOSTIC OZONE (EC) IS PASSED TO RADIATION
+! NAER   : INTEGER : CONFIGURATION INDEX FOR AEROSOLS
+! NMODE  : INTEGER : CONFIGURATION FOR RADIATION CODE: FLUX VS. RADIANCE
+! NOZOCL : INTEGER : CHOICE OF OZONE CLIMATOLOGY (0 old, 1 new)
+! NRADFR : INTEGER : FREQUENCY OF FULL RADIATION COMPUTATIONS
+!                    IF(NRADFR.GT.0): RAD EVERY 'NRADFR' TIME-STEPS
+!                    IF(NRADFR.LT.0): RAD EVERY '-NRADFR' HOURS
+! NRADPFR: INTEGER : PRINT FREQUENCY FOR RAD.STATISTICS (in RAD.T.STEPS)
+! NRADPLA: INTEGER : PRINT RAD.STATISTICS EVERY 'NRADPLA' ROWS
+! NRADINT: INTEGER : RADIATION INTERPOLATION METHOD
+!                  : 1 = SPECTRAL TRANSFORM INTERPOLATION
+!                  : 2 =  4 POINT HORIZONTAL INTERPOLATION
+!                  : 3 = 12 POINT HORIZONTAL INTERPOLATION
+! NRADRES: INTEGER : RADIATION GRID SPECTRAL RESOLUTION
+! NRADNFR: INTEGER : NORMAL   FREQUENCY OF RADIATION STEPS
+! NRADSFR: INTEGER : START-UP FREQUENCY OF RADIATION STEPS
+! NRADE1H: INTEGER : START-UP FREQUENCY OF RADIATION STEPS FOR EPS
+! NRADE3H: INTEGER : SUBSEQUENT FREQUENCY OF RADIATION STEPS FOR EPS
+! NRADELG: INTEGER : LENGTH IN HOURS DURING WHICH THE FREQUENCY OF RADIATION IS INCREASED FOR EPS
+! NOVLP  : INTEGER : CLOUD OVERLAP CONFIGURATION
+! NRPROMA: INTEGER : VECTOR LENGTH FOR RADIATION CALCULATIONS
+! NSW    : INTEGER : NUMBER OF SHORTWAVE SPECTRAL INTERVALS
+! NSWNL  : INTEGER : NUMBER OF SHORTWAVE SPECTRAL INTERVALS IN NL MODEL
+! NSWTL  : INTEGER : NUMBER OF SHORTWAVE SPECTRAL INTERVALS IN TL MODEL
+! NTSW   : INTEGER : MAXIMUM POSSIBLE NUMBER OF SW SPECTRAL INTERVALS 
+! NUV    : INTEGER : NUMBER OF UV SPECTRAL INTERVALS FOR THE UV PROCESSOR   
+! LOPTRPROMA:LOGICAL: .T. NRPROMA will be optimised
+!                   : .F. NRPROMA will not be optimised (forced
+!                   :         by negative NRPROMA in namelist)
+
+! NRADIP : INTEGER : INDEX FOR DIAGNOSIS OF ICE CLOUD EFFECTIVE RADIUS
+!          0=EbCu/SmSh  1=EbCu/EbCu  2=FuLi/FuLi  3=Fu/Fu&al
+! NRADLP : INTEGER : INDEX FOR DIAGNOSIS OF LIQ. CLOUD EFFECTIVE RADIUS
+!          0=YF/SmSh    1=ASl/HSa    2=ASl/LiLi
+! NICEOPT: INTEGER : INDEX FOR ICE CLOUD OPTICAL PROPERTIES
+!          0=40u        1=40-130     2=30-60      3=Sun'01
+! NLIQOPT: INTEGER : INDEX FOR LIQUID WATER CLOUD OPTICAL PROPERTIES
+!          0=f(P)       1=10/13      2=Martin_et_al
+
+! LONEWSW: LOGICAL : .T. IF NEW SW CODE IS ACTIVE
+! LECSRAD: LOGICAL : .T. IF CLEAR-SKY RADIATION IS ARCHIVED AS PEXTR2
+! NCSRADF: INTEGER : 1 IF ACCUMULATED, 2 IF INSTANTANEOUS
+! LRRTM  : LOGICAL : .T. IF RRTM140MR IS USED FOR LW RADIATION TRANSFER
+
+! LHVOLCA: LOGICAL : .T. IF GISS HISTORY OF VOLCANIC AEROSOLS IS ON
+! LNEWAER: LOGICAL : .T. IF AEROSOL MONTHLY DISTRIBUTIONS ARE USED
+! LNOTROAER:LOGICAL: .T. IF NO TROPOSPHERIC AEROSOLS
+! CRTABLEDIR: CHAR : IF NRADINT > 0 SPECIFIES DIRECTORY PATH FOR RADIATION
+!                  : GRID RTABLE NAMELIST
+! CRTABLEFIL: CHAR : IF NRADINT > 0 SPECIFIES FILE NAME OF RADIATION 
+!                  : GRID RTABLE NAMELIST
+! LRAYL  : LOGICAL : .T. NEW RAYLEIGH FOR SW-6 VERSION
+
+! RAOVLP : REAL    : COEFFICIENTS FOR ALPHA1 FACTOR IN HOGAN & 
+! RBOVLP : REAL    : ILLINGWORTH's PARAMETRIZATION
+
+! LCCNL  : LOGICAL : .T. IF CCN CONCENTRATION OVER LAND IS DIAGNOSED
+! LCCNO  : LOGICAL : .T. IF CCN CONCENTRATION OVER OCEAN IS DIAGNOSED
+! RCCNLND: REAL    : NUMBER CONCENTRATION (CM-3) OF CCNs OVER LAND
+! RCCNSEA: REAL    : NUMBER CONCENTRATION (CM-3) OF CCNs OVER SEA
+
+! LDIFFC : LOGICAL : .T. IF SAVIJARVI'S DIFFUSIVITY CORRECTION IS ON
+
+! NINHOM : INTEGER : 0 IF NO INHOMOGENEITY SCALING EFFECT 
+!                    1 IF SIMPLE 0.7 SCALING
+!                    2 IF BARKER, 3 IF CAIRNS ET AL.
+! RLWINHF: REAL    : INHOMOG. SCALING FACTOR FOR CLOUD LW OPTICAL THICKNESS
+! RSWINHF: REAL    : INHOMOG. SCALING FACTOR FOR CLOUD SW OPTICAL THICKNESS
+
+! NPERTAER : INTERGER : PERCENTAGE OF PERTURBATION FOR AEROSOL   
+! NPERTOZONE : INTEGER : PERCENTAGE OF PERTURBATION FOR OZONE 
+! NHINCSOL:INTEGER :
+!        = 0 NO VARIABILITY OF SOLAR CONSTANT IS ACCOUNTED FOR 
+!        = 1 IF YEAR-TO-YEAR VARIABILITY OF SOLAR CONSTANT IS ACCOUNTED FOR 
+!        = 2 IF MONTH-TO-MONTH VARIABILITY OF SOLAR CONSTANT IS ACCOUNTED FOR 
+!        = 3 IF YEAR-TO-YEAR VARIABILITY OF SOLAR CONSTANT IS ACCOUNTED FOR ACCORDING TO CMIP5 RECOMMENDATIONS
+! LECO2VAR: LOGICAL: .T. IF ERA-40/AMIP2 VARIABILITY OF GHG IS ON
+! LHGHG  : LOGICAL : .T. IF VARIABILITY OF GREENHOUSE GASES (INCLUDING CO2) IS ON
+! N.B.: LHGHG supercedes LECO2VAR and allows using better specification of trace gases
+! NSCEN  : INTEGER : 21st CENTURY SCENARIO FOR GHG (1=A1B, 2=A2, 3=B1)
+! RRe2De : REAL    : CONVERSION FACTOR BETWWEN EFFECTIVE RADIUS AND PARTICLE SIZE
+! RMINICE: REAL    : MINIMUM SIZE FOR ICE PARTICLES (um)
+!                    FOR ICE
+! NMINICE: INTEGER : 1-6 MINIMUM ICE PARTICLE SIZE DEPENDS ON LATITUDE, 0=INDEPENDENT OF LATITUDE
+! NDECOLAT:INTEGER : DECORRELATION LENGTH FOR CF AND CW 
+!                     0: SPECIFIED INDEPENDENT OF LATITUDE, 1: SHONK-HOGAN, 2: IMPROVED
+! NMCICA : INTEGER :  0: NO McICA
+!                     1: McICA w maximum-random in cloud generator
+!                     2: McICA w generalized overlap in cloud generator
+! LESO4HIS: LOGICAL:.T.: Use historical/projected SO4 data per decade and month
+! NGHGRAD: INTEGER : configuration of 3D GHG climatologies accounted for in radiation
+!                     0: global values
+!                     1: CO2       2: CH4    3: N2O    4: NO2    5:CFC11   6:CFC12
+!                    12: CO2+CH4  13: CO2+CH4+N2O     
+!                    16: CO2+CH4+N2O+CFC11+CFC12
+! LETRACGMS: LOGICAL : F=Cariolle climatol. T=GEMS-derived clim for CO2, CH4, O3
+! LAERCLIM : LOGICAL : .T. for output of the climatological aerosol optical depth at 550 nm
+! LAERVISI : LOGICAL : .T. for output of the visibility (from diagnsotic or prognostic aerosols)
+! NVOLCVERT: INTEGER : Vertical distribution of volcanic aerosol
+!                       0: original profile, diagnosed from T
+!                       1: original profile, but upper boundary at 10hPa
+!                       2: lower boundary diagnosed from ozone, upper boundary at 10hPa
+! LVOLCSPEC: LOGICAL : T for specified volcanic aerosol
+! LVOLCDAMP: LOGICAL : T for damping of specified volcanic aerosol from initial value
+! RVOLCSPEC: REAL    : Specified volcanic aerosol (total optical depth) in NH/Tropics/SH
+! RNs                : derived from Avogadro
+! RSIGAIR: invariant terms in expression of Rayleigh scattering cross-section
+! NREDGSW  : LOGICAL : 0 full resolution for RRTM_SW (224)
+!                      1 ECMWF High resolution model configuration (_SW: 112)
+!                      2 ECMWF EPS configuration (_SW: 56)
+! NREDGLW  : LOGICAL : 0 full resolution for RRTM_LW (256)
+!                      1 ECMWF High resolution model configuration (_LW: 140)
+!                      2 ECMWF EPS configuration (_LW: 70)
+! LDIAGFORCING : LOGICAL : T Write input ozone, ghg and aerosol forcing to 3D fields 
+!                            To be used for diagnostics only; do not use in production runs
+! LApproxLwUpdate : LOGICAL : Update the longwave upwelling flux every
+!                             timestep/gridpoint using the stored rate
+!                             of change of the fluxes with respect to
+!                             the surface upwelling longwave flux
+! LApproxSwUpdate : LOGICAL : Update the shortwave upwelling flux
+!                             every gridpoint to account for the local
+!                             value of surface albedo, and every
+!                             timestep using Manners et al. (2009)
+!                             correction for solar zenith angle change
+! LCentredTimeSZA : LOGICAL : Compute solar zenith angle in radiation
+!                             scheme half way between calls to
+!                             radiation scheme (rather than previous
+!                             behaviour, which is half way between
+!                             calls plus half a model timestep)
+! ------------------------------------------------------------------
+END MODULE YOERAD
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerdi.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerdi.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerdi.F90	(revision 3908)
@@ -0,0 +1,49 @@
+MODULE YOERDI
+
+USE PARKIND1  ,ONLY : JPRB
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERDI* - COEFFICIENTS WITHIN RADIATION INTERFACE
+!     -----------------------------------------------------------------
+
+REAL(KIND=JPRB) :: RRAE
+REAL(KIND=JPRB) :: RSUNDUR
+REAL(KIND=JPRB) :: RCARDI
+REAL(KIND=JPRB) :: RCH4
+REAL(KIND=JPRB) :: RN2O
+REAL(KIND=JPRB) :: RNO2
+REAL(KIND=JPRB) :: RO3
+REAL(KIND=JPRB) :: RCCL4
+REAL(KIND=JPRB) :: RCFC11
+REAL(KIND=JPRB) :: RCFC12
+REAL(KIND=JPRB) :: RCFC22
+REAL(KIND=JPRB) :: REPCLC
+REAL(KIND=JPRB) :: REPH2O
+REAL(KIND=JPRB) :: RCCO2, RCCH4, RCN2O, RCNO2, RCCFC11, RCCFC12, RCCFC22, RCCCL4
+REAL(KIND=JPRB) :: RSOLINC
+
+!        * E.C.M.W.F. PHYSICS PACKAGE *
+
+!     Original  J.-J. MORCRETTE       E.C.M.W.F.      89/07/14
+!     Modified  P. Viterbo    99/03/26    Surface tiling
+!     Modified  P. Viterbo    24/05/2004  surf library
+!     Modified JJMorcrette    2005/01/19  GHG and Solar constant variability
+
+!  NAME     TYPE     PURPOSE
+!  ----  :  ----   : ---------------------------------------------------
+! RRAE   : EFFECT OF EARTH'S CURVATURE ON COSINE SOLAR ZENITH ANGLE
+! RSUNDUR: MINIMUM DIRECT SOLAR FOR COMPUTING SOLAR DURATION
+! RCARDI : SPECIFIC ATMOSPHERIC CONTENT IN CO2
+! RCH4, RN2O, RNO2, RO3, RCFC11, RCFC12 MASS MIXING RATIO OF VARIOUS TRACE GASES
+! RCCH4, RCN2O, ... MASS MIXING RATIO OF VARIOUS TRACE GASES IN CLIMATE MODE
+! REPCLC : SECURITY TO AVOID ZERO OR ONE CLOUD COVERS
+! REPH2O : SECURITY TO AVOID WATER VAPOUR CONTENT IN A LAYER
+!          TO BE MORE THAN THE RESPECTIVE VALUE AT SATURATION.
+!     -----------------------------------------------------------------
+END MODULE YOERDI
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrta1.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrta1.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrta1.F90	(revision 3908)
@@ -0,0 +1,46 @@
+MODULE YOERRTA1
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTA1* - RRTM COEFFICIENTS FOR INTERVAL 1
+!     BAND 1:  10-250 cm-1 (low - H2O; high - H2O)
+!     ABozzo may 2013 update to last version of rrtmg
+!     band 1:  10-350 cm-1
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NG1  = 10
+
+REAL(KIND=JPRB) :: FRACREFA(NG1)  , FRACREFB(NG1)
+REAL(KIND=JPRB) :: KA(5,13,NG1)   , ABSA(65,NG1)
+REAL(KIND=JPRB) :: KB(5,13:59,NG1), ABSB(235,NG1)
+REAL(KIND=JPRB) :: KA_MN2(19,NG1) , KB_MN2(19,NG1)
+REAL(KIND=JPRB) :: SELFREF(10,NG1), FORREF(4,NG1)
+
+EQUIVALENCE (KA(1,1,1),ABSA(1,1)), (KB(1,13,1),ABSB(1,1))
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM LW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! ABSA    : REAL     absorption coefficient of major absorber for M reference tropospheric 
+!                    pressures and N reference tropospheric temperatures
+! ABSB    : REAL     absorption coefficient of secondary absorber for M reference stratospheric
+!                    pressures and N reference stratospheric temperatures 
+! FRACREFA: REAL     distance from r and T reference tabulated points (troposphere)
+! FRACREFB: REAL     distance from r and T reference tabulated points (stratosphere)
+! FORREF  : REAL     foreign broadening coefficient for water vapour
+! KA      : REAL     absorption coefficient of major absorber    
+! KB      : REAL     absorption coefficient of secondary absorber    
+! SELFREF : REAL     self broadening coefficient for water vapour
+!     -----------------------------------------------------------------
+END MODULE YOERRTA1
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrta10.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrta10.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrta10.F90	(revision 3908)
@@ -0,0 +1,45 @@
+MODULE YOERRTA10
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTA14* - RRTM COEFFICIENTS FOR INTERVAL 10
+!     BAND 10:  1390-1480 cm-1 (low - H2O; high - H2O)
+!     ABozzo 201306 updated to rrtmg v4.85
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NG10 = 6
+
+REAL(KIND=JPRB) , DIMENSION(NG10) :: FRACREFA
+REAL(KIND=JPRB) , DIMENSION(NG10) :: FRACREFB
+
+REAL(KIND=JPRB) :: KA(5,13,NG10)   , ABSA(65,NG10)
+REAL(KIND=JPRB) :: KB(5,13:59,NG10), ABSB(235,NG10)
+REAL(KIND=JPRB) :: SELFREF(10,NG10)
+REAL(KIND=JPRB) :: FORREF(4,NG10)
+
+EQUIVALENCE (KA(1,1,1),ABSA(1,1)),(KB(1,13,1),ABSB(1,1))
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE *
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! ABSA    : REAL     absorption coefficient of major absorber for M reference tropospheric 
+!                    pressures and N reference tropospheric temperatures 
+! ABSB    : REAL     absorption coefficient of secondary absorber for M reference stratospheric
+!                    pressures and N reference stratospheric temperatures 
+! FRACREFA: REAL     distance from r and T reference tabulated points (troposphere)
+! FRACREFB: REAL     distance from r and T reference tabulated points (stratosphere)
+! KA      : REAL     absorption coefficient of major absorber (equiv. to ABSA)   
+! KB      : REAL     absorption coefficient of secondary absorber (equiv. to ABSB)   
+!     -----------------------------------------------------------------
+END MODULE YOERRTA10
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrta11.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrta11.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrta11.F90	(revision 3908)
@@ -0,0 +1,47 @@
+MODULE YOERRTA11
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTA11* - RRTM COEFFICIENTS FOR INTERVAL 11
+!     BAND 11:  1480-1800 cm-1 (low - H2O; high - H2O)
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NG11 = 8
+
+REAL(KIND=JPRB) , DIMENSION(NG11) :: FRACREFA
+REAL(KIND=JPRB) , DIMENSION(NG11) :: FRACREFB
+
+REAL(KIND=JPRB) :: KA(5,13,NG11)   , ABSA(65,NG11)
+REAL(KIND=JPRB) :: KB(5,13:59,NG11), ABSB(235,NG11)
+REAL(KIND=JPRB) :: KA_MO2(19,NG11)
+REAL(KIND=JPRB) :: KB_MO2(19,NG11)
+REAL(KIND=JPRB) :: SELFREF(10,NG11)
+REAL(KIND=JPRB) :: FORREF(4,NG11)
+
+EQUIVALENCE (KA(1,1,1),ABSA(1,1)),(KB(1,13,1),ABSB(1,1))
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE *
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! ABSA    : REAL     absorption coefficient of major absorber for M reference tropospheric 
+!                    pressures and N reference tropospheric temperatures 
+! ABSB    : REAL     absorption coefficient of secondary absorber for M reference stratospheric
+!                    pressures and N reference stratospheric temperatures 
+! FRACREFA: REAL     distance from r and T reference tabulated points (troposphere)
+! FRACREFB: REAL     distance from r and T reference tabulated points (stratosphere)
+! KA      : REAL     absorption coefficient of major absorber (equiv. to ABSA)   
+! KB      : REAL     absorption coefficient of secondary absorber (equiv. to ABSB)   
+! SELFREF : REAL     self broadening coefficient for water vapour
+!     -----------------------------------------------------------------
+END MODULE YOERRTA11
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrta12.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrta12.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrta12.F90	(revision 3908)
@@ -0,0 +1,43 @@
+MODULE YOERRTA12
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTA12* - RRTM COEFFICIENTS FOR INTERVAL 12
+!     BAND 12:  1800-2080 cm-1 (low - H2O,CO2; high - nothing)
+!     ABozzo 201306 updated to rrtmg v4.85
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NG12 = 8
+
+REAL(KIND=JPRB) :: FRACREFA(NG12,9)
+REAL(KIND=JPRB) :: KA(9,5,13,NG12) ,ABSA(585,NG12)
+REAL(KIND=JPRB) :: SELFREF(10,NG12)
+REAL(KIND=JPRB) :: FORREF(4,NG12)
+
+REAL(KIND=JPRB) :: STRRAT
+
+EQUIVALENCE (KA(1,1,1,1),ABSA(1,1))
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM LW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! ABSA    : REAL     absorption coefficient of major absorber for M reference tropospheric 
+!                    pressures and N reference tropospheric temperatures 
+! FRACREFA: REAL     distance from r and T reference tabulated points (troposphere)
+! KA      : REAL     absorption coefficient of major absorber (equiv. to ABSA)   
+! SELFREF : REAL     self broadening coefficient for water vapour
+! STRRAT  : REAL     weighting factors for the transition between tropospheric 
+!                    and stratospheric computations
+!     -----------------------------------------------------------------
+END MODULE YOERRTA12
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrta13.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrta13.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrta13.F90	(revision 3908)
@@ -0,0 +1,46 @@
+MODULE YOERRTA13
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTA13* - RRTM COEFFICIENTS FOR INTERVAL 13
+!     BAND 13:  2080-2250 cm-1 (low - H2O,N2O; high - nothing)
+!     ABozzo 201306 updated to rrtmg v4.85
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NG13 = 4
+
+REAL(KIND=JPRB) :: FRACREFA(NG13,9)
+REAL(KIND=JPRB) , DIMENSION(NG13) :: FRACREFB
+
+REAL(KIND=JPRB) :: KA(9,5,13,NG13) ,ABSA(585,NG13)
+REAL(KIND=JPRB) :: SELFREF(10,NG13)
+REAL(KIND=JPRB) :: FORREF(4,NG13)
+REAL(KIND=JPRB) :: KA_MCO2(9,19,NG13)
+REAL(KIND=JPRB) :: KA_MCO(9,19,NG13)
+REAL(KIND=JPRB) :: KB_MO3(19,NG13)
+
+EQUIVALENCE (KA(1,1,1,1),ABSA(1,1))
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM LW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! ABSA    : REAL     absorption coefficient of major absorber for M reference tropospheric 
+!                    pressures and N reference tropospheric temperatures 
+! FRACREFA: REAL     distance from r and T reference tabulated points (troposphere)
+! KA      : REAL     absorption coefficient of major absorber (equiv. to ABSA)   
+! SELFREF : REAL     self broadening coefficient for water vapour
+! STRRAT  : REAL     weighting factors for the transition between tropospheric 
+!                    and stratospheric computations
+!     -----------------------------------------------------------------
+END MODULE YOERRTA13
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrta14.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrta14.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrta14.F90	(revision 3908)
@@ -0,0 +1,47 @@
+MODULE YOERRTA14
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTA14* - RRTM COEFFICIENTS FOR INTERVAL 14
+!     BAND 14:  2250-2380 cm-1 (low - CO2; high - CO2)
+!     ABozzo 201306 updated to rrtmg v4.85
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NG14 = 2
+
+REAL(KIND=JPRB) , DIMENSION(NG14) :: FRACREFA
+REAL(KIND=JPRB) , DIMENSION(NG14) :: FRACREFB
+
+REAL(KIND=JPRB) :: KA(5,13,NG14)   ,ABSA(65,NG14)
+REAL(KIND=JPRB) :: KB(5,13:59,NG14),ABSB(235,NG14)
+REAL(KIND=JPRB) :: SELFREF(10,NG14)
+REAL(KIND=JPRB) :: FORREF(4,NG14)
+
+EQUIVALENCE (KA(1,1,1),ABSA(1,1)), (KB(1,13,1),ABSB(1,1))
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE *
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/01/15
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! ABSA    : REAL     absorption coefficient of major absorber for M reference tropospheric 
+!                    pressures and N reference tropospheric temperatures 
+! ABSB    : REAL     absorption coefficient of secondary absorber for M reference stratospheric
+!                    pressures and N reference stratospheric temperatures 
+! FRACREFA: REAL     distance from r and T reference tabulated points (troposphere)
+! FRACREFB: REAL     distance from r and T reference tabulated points (stratosphere)
+! KA      : REAL     absorption coefficient of major absorber (equiv. to ABSA)   
+! KB      : REAL     absorption coefficient of secondary absorber (equiv. to ABSB)   
+! SELFREF : REAL     self broadening coefficient for water vapour
+!     -----------------------------------------------------------------
+END MODULE YOERRTA14
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrta15.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrta15.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrta15.F90	(revision 3908)
@@ -0,0 +1,47 @@
+MODULE YOERRTA15
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTA15* - RRTM COEFFICIENTS FOR INTERVAL 15
+!     BAND 15:  2380-2600 cm-1 (low - N2O,CO2; high - nothing)
+!     ABozzo 2001306 updated to rrtmg v4.85
+!     band 15:  2380-2600 cm-1 (low - n2o,co2; low minor - n2)
+!                              (high - nothing)
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NG15 = 2
+
+REAL(KIND=JPRB) :: FRACREFA(NG15,9)
+
+REAL(KIND=JPRB) :: KA(9,5,13,NG15) ,ABSA(585,NG15)
+REAL(KIND=JPRB) :: KA_MN2(9,19,NG15)
+REAL(KIND=JPRB) :: SELFREF(10,NG15)
+REAL(KIND=JPRB) :: FORREF(4,NG15)
+
+
+
+EQUIVALENCE (KA(1,1,1,1),ABSA(1,1))
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE *
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! ABSA    : REAL     absorption coefficient of major absorber for M reference tropospheric 
+!                    pressures and N reference tropospheric temperatures 
+! FRACREFA: REAL     distance from r and T reference tabulated points (troposphere)
+! KA      : REAL     absorption coefficient of major absorber (equiv. to ABSA)   
+! SELFREF : REAL     self broadening coefficient for water vapour
+! STRRAT  : REAL     weighting factors for the transition between tropospheric 
+!                    and stratospheric computations
+!     -----------------------------------------------------------------
+END MODULE YOERRTA15
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrta16.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrta16.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrta16.F90	(revision 3908)
@@ -0,0 +1,45 @@
+MODULE YOERRTA16
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTA16* - RRTM COEFFICIENTS FOR INTERVAL 16
+!     BAND 16:  2600-3000 cm-1 (low - H2O,CH4; high - nothing)
+!     ABozzo 201306 updated to rrtmg v4.85
+!     band 16:  2600-3250 cm-1 (low key- h2o,ch4; high key - ch4)
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NG16 = 2
+
+REAL(KIND=JPRB) :: FRACREFA(NG16,9)
+REAL(KIND=JPRB) , DIMENSION(NG16) :: FRACREFB
+
+REAL(KIND=JPRB) :: KA(9,5,13,NG16) ,ABSA(585,NG16)
+REAL(KIND=JPRB) :: KB(5,13:59,NG16), ABSB(235,NG16)
+REAL(KIND=JPRB) :: SELFREF(10,NG16)
+REAL(KIND=JPRB) :: FORREF(4,NG16)
+
+EQUIVALENCE (KA(1,1,1,1),ABSA(1,1)), (KB(1,13,1),ABSB(1,1))
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM LW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! ABSA    : REAL     absorption coefficient of major absorber for M reference tropospheric 
+!                    pressures and N reference tropospheric temperatures 
+! FRACREFA: REAL     distance from r and T reference tabulated points (troposphere)
+! KA      : REAL     absorption coefficient of major absorber (equiv. to ABSA)   
+! SELFREF : REAL     self broadening coefficient for water vapour
+! STRRAT  : REAL     weighting factors for the transition between tropospheric 
+!                    and stratospheric computations
+!     -----------------------------------------------------------------
+END MODULE YOERRTA16
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrta2.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrta2.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrta2.F90	(revision 3908)
@@ -0,0 +1,49 @@
+MODULE YOERRTA2
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTA2* - RRTM COEFFICIENTS FOR INTERVAL 2
+!     BAND 2:  250-500 cm-1 (low - H2O; high - H2O)
+! ABozzo May 2013 updated to the last rrtmg
+!     band 2:  350-500 cm-1 (low key - h2o; high key - h2o)
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NG2  = 12
+
+!     The ith set of reference fractions are from the ith reference
+!     pressure level.
+REAL(KIND=JPRB) :: FRACREFA(NG2), FRACREFB(NG2)
+REAL(KIND=JPRB) :: KA(5,13,NG2)   , ABSA(65,NG2)
+REAL(KIND=JPRB) :: KB(5,13:59,NG2), ABSB(235,NG2)
+REAL(KIND=JPRB) :: SELFREF(10,NG2), FORREF(4,NG2)
+
+EQUIVALENCE (KA(1,1,1),ABSA(1,1)),(KB(1,13,1),ABSB(1,1))
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM LW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! ABSA    : REAL     absorption coefficient of major absorber for M reference tropospheric 
+!                    pressures and N reference tropospheric temperatures 
+! ABSB    : REAL     absorption coefficient of secondary absorber for M reference stratospheric
+!                    pressures and N reference stratospheric temperatures 
+! FRACREFA: REAL     distance from r and T reference tabulated points (troposphere)
+! FRACREFB: REAL     distance from r and T reference tabulated points (stratosphere)
+! FORREF  : REAL     foreign broadening coefficient for water vapour
+! KA      : REAL     absorption coefficient of major absorber (equiv. to ABSA)   
+! KB      : REAL     absorption coefficient of secondary absorber (equiv. to ABSB)   
+! REFPARAM: REAL     reference water vapour mixing ratio for use in Planck function interpolation
+! SELFREF : REAL     self broadening coefficient for water vapour
+!     -----------------------------------------------------------------
+END MODULE YOERRTA2
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrta3.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrta3.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrta3.F90	(revision 3908)
@@ -0,0 +1,53 @@
+MODULE YOERRTA3
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTA3* - RRTM COEFFICIENTS FOR INTERVAL 3
+!     BAND 3:  500-630 cm-1 (low - H2O,CO2; high - H2O,CO2)
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NG3  = 16
+
+REAL(KIND=JPRB) :: FRACREFA(NG3,9) ,FRACREFB(NG3,5)
+
+REAL(KIND=JPRB) :: KA_MN2O(9,19,NG3), KB_MN2O(5,19,NG3)
+REAL(KIND=JPRB) :: KA(9,5,13,NG3)  ,ABSA(585,NG3)
+REAL(KIND=JPRB) :: KB(5,5,13:59,NG3),ABSB(1175,NG3)
+REAL(KIND=JPRB) :: SELFREF(10,NG3)
+REAL(KIND=JPRB) :: FORREF(4,NG3)
+
+EQUIVALENCE (KA(1,1,1,1),ABSA(1,1)),(KB(1,1,13,1),ABSB(1,1))
+
+!     ------------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM LW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! ABSA    : REAL     absorption coefficient of major absorber for M reference tropospheric 
+!                    pressures and N reference tropospheric temperatures 
+! ABSB    : REAL     absorption coefficient of secondary absorber for M reference stratospheric
+!                    pressures and N reference stratospheric temperatures 
+! ABSN2OA : REAL     absorption coefficient for tropospheric N2O
+! ABSN2OB : REAL     absorption coefficient for stratospheric N2O
+! CO2REF  : REAL     refrence CO2 profile
+! ETAREF  : REAL     reference eta scale [0,1]
+! FRACREFA: REAL     distance from r and T reference tabulated points (troposphere)
+! FRACREFB: REAL     distance from r and T reference tabulated points (stratosphere)
+! H2OREF  : REAL     reference H2O profile
+! KA      : REAL     absorption coefficient of major absorber (equiv. to ABSA)   
+! KB      : REAL     absorption coefficient of secondary absorber (equiv. to ABSB)   
+! N2OREF  : REAL     reference N2O profile
+! SELFREF : REAL     self broadening coefficient for water vapour
+! STRRAT  : REAL     weighting factor for the transition between tropospheric 
+!                    and stratospheric computations
+!     -----------------------------------------------------------------
+END MODULE YOERRTA3
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrta4.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrta4.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrta4.F90	(revision 3908)
@@ -0,0 +1,45 @@
+MODULE YOERRTA4
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTA4* - RRTM COEFFICIENTS FOR INTERVAL 5
+!     BAND 4:  630-700 cm-1 (low - H2O,CO2; high - O3,CO2)
+!     201306 ABozzo updated to rrtmg v4.85
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NG4  = 14
+
+REAL(KIND=JPRB) :: FRACREFA(NG4,9)  ,FRACREFB(NG4,5)
+REAL(KIND=JPRB) :: KA(9,5,13,NG4)   ,ABSA(585,NG4)
+REAL(KIND=JPRB) :: KB(5,5,13:59,NG4),ABSB(1175,NG4)
+REAL(KIND=JPRB) :: SELFREF(10,NG4)  ,FORREF(4,NG4)
+
+EQUIVALENCE (KA(1,1,1,1),ABSA(1,1)),(KB(1,1,13,1),ABSB(1,1))
+
+!     ------------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM LW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! ABSA    : REAL     absorption coefficient of major absorber for M reference tropospheric 
+!                    pressures and N reference tropospheric temperatures 
+! ABSB    : REAL     absorption coefficient of secondary absorber for M reference stratospheric
+!                    pressures and N reference stratospheric temperatures 
+! FRACREFA: REAL     distance from r and T reference tabulated points (troposphere)
+! FRACREFB: REAL     distance from r and T reference tabulated points (stratosphere)
+! KA      : REAL     absorption coefficient of major absorber (equiv. to ABSA)   
+! KB      : REAL     absorption coefficient of secondary absorber (equiv. to ABSB)   
+! SELFREF : REAL     self broadening coefficient for water vapour
+! STRRATn : REAL     weighting factors for the transition between tropospheric 
+!                    and stratospheric computations
+!     -----------------------------------------------------------------
+END MODULE YOERRTA4
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrta5.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrta5.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrta5.F90	(revision 3908)
@@ -0,0 +1,51 @@
+MODULE YOERRTA5
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTA5* - RRTM COEFFICIENTS FOR INTERVAL 5
+!     BAND 5:  700-820 cm-1 (low - H2O,CO2; high - O3,CO2)
+!     ABozzo 201306 updated to rrtmg v4.85
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NG5  = 16
+
+REAL(KIND=JPRB) :: FRACREFA(NG5,9) ,FRACREFB(NG5,5)
+
+REAL(KIND=JPRB) , DIMENSION(NG5) :: CCL4
+
+REAL(KIND=JPRB) :: KA(9,5,13,NG5)   ,ABSA(585,NG5)
+REAL(KIND=JPRB) :: KB(5,5,13:59,NG5),ABSB(1175,NG5)
+REAL(KIND=JPRB) :: KA_MO3(9,19,NG5)
+REAL(KIND=JPRB) :: SELFREF(10,NG5)
+REAL(KIND=JPRB) :: FORREF(4,NG5)
+
+EQUIVALENCE (KA(1,1,1,1),ABSA(1,1)),(KB(1,1,13,1),ABSB(1,1))
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM LW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! ABSA    : REAL     absorption coefficient of major absorber for M reference tropospheric 
+!                    pressures and N reference tropospheric temperatures 
+! ABSB    : REAL     absorption coefficient of secondary absorber for M reference stratospheric
+!                    pressures and N reference stratospheric temperatures 
+! CCL4    : REAL     absorption coefficient for CCl4
+! FRACREFA: REAL     distance from r and T reference tabulated points (troposphere)
+! FRACREFB: REAL     distance from r and T reference tabulated points (stratosphere)
+! KA      : REAL     absorption coefficient of major absorber (equiv. to ABSA)   
+! KB      : REAL     absorption coefficient of secondary absorber (equiv. to ABSB)   
+! SELFREF : REAL     self broadening coefficient for water vapour
+! STRRATn : REAL     weighting factors for the transition between tropospheric 
+!                    and stratospheric computations
+!     -----------------------------------------------------------------
+END MODULE YOERRTA5
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrta6.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrta6.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrta6.F90	(revision 3908)
@@ -0,0 +1,48 @@
+MODULE YOERRTA6
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTA6* - RRTM COEFFICIENTS FOR INTERVAL 6
+!     BAND 6:  820-980 cm-1 (low - H2O; high - nothing)
+!     ABozzo 201306 updaten to rrtmg v4.85
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NG6  = 8
+
+REAL(KIND=JPRB) , DIMENSION(NG6) :: FRACREFA
+
+REAL(KIND=JPRB) , DIMENSION(NG6) :: CFC11ADJ
+REAL(KIND=JPRB) , DIMENSION(NG6) :: CFC12
+
+
+REAL(KIND=JPRB) :: KA(5,13,NG6),ABSA(65,NG6)
+REAL(KIND=JPRB) :: SELFREF(10,NG6)
+REAL(KIND=JPRB) :: KA_MCO2(19,NG6)
+REAL(KIND=JPRB) :: FORREF(4,NG6)
+
+EQUIVALENCE (KA(1,1,1),ABSA(1,1))
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE *
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! ABSCO2  : REAL     absorption coefficient for CO2
+! ABSA    : REAL     absorption coefficient of major absorber for M reference tropospheric 
+!                    pressures and N reference tropospheric temperatures 
+! CFC11ADJ: REAL     absorption coefficient for CFC-11 (adjusted)
+! CFC12   : REAL     absorption coefficient for CFC-12
+! FRACREFA: REAL     distance from r and T reference tabulated points (troposphere)
+! KA      : REAL     absorption coefficient of major absorber (equiv. to ABSA)   
+! SELFREF : REAL     self broadening coefficient for water vapour
+!     -----------------------------------------------------------------
+END MODULE YOERRTA6
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrta7.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrta7.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrta7.F90	(revision 3908)
@@ -0,0 +1,51 @@
+MODULE YOERRTA7
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTA7* - RRTM COEFFICIENTS FOR INTERVAL 7
+!     BAND 7:  980-1080 cm-1 (low - H2O,O3; high - O3)
+!     ABozzo updated to rrtmg v4.85
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NG7  = 12
+
+REAL(KIND=JPRB) :: FRACREFA(NG7,9)
+
+REAL(KIND=JPRB) , DIMENSION(NG7) :: FRACREFB
+REAL(KIND=JPRB) :: KA(9,5,13,NG7) ,ABSA(585,NG7)
+REAL(KIND=JPRB) :: KB(5,13:59,NG7),ABSB(235,NG7)
+REAL(KIND=JPRB) :: SELFREF(10,NG7)
+REAL(KIND=JPRB) :: KA_MCO2(9,19,NG7)
+REAL(KIND=JPRB) :: KB_MCO2(19,NG7)
+REAL(KIND=JPRB) :: FORREF(4,NG7)
+
+EQUIVALENCE (KA(1,1,1,1),ABSA(1,1)),(KB(1,13,1),ABSB(1,1))
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE *
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : --------------------------------------------------- 
+! ABSA    : REAL     absorption coefficient of major absorber for M reference tropospheric 
+!                    pressures and N reference tropospheric temperatures 
+! ABSB    : REAL     absorption coefficient of secondary absorber for M reference stratospheric
+!                    pressures and N reference stratospheric temperatures 
+! ABSCO2  : REAL     absorption coefficient for CO2
+! FRACREFA: REAL     distance from r and T reference tabulated points (troposphere)
+! FRACREFB: REAL     distance from r and T reference tabulated points (stratosphere)
+! KA      : REAL     absorption coefficient of major absorber (equiv. to ABSA)   
+! KB      : REAL     absorption coefficient of secondary absorber (equiv. to ABSB)   
+! SELFREF : REAL     self broadening coefficient for water vapour
+! STRRAT  : REAL     weighting factors for the transition between tropospheric 
+!                    and stratospheric computations
+!     -----------------------------------------------------------------
+END MODULE YOERRTA7
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrta8.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrta8.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrta8.F90	(revision 3908)
@@ -0,0 +1,67 @@
+MODULE YOERRTA8
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTA8* - RRTM COEFFICIENTS FOR INTERVAL 8
+!     BAND 8:  1080-1180 cm-1 (low (i.e.>~300mb) - H2O; high - O3)
+!     ABozzo 201306 updated to rrtmg v4.85
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NG8  = 8
+
+REAL(KIND=JPRB) , DIMENSION(NG8) :: FRACREFA
+REAL(KIND=JPRB) , DIMENSION(NG8) :: FRACREFB
+REAL(KIND=JPRB) , DIMENSION(NG8) :: CFC12
+REAL(KIND=JPRB) , DIMENSION(NG8) :: CFC22ADJ
+
+REAL(KIND=JPRB) :: KA(5,13,NG8)    ,ABSA(65,NG8)
+REAL(KIND=JPRB) :: KB(5,13:59,NG8) ,ABSB(235,NG8)
+REAL(KIND=JPRB) :: KA_MCO2(19,NG8)
+REAL(KIND=JPRB) :: KA_MN2O(19,NG8)
+REAL(KIND=JPRB) :: KA_MO3(19,NG8)
+REAL(KIND=JPRB) :: KB_MCO2(19,NG8)
+REAL(KIND=JPRB) :: KB_MN2O(19,NG8)
+REAL(KIND=JPRB) :: SELFREF(10,NG8)
+REAL(KIND=JPRB) :: FORREF(4,NG8)
+
+
+EQUIVALENCE (KA(1,1,1),ABSA(1,1)),(KB(1,13,1),ABSB(1,1))
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE *
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! ABSA    : REAL     absorption coefficient of major absorber for M reference tropospheric 
+!                    pressures and N reference tropospheric temperatures 
+! ABSB    : REAL     absorption coefficient of secondary absorber for M reference stratospheric
+!                    pressures and N reference stratospheric temperatures 
+! ABSCO2A : REAL     absorption coefficient for CO2 for M reference tropospheric 
+!                    pressures and N reference tropospheric temperatures 
+! ABSCO2B : REAL     absorption coefficient for CO2 for M reference stratospheric 
+!                    pressures and N reference stratospheric temperatures     
+! ABSN2OA : REAL     absorption coefficient for N2O for M reference tropospheric 
+!                    pressures and N reference tropospheric temperatures     
+! ABSN2OB : REAL     absorption coefficient for N2O for M reference stratospheric 
+!                    pressures and N reference stratospheric temperatures 
+! CFC12   : REAL     absorption coefficient for CFC-12
+! CFC22ADJ: REAL     absorption coefficient for CFC-22 (adjusted)
+! FRACREFA: REAL     distance from r and T reference tabulated points (troposphere)
+! FRACREFB: REAL     distance from r and T reference tabulated points (stratosphere)
+! H2OREF  : REAL     reference profile for H2O
+! KA      : REAL     absorption coefficient of major absorber (equiv. to ABSA)   
+! KB      : REAL     absorption coefficient of secondary absorber (equiv. to ABSB)   
+! N2OREF  : REAL     reference profile for N2O
+! O3REF   : REAL     reference profile for O3
+! SELFREF : REAL     self broadening coefficient for water vapour
+!     -----------------------------------------------------------------
+END MODULE YOERRTA8
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrta9.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrta9.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrta9.F90	(revision 3908)
@@ -0,0 +1,55 @@
+MODULE YOERRTA9
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTA9* - RRTM COEFFICIENTS FOR INTERVAL 9
+!     BAND 9:  1180-1390 cm-1 (low - H2O,CH4; high - CH4)
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NG9  = 12
+
+REAL(KIND=JPRB) :: FRACREFA(NG9,9)
+
+REAL(KIND=JPRB) , DIMENSION(NG9) :: FRACREFB
+
+REAL(KIND=JPRB) :: KA(9,5,13,NG9) ,ABSA(585,NG9)
+REAL(KIND=JPRB) :: KB(5,13:59,NG9) ,ABSB(235,NG9)
+REAL(KIND=JPRB) :: KA_MN2O(9,19,NG9)
+REAL(KIND=JPRB) :: KB_MN2O(19,NG9)
+REAL(KIND=JPRB) :: SELFREF(10,NG9)
+REAL(KIND=JPRB) :: FORREF(4,NG9)
+
+EQUIVALENCE (KA(1,1,1,1),ABSA(1,1)),(KB(1,13,1),ABSB(1,1))
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM LW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! ABSA    : REAL     absorption coefficient of major absorber for M reference tropospheric 
+!                    pressures and N reference tropospheric temperatures 
+! ABSB    : REAL     absorption coefficient of secondary absorber for M reference stratospheric
+!                    pressures and N reference stratospheric temperatures 
+! ABSN2O  : REAL     absorption coefficient for N2O
+! CH4REF  : REAL     reference profile for CH4
+! ETAREF  : REAL     reference eta profile
+! FRACREFA: REAL     distance from r and T reference tabulated points (troposphere)
+! FRACREFB: REAL     distance from r and T reference tabulated points (stratosphere)
+! H2OREF  : REAL     reference profile for H2O
+! KA      : REAL     absorption coefficient of major absorber (equiv. to ABSA)   
+! KB      : REAL     absorption coefficient of secondary absorber (equiv. to ABSB)   
+! N2OREF  : REAL     reference profile for N2O
+! SELFREF : REAL     self broadening coefficient for water vapour
+! STRRAT  : REAL     weighting factors for the transition between tropospheric 
+!                    and stratospheric computations
+!     -----------------------------------------------------------------
+END MODULE YOERRTA9
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrtab.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrtab.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrtab.F90	(revision 3908)
@@ -0,0 +1,29 @@
+MODULE YOERRTAB
+
+USE PARKIND1  ,ONLY : JPRB
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!    -------------------------------------------------------------------
+
+!    -------------------------------------------------------------------
+
+REAL(KIND=JPRB) , DIMENSION(0:5000) :: TRANS
+REAL(KIND=JPRB) :: BPADE
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM LW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----  :  ----   : ---------------------------------------------------
+! TRANS  :  REAL   : TABULATED REFERENCE FOR LW TRANSMISSION    
+! BPADE  :  REAL   : INVERSE OF PADE APPROXIMATION CONSTANT  (= 1./0.278)     
+!     -----------------------------------------------------------------
+END MODULE YOERRTAB
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrtbg2.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrtbg2.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrtbg2.F90	(revision 3908)
@@ -0,0 +1,29 @@
+MODULE YOERRTBG2
+
+USE PARKIND1  ,ONLY : JPRB
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!    -------------------------------------------------------------------
+
+!    -------------------------------------------------------------------
+
+REAL(KIND=JPRB) :: CORR1(0:200)
+REAL(KIND=JPRB) :: CORR2(0:200)
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM LW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----  :  ----   : ---------------------------------------------------
+! CORR1  :  REAL   : 
+! CORR2  :  REAL   :
+!    -------------------------------------------------------------------
+END MODULE YOERRTBG2
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrtftr.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrtftr.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrtftr.F90	(revision 3908)
@@ -0,0 +1,51 @@
+MODULE YOERRTFTR
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+
+!USE PARRRTM, ONLY : JPBAND, JPG, JPGMAX
+!USE YOERRTM, ONLY : JPGPT
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!    -------------------------------------------------------------------
+
+!    -------------------------------------------------------------------
+
+INTEGER(KIND=JPIM) :: NGC(16)
+INTEGER(KIND=JPIM) :: NGS(16)
+
+INTEGER(KIND=JPIM) :: NGN(256)
+INTEGER(KIND=JPIM) :: NGB(256)
+
+INTEGER(KIND=JPIM) :: NGM(256)
+REAL(KIND=JPRB) ::    WT(16)
+
+!INTEGER(KIND=JPIM) :: NGC(JPBAND)
+!INTEGER(KIND=JPIM) :: NGS(JPBAND)
+!
+!INTEGER(KIND=JPIM) :: NGN(JPGMAX)
+!INTEGER(KIND=JPIM) :: NGB(JPGMAX)
+!
+!INTEGER(KIND=JPIM) :: NGM(JPG*JPBAND)
+!REAL(KIND=JPRB) ::    WT(JPG)
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM LW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----  :  ----   : ---------------------------------------------------
+!  NGC   : INTEGER :
+!  NGS   : INTEGER :
+!  NGN   : INTEGER :
+!  NGB   : INTEGER :
+!  NGM   : INTEGER :
+!  WT    : REAL    :
+!    -------------------------------------------------------------------
+END MODULE YOERRTFTR
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrtm.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrtm.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrtm.F90	(revision 3908)
@@ -0,0 +1,99 @@
+MODULE YOERRTM
+
+USE PARKIND1  ,ONLY : JPIM
+USE PARRRTM   ,ONLY : JPGMAX
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     ------------------------------------------------------------------
+!     Parameters relevant to AER's RRTM-LW radiation scheme: Part 2
+
+!     20110613 JJMorcrette
+
+!     Modified to allow possibilities of different g-point numbers.  
+!     ------------------------------------------------------------------
+
+!INTEGER(KIND=JPIM) :: JPGPT
+!INTEGER(KIND=JPIM) :: JPGLW
+
+!INTEGER(KIND=JPIM) :: NG1
+!INTEGER(KIND=JPIM) :: NG2
+!INTEGER(KIND=JPIM) :: NG3
+!INTEGER(KIND=JPIM) :: NG4
+!INTEGER(KIND=JPIM) :: NG5
+!INTEGER(KIND=JPIM) :: NG6
+!INTEGER(KIND=JPIM) :: NG7
+!INTEGER(KIND=JPIM) :: NG8
+!INTEGER(KIND=JPIM) :: NG9
+!INTEGER(KIND=JPIM) :: NG10
+!INTEGER(KIND=JPIM) :: NG11
+!INTEGER(KIND=JPIM) :: NG12
+!INTEGER(KIND=JPIM) :: NG13
+!INTEGER(KIND=JPIM) :: NG14
+!INTEGER(KIND=JPIM) :: NG15
+!INTEGER(KIND=JPIM) :: NG16
+
+!INTEGER(KIND=JPIM) :: NGS1
+!INTEGER(KIND=JPIM) :: NGS2
+!INTEGER(KIND=JPIM) :: NGS3
+!INTEGER(KIND=JPIM) :: NGS4
+!INTEGER(KIND=JPIM) :: NGS5
+!INTEGER(KIND=JPIM) :: NGS6
+!INTEGER(KIND=JPIM) :: NGS7
+!INTEGER(KIND=JPIM) :: NGS8
+!INTEGER(KIND=JPIM) :: NGS9
+!INTEGER(KIND=JPIM) :: NGS10
+!INTEGER(KIND=JPIM) :: NGS11
+!INTEGER(KIND=JPIM) :: NGS12
+!INTEGER(KIND=JPIM) :: NGS13
+!INTEGER(KIND=JPIM) :: NGS14
+!INTEGER(KIND=JPIM) :: NGS15
+!INTEGER(KIND=JPIM) :: NGS16
+
+INTEGER(KIND=JPIM), PARAMETER :: JPGPT  = 140
+INTEGER(KIND=JPIM), PARAMETER :: JPGLW  = 140
+
+!-- NGnn : number of g-points in each longwave spectral band
+INTEGER(KIND=JPIM), PARAMETER :: NG1  = 10
+INTEGER(KIND=JPIM), PARAMETER :: NG2  = 12
+INTEGER(KIND=JPIM), PARAMETER :: NG3  = 16
+INTEGER(KIND=JPIM), PARAMETER :: NG4  = 14
+INTEGER(KIND=JPIM), PARAMETER :: NG5  = 16
+INTEGER(KIND=JPIM), PARAMETER :: NG6  = 8
+INTEGER(KIND=JPIM), PARAMETER :: NG7  = 12
+INTEGER(KIND=JPIM), PARAMETER :: NG8  = 8
+INTEGER(KIND=JPIM), PARAMETER :: NG9  = 12
+INTEGER(KIND=JPIM), PARAMETER :: NG10 = 6
+INTEGER(KIND=JPIM), PARAMETER :: NG11 = 8
+INTEGER(KIND=JPIM), PARAMETER :: NG12 = 8
+INTEGER(KIND=JPIM), PARAMETER :: NG13 = 4
+INTEGER(KIND=JPIM), PARAMETER :: NG14 = 2
+INTEGER(KIND=JPIM), PARAMETER :: NG15 = 2
+INTEGER(KIND=JPIM), PARAMETER :: NG16 = 2
+!-- NGSnn: accumulated number of g-points at the beginning of spectral band nn+1
+INTEGER(KIND=JPIM), PARAMETER :: NGS1  = 10
+INTEGER(KIND=JPIM), PARAMETER :: NGS2  = 22
+INTEGER(KIND=JPIM), PARAMETER :: NGS3  = 38
+INTEGER(KIND=JPIM), PARAMETER :: NGS4  = 52
+INTEGER(KIND=JPIM), PARAMETER :: NGS5  = 68
+INTEGER(KIND=JPIM), PARAMETER :: NGS6  = 76
+INTEGER(KIND=JPIM), PARAMETER :: NGS7  = 88
+INTEGER(KIND=JPIM), PARAMETER :: NGS8  = 96
+INTEGER(KIND=JPIM), PARAMETER :: NGS9  = 108
+INTEGER(KIND=JPIM), PARAMETER :: NGS10 = 114
+INTEGER(KIND=JPIM), PARAMETER :: NGS11 = 122
+INTEGER(KIND=JPIM), PARAMETER :: NGS12 = 130
+INTEGER(KIND=JPIM), PARAMETER :: NGS13 = 134
+INTEGER(KIND=JPIM), PARAMETER :: NGS14 = 136
+INTEGER(KIND=JPIM), PARAMETER :: NGS15 = 138
+
+
+INTEGER(KIND=JPIM) :: NGN(JPGMAX), NGBLW(JPGMAX)
+
+!     ------------------------------------------------------------------
+END MODULE YOERRTM
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrto1.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrto1.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrto1.F90	(revision 3908)
@@ -0,0 +1,43 @@
+MODULE YOERRTO1
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB, JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTO1* - RRTM ORIGINAL COEFFICIENTS FOR INTERVAL 1
+!     BAND 1:  10-250 cm-1 (low - H2O; high - H2O)
+!     ABozzo may 2013 update to rrtmg v4.85
+!     band 1:  10-350 cm-1
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NO1  = 16
+
+REAL(KIND=JPRB) :: FRACREFAO(NO1)  , FRACREFBO(NO1)
+REAL(KIND=JPRB) :: KAO(5,13,NO1)
+REAL(KIND=JPRB) :: KBO(5,13:59,NO1)
+REAL(KIND=JPRD) :: KAO_D(5,13,NO1)
+REAL(KIND=JPRD) :: KBO_D(5,13:59,NO1)
+REAL(KIND=JPRB) :: KAO_MN2(19,NO1) , KBO_MN2(19,NO1)
+REAL(KIND=JPRB) :: SELFREFO(10,NO1), FORREFO(4,NO1)
+
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM LW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+!FRACREFAO: REAL    
+!FRACREFBO: REAL
+! FORREFO : REAL
+! KAO     : REAL     
+! KBO     : REAL     
+! SELFREFO: REAL     
+!     -----------------------------------------------------------------
+END MODULE YOERRTO1
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrto10.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrto10.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrto10.F90	(revision 3908)
@@ -0,0 +1,41 @@
+MODULE YOERRTO10
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB, JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTO14* - RRTM ORIGINAL COEFFICIENTS FOR INTERVAL 10
+!     BAND 10:  1390-1480 cm-1 (low - H2O; high - H2O)
+!     ABozzo 201306 updated to rrtmg v4.85
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NO10 = 16
+
+REAL(KIND=JPRB) , DIMENSION(NO10) :: FRACREFAO
+REAL(KIND=JPRB) , DIMENSION(NO10) :: FRACREFBO
+
+REAL(KIND=JPRB) :: KAO(5,13,NO10)
+REAL(KIND=JPRB) :: KBO(5,13:59,NO10)
+REAL(KIND=JPRD) :: KAO_D(5,13,NO10)
+REAL(KIND=JPRD) :: KBO_D(5,13:59,NO10)
+REAL(KIND=JPRB) :: SELFREFO(10,NO10)
+REAL(KIND=JPRB) :: FORREFO(4,NO10)
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE *
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! FRACREFA: REAL    
+! FRACREFB: REAL    
+! KA      : REAL     
+! KB      : REAL     
+!     -----------------------------------------------------------------
+END MODULE YOERRTO10
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrto11.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrto11.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrto11.F90	(revision 3908)
@@ -0,0 +1,44 @@
+MODULE YOERRTO11
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB, JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTO11* - RRTM ORIGINAL COEFFICIENTS FOR INTERVAL 11
+!     BAND 11:  1480-1800 cm-1 (low - H2O; high - H2O)
+!     ABozzo 201306 updated to rrtmg v4.85
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NO11 = 16
+
+REAL(KIND=JPRB) , DIMENSION(NO11) :: FRACREFAO
+REAL(KIND=JPRB) , DIMENSION(NO11) :: FRACREFBO
+
+REAL(KIND=JPRB) :: KAO(5,13,NO11)
+REAL(KIND=JPRB) :: KBO(5,13:59,NO11)
+REAL(KIND=JPRD) :: KAO_D(5,13,NO11)
+REAL(KIND=JPRD) :: KBO_D(5,13:59,NO11)
+REAL(KIND=JPRB) :: KAO_MO2(19,NO11)
+REAL(KIND=JPRB) :: KBO_MO2(19,NO11)
+REAL(KIND=JPRB) :: SELFREFO(10,NO11)
+REAL(KIND=JPRB) :: FORREFO(4,NO11)
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE *
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! FRACREFA: REAL    
+! FRACREFB: REAL    
+! KA      : REAL     
+! KB      : REAL     
+! SELFREF : REAL     
+!     -----------------------------------------------------------------
+END MODULE YOERRTO11
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrto12.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrto12.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrto12.F90	(revision 3908)
@@ -0,0 +1,36 @@
+MODULE YOERRTO12
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB, JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTO12* - RRTM ORIGINAL COEFFICIENTS FOR INTERVAL 12
+!     BAND 12:  1800-2080 cm-1 (low - H2O,CO2; high - nothing)
+!     ABozzo 201306 updated to rrtmg v4.85
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NO12 = 16
+
+REAL(KIND=JPRB) :: FRACREFAO(NO12,9)
+REAL(KIND=JPRB) :: KAO(9,5,13,NO12)
+REAL(KIND=JPRD) :: KAO_D(9,5,13,NO12)
+REAL(KIND=JPRB) :: SELFREFO(10,NO12)
+REAL(KIND=JPRB) :: FORREFO(4,NO12)
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM LW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! FRACREFA: REAL    
+! KA      : REAL     
+! SELFREF : REAL
+!     -----------------------------------------------------------------
+END MODULE YOERRTO12
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrto13.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrto13.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrto13.F90	(revision 3908)
@@ -0,0 +1,41 @@
+MODULE YOERRTO13
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB, JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTO13* - RRTM ORIGINAL COEFFICIENTS FOR INTERVAL 13
+!     BAND 13:  2080-2250 cm-1 (low - H2O,N2O; high - nothing)
+!     ABozzo 201306 updated to rrtmg v4.85
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NO13 = 16
+
+REAL(KIND=JPRB) :: FRACREFAO(NO13,9)
+REAL(KIND=JPRB) , DIMENSION(NO13) :: FRACREFBO
+
+REAL(KIND=JPRB) :: KAO(9,5,13,NO13)
+REAL(KIND=JPRD) :: KAO_D(9,5,13,NO13)
+REAL(KIND=JPRB) :: SELFREFO(10,NO13)
+REAL(KIND=JPRB) :: KAO_MCO2(9,19,NO13)
+REAL(KIND=JPRB) :: KAO_MCO(9,19,NO13)
+REAL(KIND=JPRB) :: KBO_MO3(19,NO13)
+REAL(KIND=JPRB) :: FORREFO(4,NO13)
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM LW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! FRACREFA: REAL    
+! KA      : REAL     
+! SELFREF : REAL
+!     -----------------------------------------------------------------
+END MODULE YOERRTO13
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrto14.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrto14.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrto14.F90	(revision 3908)
@@ -0,0 +1,42 @@
+MODULE YOERRTO14
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB, JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTO14* - RRTM ORIGINAL COEFFICIENTS FOR INTERVAL 14
+!     BAND 14:  2250-2380 cm-1 (low - CO2; high - CO2)
+!     ABozzo 201306 updated to rrtmg v4.85
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NO14 = 16
+
+REAL(KIND=JPRB) , DIMENSION(NO14) :: FRACREFAO
+REAL(KIND=JPRB) , DIMENSION(NO14) :: FRACREFBO
+
+REAL(KIND=JPRB) :: KAO(5,13,NO14)
+REAL(KIND=JPRB) :: KBO(5,13:59,NO14)
+REAL(KIND=JPRD) :: KAO_D(5,13,NO14)
+REAL(KIND=JPRD) :: KBO_D(5,13:59,NO14)
+REAL(KIND=JPRB) :: SELFREFO(10,NO14)
+REAL(KIND=JPRB) :: FORREFO(4,NO14)
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE *
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/01/15
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! FRACREFA: REAL    
+! FRACREFB: REAL    
+! KA      : REAL     
+! KB      : REAL     
+! SELFREF : REAL     
+!     -----------------------------------------------------------------
+END MODULE YOERRTO14
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrto15.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrto15.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrto15.F90	(revision 3908)
@@ -0,0 +1,39 @@
+MODULE YOERRTO15
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB,JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTO15* - RRTM ORIGINAL COEFFICIENTS FOR INTERVAL 15
+!     BAND 15:  2380-2600 cm-1 (low - N2O,CO2; high - nothing)
+!     ABozzo 2001306 updated to rrtmg v4.85
+!     band 15:  2380-2600 cm-1 (low - n2o,co2; low minor - n2)
+!                              (high - nothing)
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NO15 = 16
+
+REAL(KIND=JPRB) :: FRACREFAO(NO15,9)
+
+REAL(KIND=JPRB) :: KAO(9,5,13,NO15)
+REAL(KIND=JPRD) :: KAO_D(9,5,13,NO15)
+REAL(KIND=JPRB) :: SELFREFO(10,NO15)
+REAL(KIND=JPRB) :: FORREFO(4,NO15)
+REAL(KIND=JPRB) :: KAO_MN2(9,19,NO15)
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE *
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! FRACREFA: REAL    
+! KA      : REAL     
+! SELFREF : REAL 
+!     -----------------------------------------------------------------
+END MODULE YOERRTO15
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrto16.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrto16.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrto16.F90	(revision 3908)
@@ -0,0 +1,41 @@
+MODULE YOERRTO16
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB, JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTO16* - RRTM ORIGINAL COEFFICIENTS FOR INTERVAL 16
+!     BAND 16:  2600-3000 cm-1 (low - H2O,CH4; high - nothing)
+!     ABozzo 201306 updated to rrtmg v4.85
+!     band 16:  2600-3250 cm-1 (low key- h2o,ch4; high key - ch4)
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NO16 = 16
+
+REAL(KIND=JPRB) :: FRACREFAO(NO16,9)
+REAL(KIND=JPRB) , DIMENSION(NO16) :: FRACREFBO
+
+REAL(KIND=JPRB) :: KAO(9,5,13,NO16)
+REAL(KIND=JPRB) :: KBO(5,13:59,NO16)
+REAL(KIND=JPRD) :: KAO_D(9,5,13,NO16)
+REAL(KIND=JPRD) :: KBO_D(5,13:59,NO16)
+REAL(KIND=JPRB) :: SELFREFO(10,NO16)
+REAL(KIND=JPRB) :: FORREFO(4,NO16)
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM LW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! FRACREFA: REAL    
+! KA      : REAL     
+! SELFREF : REAL     
+!     -----------------------------------------------------------------
+END MODULE YOERRTO16
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrto2.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrto2.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrto2.F90	(revision 3908)
@@ -0,0 +1,45 @@
+MODULE YOERRTO2
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB, JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTO2* - RRTM ORIGINAL COEFFICIENTS FOR INTERVAL 2
+!     BAND 2:  250-500 cm-1 (low - H2O; high - H2O)
+! ABozzo May 2013 updated to rrtmg v4.85
+!     band 2:  350-500 cm-1 (low key - h2o; high key - h2o)
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NO2  = 16
+
+!     The ith set of reference fractions are from the ith reference
+!     pressure level.
+REAL(KIND=JPRB) :: FRACREFAO(NO2), FRACREFBO(NO2)
+REAL(KIND=JPRB) :: KAO(5,13,NO2)
+REAL(KIND=JPRB) :: KBO(5,13:59,NO2)
+REAL(KIND=JPRD) :: KAO_D(5,13,NO2)
+REAL(KIND=JPRD) :: KBO_D(5,13:59,NO2)
+REAL(KIND=JPRB) :: SELFREFO(10,NO2) , FORREFO(4,NO2)
+
+
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM LW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+!FRACREFAO: REAL    
+!FRACREFBO: REAL
+! KAO     : REAL     
+! KBO     : REAL     
+! SELFREFO: REAL
+! FORREFO : REAL  
+!     -----------------------------------------------------------------
+END MODULE YOERRTO2
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrto3.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrto3.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrto3.F90	(revision 3908)
@@ -0,0 +1,46 @@
+MODULE YOERRTO3
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB,JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTO3* - RRTM ORIGINAL COEFFICIENTS FOR INTERVAL 3
+!     BAND 3:  500-630 cm-1 (low - H2O,CO2; high - H2O,CO2)
+!      ABozzo 200130517 updated to rrtmg_lw_v4.85:
+!     band 3:  500-630 cm-1 (low key - h2o,co2; low minor - n2o)
+!                           (high key - h2o,co2; high minor - n2o)
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NO3  = 16
+
+REAL(KIND=JPRB) :: FRACREFAO(NO3,9) ,FRACREFBO(NO3,5)
+
+REAL(KIND=JPRB) :: KAO_MN2O(9,19,NO3), KBO_MN2O(5,19,NO3)
+REAL(KIND=JPRB) :: KAO(9,5,13,NO3)
+REAL(KIND=JPRB) :: KBO(5,5,13:59,NO3)
+REAL(KIND=JPRD) :: KAO_D(9,5,13,NO3)
+REAL(KIND=JPRD) :: KBO_D(5,5,13:59,NO3)
+REAL(KIND=JPRB) :: SELFREFO(10,NO3),FORREFO(4,NO3)
+
+
+!     ------------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM LW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! ABSN2OAO: REAL
+! ABSN2OBO: REAL
+!FRACREFAO: REAL    
+!FRACREFBO: REAL
+! KAO     : REAL     
+! KBO     : REAL     
+! SELFREFO: REAL     
+!     -----------------------------------------------------------------
+END MODULE YOERRTO3
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrto4.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrto4.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrto4.F90	(revision 3908)
@@ -0,0 +1,40 @@
+MODULE YOERRTO4
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB,JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTO4* - RRTM ORIGINAL COEFFICIENTS FOR INTERVAL 4
+!     BAND 4:  630-700 cm-1 (low - H2O,CO2; high - O3,CO2)
+!     201306 ABozzo updated to rrtmg v4.85
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NO4  = 16
+
+REAL(KIND=JPRB) :: FRACREFAO(NO4,9)  ,FRACREFBO(NO4,5) 
+REAL(KIND=JPRB) :: KAO(9,5,13,NO4)
+REAL(KIND=JPRB) :: KBO(5,5,13:59,NO4)
+REAL(KIND=JPRD) :: KAO_D(9,5,13,NO4)
+REAL(KIND=JPRD) :: KBO_D(5,5,13:59,NO4)
+REAL(KIND=JPRB) :: SELFREFO(10,NO4),FORREFO(4,NO4)
+
+
+!     ------------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM LW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! FRACREFA: REAL    
+! FRACREFB: REAL
+! KA      : REAL     
+! KB      : REAL     
+! SELFREF : REAL     
+!     -----------------------------------------------------------------
+END MODULE YOERRTO4
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrto5.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrto5.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrto5.F90	(revision 3908)
@@ -0,0 +1,45 @@
+MODULE YOERRTO5
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB,JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTO5* - RRTM ORIGINAL COEFFICIENTS FOR INTERVAL 5
+!     BAND 5:  700-820 cm-1 (low - H2O,CO2; high - O3,CO2)
+!     ABozzo 201306 updated to rrtmg v4.85
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NO5  = 16
+
+REAL(KIND=JPRB) :: FRACREFAO(NO5,9) ,FRACREFBO(NO5,5)
+
+REAL(KIND=JPRB) , DIMENSION(NO5) :: CCL4O
+
+REAL(KIND=JPRB) :: KAO_MO3(9,19,NO5)
+REAL(KIND=JPRB) :: KAO(9,5,13,NO5)
+REAL(KIND=JPRB) :: KBO(5,5,13:59,NO5)
+REAL(KIND=JPRD) :: KAO_D(9,5,13,NO5)
+REAL(KIND=JPRD) :: KBO_D(5,5,13:59,NO5)
+REAL(KIND=JPRB) :: SELFREFO(10,NO5)
+REAL(KIND=JPRB) :: FORREFO(4,NO5)
+
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM LW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! FRACREFA: REAL    
+! FRACREFB: REAL
+! KA      : REAL     
+! KB      : REAL     
+! SELFREF : REAL     
+!     -----------------------------------------------------------------
+END MODULE YOERRTO5
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrto6.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrto6.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrto6.F90	(revision 3908)
@@ -0,0 +1,44 @@
+MODULE YOERRTO6
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB, JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTO6* - RRTM ORIGINAL COEFFICIENTS FOR INTERVAL 6
+!     BAND 6:  820-980 cm-1 (low - H2O; high - nothing)
+!     ABozzo 201306 update to rrtmg v4.85
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NO6  = 16
+
+REAL(KIND=JPRB) , DIMENSION(NO6) :: FRACREFAO
+
+REAL(KIND=JPRB) , DIMENSION(NO6) :: CFC11ADJO
+REAL(KIND=JPRB) , DIMENSION(NO6) :: CFC12O
+
+
+REAL(KIND=JPRB) :: KAO(5,13,NO6)
+REAL(KIND=JPRD) :: KAO_D(5,13,NO6)
+REAL(KIND=JPRB) :: SELFREFO(10,NO6)
+REAL(KIND=JPRB) :: KAO_MCO2(19,NO6)
+REAL(KIND=JPRB) :: FORREFO(4,NO6)
+
+
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE *
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! FRACREFA: REAL    
+! KA      : REAL     
+! SELFREF : REAL     
+!     -----------------------------------------------------------------
+END MODULE YOERRTO6
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrto7.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrto7.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrto7.F90	(revision 3908)
@@ -0,0 +1,46 @@
+MODULE YOERRTO7
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB,JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTO7* - RRTM ORIGINAL COEFFICIENTS FOR INTERVAL 7
+!     BAND 7:  980-1080 cm-1 (low - H2O,O3; high - O3)
+!     ABozzo updated to rrtmg v4.85
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NO7  = 16
+
+REAL(KIND=JPRB) :: FRACREFAO(NO7,9)
+
+REAL(KIND=JPRB) , DIMENSION(NO7) :: FRACREFBO
+REAL(KIND=JPRB) :: KAO(9,5,13,NO7)
+REAL(KIND=JPRB) :: KBO(5,13:59,NO7)
+REAL(KIND=JPRD) :: KAO_D(9,5,13,NO7)
+REAL(KIND=JPRD) :: KBO_D(5,13:59,NO7)
+REAL(KIND=JPRB) :: SELFREFO(10,NO7)
+REAL(KIND=JPRB) :: KAO_MCO2(9,19,NO7)
+REAL(KIND=JPRB) :: KBO_MCO2(19,NO7)
+REAL(KIND=JPRB) :: FORREFO(4,NO7)
+
+
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE *
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! FRACREFA: REAL    
+! FRACREFB: REAL    
+! KA      : REAL     
+! KB      : REAL     
+! SELFREF : REAL  
+!     -----------------------------------------------------------------
+END MODULE YOERRTO7
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrto8.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrto8.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrto8.F90	(revision 3908)
@@ -0,0 +1,57 @@
+MODULE YOERRTO8
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB,JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTO8* - RRTM ORIGINAL COEFFICIENTS FOR INTERVAL 8
+!     BAND 8:  1080-1180 cm-1 (low (i.e.>~300mb) - H2O; high - O3)
+!     ABozzo 201306 updated to rrtmg v4.85
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NO8  = 16
+
+REAL(KIND=JPRB) , DIMENSION(NO8) :: FRACREFAO
+REAL(KIND=JPRB) , DIMENSION(NO8) :: FRACREFBO
+REAL(KIND=JPRB) , DIMENSION(NO8) :: CFC12O
+REAL(KIND=JPRB) , DIMENSION(NO8) :: CFC22ADJO
+
+REAL(KIND=JPRB) :: KAO(5,13,NO8)
+REAL(KIND=JPRB) :: KBO(5,13:59,NO8)
+REAL(KIND=JPRD) :: KAO_D(5,13,NO8)
+REAL(KIND=JPRD) :: KBO_D(5,13:59,NO8)
+REAL(KIND=JPRB) :: SELFREFO(10,NO8)
+REAL(KIND=JPRB) :: KAO_MCO2(19,NO8)
+REAL(KIND=JPRB) :: KAO_MN2O(19,NO8)
+REAL(KIND=JPRB) :: KAO_MO3(19,NO8)
+REAL(KIND=JPRB) :: KBO_MCO2(19,NO8)
+REAL(KIND=JPRB) :: KBO_MN2O(19,NO8)
+REAL(KIND=JPRB) :: FORREFO(4,NO8)
+
+
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE *
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! ABSCO2A : REAL     
+! ABSCO2B : REAL     
+! ABSN2OA : REAL     
+! ABSN2OB : REAL 
+! CFC12   : REAL     
+! CFC22ADJ: REAL     
+! FRACREFA: REAL    
+! FRACREFB: REAL    
+! KA      : REAL     
+! KB      : REAL     
+! SELFREF : REAL     
+!     -----------------------------------------------------------------
+END MODULE YOERRTO8
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrto9.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrto9.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrto9.F90	(revision 3908)
@@ -0,0 +1,51 @@
+MODULE YOERRTO9
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB,JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTO9* - RRTM ORIGINAL COEFFICIENTS FOR INTERVAL 9
+!     BAND 9:  1180-1390 cm-1 (low - H2O,CH4; high - CH4)
+!     ABozzo 201306 updated to rrtmg v4.85
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: NO9  = 16
+
+REAL(KIND=JPRB) :: FRACREFAO(NO9,9)
+
+REAL(KIND=JPRB) , DIMENSION(NO9) :: FRACREFBO
+! 48 = 3*NO9      
+
+
+REAL(KIND=JPRB) :: KAO(9,5,13,NO9)
+REAL(KIND=JPRB) :: KBO(5,13:59,NO9)
+REAL(KIND=JPRD) :: KAO_D(9,5,13,NO9)
+REAL(KIND=JPRD) :: KBO_D(5,13:59,NO9)
+REAL(KIND=JPRB) :: KAO_MN2O(9,19,NO9)
+REAL(KIND=JPRB) :: KBO_MN2O(19,NO9)
+REAL(KIND=JPRB) :: SELFREFO(10,NO9)
+REAL(KIND=JPRB) :: FORREFO(4,NO9)
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM LW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! ABSN2O  : REAL    
+! CH4REF  : REAL
+! ETAREF  : REAL
+! FRACREFA: REAL    
+! FRACREFB: REAL
+! H2OREF  : REAL
+! N2OREF  : REAL
+! KA      : REAL     
+! KB      : REAL     
+! SELFREF : REAL     
+!     -----------------------------------------------------------------
+END MODULE YOERRTO9
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrtrf.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrtrf.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrtrf.F90	(revision 3908)
@@ -0,0 +1,31 @@
+MODULE YOERRTRF
+
+USE PARKIND1  ,ONLY : JPRB
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOERRTRF* - RRTM REFERENCE ATMOSPHERE
+!     -----------------------------------------------------------------
+
+REAL(KIND=JPRB) , DIMENSION(59) :: PREF
+REAL(KIND=JPRB) , DIMENSION(59) :: PREFLOG
+REAL(KIND=JPRB) , DIMENSION(59) :: TREF
+REAL(KIND=JPRB)  :: CHI_MLS(7,59)
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM LW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/01/15
+
+!  NAME     TYPE     PURPOSE
+!  ----  :  ----   : ---------------------------------------------------
+! PREF   :  REAL    
+! PREFLOG: REAL
+! TREF   : REAL
+!     -----------------------------------------------------------------
+END MODULE YOERRTRF
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrtrwt.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrtrwt.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrtrwt.F90	(revision 3908)
@@ -0,0 +1,36 @@
+MODULE YOERRTRWT
+
+USE PARKIND1, ONLY : JPRB
+!USE PARRRTM,  ONLY : JPGPT, JPG, JPBAND
+USE PARRRTM,  ONLY : JPG, JPBAND, JPGMAX
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!    -------------------------------------------------------------------
+
+!    -------------------------------------------------------------------
+
+REAL(KIND=JPRB) :: FREFA  (JPGMAX,13)
+REAL(KIND=JPRB) :: FREFB  (JPGMAX,6)
+REAL(KIND=JPRB) :: FREFADF(JPGMAX,13)
+REAL(KIND=JPRB) :: FREFBDF(JPGMAX,6)
+REAL(KIND=JPRB) :: RWGT   (JPG*JPBAND)
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM LW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----  :  ----   : ---------------------------------------------------
+! FREFA  :  REAL   :
+! FREFB  :  REAL   :
+! FREFADF:  REAL   :
+! FREFBDF:  REAL   :
+! RWT    :  REAL   : 
+!    -------------------------------------------------------------------
+END MODULE YOERRTRWT
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoerrtwn.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoerrtwn.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoerrtwn.F90	(revision 3908)
@@ -0,0 +1,36 @@
+MODULE YOERRTWN
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!    -------------------------------------------------------------------
+
+INTEGER(KIND=JPIM) , DIMENSION(16) :: NG
+INTEGER(KIND=JPIM) , DIMENSION(16) :: NSPA
+INTEGER(KIND=JPIM) , DIMENSION(16) :: NSPB
+
+REAL(KIND=JPRB) , DIMENSION(16) :: DELWAVE
+
+REAL(KIND=JPRB) , DIMENSION(181,16) :: TOTPLNK
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM LW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      98/01/15
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----    : -------
+!  NG     : INTEGER : Number of k-coefficients in spectral intervals
+!  NSPA   : INTEGER :
+!  NSPB   : INTEGER :
+! WAVENUM1: REAL    : Lower wavenumber spectral limit
+! WAVENUM2: REAL    : Higher wavenumber spectral limit
+! DELWAVE : REAL    : Spectral interval width
+! TOTPLNK : REAL    :
+!     -----------------------------------------------------------------
+END MODULE YOERRTWN
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoesrta16.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoesrta16.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoesrta16.F90	(revision 3908)
@@ -0,0 +1,59 @@
+MODULE YOESRTA16
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB,JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOESRTA16* - SRTM COEFFICIENTS FOR INTERVAL 16
+!     BAND 16:  2600-3250 cm-1 (low - H2O,CH4; high - CH4)
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: JPG=16, NG16 = 16, NGS15 = 0
+
+REAL(KIND=JPRB) :: KA(9,5,13,JPG) 
+REAL(KIND=JPRB) :: KB(5,13:59,JPG)
+REAL(KIND=JPRD) :: KA_D(9,5,13,JPG) 
+REAL(KIND=JPRD) :: KB_D(5,13:59,JPG)
+REAL(KIND=JPRB) :: SELFREF(10,JPG),FORREF(3,JPG)
+REAL(KIND=JPRB) :: SFLUXREF(JPG)
+REAL(KIND=JPRB) :: RAYL            ,STRRAT1
+INTEGER(KIND=JPIM) :: LAYREFFR
+
+REAL(KIND=JPRB) :: KAC(9,5,13,NG16),ABSA(585,NG16)
+REAL(KIND=JPRB) :: KBC(5,13:59,NG16),ABSB(235,NG16)
+REAL(KIND=JPRB) :: SELFREFC(10,NG16),FORREFC(3,NG16)
+REAL(KIND=JPRB) :: SFLUXREFC(NG16)
+
+!EQUIVALENCE (KA(1,1,1,1),ABSA(1,1)), (KB(1,13,1),ABSB(1,1))
+EQUIVALENCE (KAC(1,1,1,1),ABSA(1,1)), (KBC(1,13,1),ABSB(1,1))
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM SW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      02/10/29
+!     M. J. IACONO          AER             12/09/03
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! KA      : REAL     absorption coefficient of major absorber
+! KB      : REAL     absorption coefficient of secondary absorber
+! SELFREF : REAL     self brodening coefficient for water vapour
+! FORREF  : REAL     foreign broadening coefficient for water vapour
+! SFLUXREF: REAL     Incident solar radiation in the spectral interval
+! RAYL    : REAL     Rayleigh scattering parameter
+! STRRAT1 : REAL     weighting factor for the transition between tropospheric 
+!                    and stratospheric computations
+! LAYREFFR: INTEGER  reference level for the transition
+! KAC     : REAL     Reduced g-point array for KA
+! KBC     : REAL     Reduced g-point array for KB
+! SELFREFC: REAL     Reduced g-point array for SELFREF
+! FORREFC : REAL     Reduced g-point array for FORREF
+!SFLUXREFC: REAL     Reduced g-point array for SFLUXREF
+!     -----------------------------------------------------------------
+END MODULE YOESRTA16
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoesrta17.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoesrta17.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoesrta17.F90	(revision 3908)
@@ -0,0 +1,58 @@
+MODULE YOESRTA17
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB,JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOESRTA17* - SRTM COEFFICIENTS FOR INTERVAL 17
+!     BAND 17:  3250-4000 cm-1 (low - H2O,CO2; high - H2O,CO2)
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER ::  JPG = 16, NG17 = 16, NGS16=16
+
+REAL(KIND=JPRB) :: KA(9,5,13,JPG)  
+REAL(KIND=JPRB) :: KB(5,5,13:59,JPG)
+REAL(KIND=JPRD) :: KA_D(9,5,13,JPG)  
+REAL(KIND=JPRD) :: KB_D(5,5,13:59,JPG)
+REAL(KIND=JPRB) :: SELFREF(10,JPG)  ,FORREF(4,JPG)
+REAL(KIND=JPRB) :: SFLUXREF(JPG,5)
+REAL(KIND=JPRB) :: RAYL              ,STRRAT
+INTEGER(KIND=JPIM) :: LAYREFFR
+
+REAL(KIND=JPRB) :: KAC(9,5,13,NG17),ABSA(585,NG17)
+REAL(KIND=JPRB) :: KBC(5,5,13:59,NG17),ABSB(1175,NG17)
+REAL(KIND=JPRB) :: SELFREFC(10,NG17),FORREFC(4,NG17)
+REAL(KIND=JPRB) :: SFLUXREFC(NG17,5)
+
+!EQUIVALENCE (KA(1,1,1,1),ABSA(1,1)), (KB(1,1,13,1),ABSB(1,1))
+EQUIVALENCE (KAC(1,1,1,1),ABSA(1,1)), (KBC(1,1,13,1),ABSB(1,1))
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM SW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      02/10/29
+!     M. J. IACONO          AER             12/09/03
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! KA      : REAL     absorption coefficient of major absorber
+! KB      : REAL     absorption coefficient of secondary absorber
+! SELFREF : REAL     self brodening coefficient for water vapour
+! FORREF  : REAL     foreign broadening coefficient for water vapour
+! SFLUXREF: REAL     Incident solar radiation in the spectral interval
+! RAYL    : REAL     Rayleigh scattering parameter
+! STRRAT  : REAL     weighting factor for the transition between tropospheric 
+!                    and stratospheric computations
+! LAYREFFR: INTEGER  reference level for the transition
+! KAC     : REAL     Reduced g-point array for KA
+! KBC     : REAL     Reduced g-point array for KB
+! SELFREFC: REAL     Reduced g-point array for SELFREF
+! FORREFC : REAL     Reduced g-point array for FORREF
+!SFLUXREFC: REAL     Reduced g-point array for SFLUXREF
+!     -----------------------------------------------------------------
+END MODULE YOESRTA17
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoesrta18.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoesrta18.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoesrta18.F90	(revision 3908)
@@ -0,0 +1,60 @@
+MODULE YOESRTA18
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB,JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOESRTA18* - SRTM COEFFICIENTS FOR INTERVAL 16
+!     BAND 18:  4000-4650 cm-1 (low - H2O,CH4; high - CH4)
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: JPG = 16, NG18 = 16, NGS17=32
+
+REAL(KIND=JPRB) :: KA(9,5,13,JPG) 
+REAL(KIND=JPRB) :: KB(5,13:59,JPG)
+REAL(KIND=JPRD) :: KA_D(9,5,13,JPG) 
+REAL(KIND=JPRD) :: KB_D(5,13:59,JPG)
+REAL(KIND=JPRB) :: SELFREF(10,JPG),FORREF(3,JPG)
+REAL(KIND=JPRB) :: SFLUXREF(JPG,9)
+REAL(KIND=JPRB) :: RAYL            ,STRRAT
+
+INTEGER(KIND=JPIM) :: LAYREFFR
+
+REAL(KIND=JPRB) :: KAC(9,5,13,NG18) ,ABSA(585,NG18)
+REAL(KIND=JPRB) :: KBC(5,13:59,NG18),ABSB(235,NG18)
+REAL(KIND=JPRB) :: SELFREFC(10,NG18),FORREFC(3,NG18)
+REAL(KIND=JPRB) :: SFLUXREFC(NG18,9)
+
+!EQUIVALENCE (KA(1,1,1,1),ABSA(1,1)), (KB(1,13,1),ABSB(1,1))
+EQUIVALENCE (KAC(1,1,1,1),ABSA(1,1)), (KBC(1,13,1),ABSB(1,1))
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM SW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      02/10/29
+!     M. J. IACONO          AER             12/09/03
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! KA      : REAL     absorption coefficient of major absorber
+! KB      : REAL     absorption coefficient of secondary absorber
+! SELFREF : REAL     self brodening coefficient for water vapour
+! FORREF  : REAL     foreign broadening coefficient for water vapour
+! SFLUXREF: REAL     Incident solar radiation in the spectral interval
+! RAYL    : REAL     Rayleigh scattering parameter
+! STRRAT  : REAL     weighting factor for the transition between tropospheric 
+!                    and stratospheric computations
+! LAYREFFR: INTEGER  reference level for the transition
+! KAC     : REAL     Reduced g-point array for KA
+! KBC     : REAL     Reduced g-point array for KB
+! SELFREFC: REAL     Reduced g-point array for SELFREF
+! FORREFC : REAL     Reduced g-point array for FORREF
+!SFLUXREFC: REAL     Reduced g-point array for SFLUXREF
+!     -----------------------------------------------------------------
+END MODULE YOESRTA18
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoesrta19.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoesrta19.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoesrta19.F90	(revision 3908)
@@ -0,0 +1,58 @@
+MODULE YOESRTA19
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB,JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOESRTA19* - SRTM COEFFICIENTS FOR INTERVAL 19
+!     BAND 19:  4650-5150 cm-1 (low - H2O,CO2; high - CO2)
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: JPG = 16, NG19 = 16
+
+REAL(KIND=JPRB) :: KA(9,5,13,JPG) 
+REAL(KIND=JPRB) :: KB(5,13:59,JPG)
+REAL(KIND=JPRD) :: KA_D(9,5,13,JPG) 
+REAL(KIND=JPRD) :: KB_D(5,13:59,JPG)
+REAL(KIND=JPRB) :: SELFREF(10,JPG),FORREF(3,JPG)
+REAL(KIND=JPRB) :: SFLUXREF(JPG,9)
+REAL(KIND=JPRB) :: RAYL            ,STRRAT
+INTEGER(KIND=JPIM) :: LAYREFFR
+
+REAL(KIND=JPRB) :: KAC(9,5,13,NG19) ,ABSA(585,NG19)
+REAL(KIND=JPRB) :: KBC(5,13:59,NG19),ABSB(235,NG19)
+REAL(KIND=JPRB) :: SELFREFC(10,NG19),FORREFC(3,NG19)
+REAL(KIND=JPRB) :: SFLUXREFC(NG19,9)
+
+!EQUIVALENCE (KA(1,1,1,1),ABSA(1,1)), (KB(1,13,1),ABSB(1,1))
+EQUIVALENCE (KAC(1,1,1,1),ABSA(1,1)), (KBC(1,13,1),ABSB(1,1))
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM SW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      02/10/29
+!     M. J. IACONO          AER             12/09/03
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! KA      : REAL     absorption coefficient of major absorber
+! KB      : REAL     absorption coefficient of secondary absorber
+! SELFREF : REAL     self brodening coefficient for water vapour
+! FORREF  : REAL     foreign broadening coefficient for water vapour
+! SFLUXREF: REAL     Incident solar radiation in the spectral interval
+! RAYL    : REAL     Rayleigh scattering parameter
+! STRRAT  : REAL     weighting factor for the transition between tropospheric 
+!                    and stratospheric computations
+! LAYREFFR: INTEGER  reference level for the transition
+! KAC     : REAL     Reduced g-point array for KA
+! KBC     : REAL     Reduced g-point array for KB
+! SELFREFC: REAL     Reduced g-point array for SELFREF
+! FORREFC : REAL     Reduced g-point array for FORREF
+!SFLUXREFC: REAL     Reduced g-point array for SFLUXREF
+!     -----------------------------------------------------------------
+END MODULE YOESRTA19
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoesrta20.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoesrta20.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoesrta20.F90	(revision 3908)
@@ -0,0 +1,59 @@
+MODULE YOESRTA20
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB,JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOESRTA20* - SRTM COEFFICIENTS FOR INTERVAL 20
+!     BAND 20:  5150-6150 cm-1 (low - H2O; high - H2O)
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: JPG = 16, NG20 = 16
+
+REAL(KIND=JPRB) :: KA(5,13,JPG)   
+REAL(KIND=JPRB) :: KB(5,13:59,JPG)
+REAL(KIND=JPRD) :: KA_D(5,13,JPG)   
+REAL(KIND=JPRD) :: KB_D(5,13:59,JPG)
+REAL(KIND=JPRB) :: SELFREF(10,JPG),FORREF(4,JPG)
+REAL(KIND=JPRB) :: SFLUXREF(JPG)  ,ABSCH4(JPG)
+REAL(KIND=JPRB) :: RAYL
+INTEGER(KIND=JPIM) :: LAYREFFR
+
+REAL(KIND=JPRB) :: KAC(5,13,NG20)   ,ABSA(65,NG20)
+REAL(KIND=JPRB) :: KBC(5,13:59,NG20),ABSB(235,NG20)
+REAL(KIND=JPRB) :: SELFREFC(10,NG20),FORREFC(4,NG20)
+REAL(KIND=JPRB) :: SFLUXREFC(NG20)  ,ABSCH4C(NG20)
+
+!EQUIVALENCE (KA(1,1,1),ABSA(1,1)), (KB(1,13,1),ABSB(1,1))
+EQUIVALENCE (KAC(1,1,1),ABSA(1,1)), (KBC(1,13,1),ABSB(1,1))
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM SW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      02/10/29
+!     M. J. IACONO          AER             12/09/03
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! KA      : REAL     absorption coefficient of major absorber
+! KB      : REAL     absorption coefficient of secondary absorber
+! SELFREF : REAL     self brodening coefficient for water vapour
+! FORREF  : REAL     foreign broadening coefficient for water vapour
+! SFLUXREF: REAL     Incident solar radiation in the spectral interval
+! ABSCH4  : REAL     absorption coefficient for CH4
+! RAYL    : REAL     Rayleigh scattering parameter
+! LAYREFFR: INTEGER  reference level for the transition
+! KAC     : REAL     Reduced g-point array for KA
+! KBC     : REAL     Reduced g-point array for KB
+! SELFREFC: REAL     Reduced g-point array for SELFREF
+! FORREFC : REAL     Reduced g-point array for FORREF
+!SFLUXREFC: REAL     Reduced g-point array for SFLUXREF
+! ABSCH4C : REAL     Reduced g-point array for ABSCH4
+!     -----------------------------------------------------------------
+END MODULE YOESRTA20
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoesrta21.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoesrta21.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoesrta21.F90	(revision 3908)
@@ -0,0 +1,59 @@
+MODULE YOESRTA21
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB,JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOESRTA21* - SRTM COEFFICIENTS FOR INTERVAL 21
+!     BAND 21:  6150-7700 cm-1 (low - H2O,CO2; high - H2O,CO2)
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: JPG = 16, NG21 = 16
+
+REAL(KIND=JPRB) :: KA(9,5,13,JPG)   
+REAL(KIND=JPRB) :: KB(5,5,13:59,JPG)
+REAL(KIND=JPRD) :: KA_D(9,5,13,JPG)   
+REAL(KIND=JPRD) :: KB_D(5,5,13:59,JPG)
+REAL(KIND=JPRB) :: SELFREF(10,JPG)  ,FORREF(4,JPG)
+REAL(KIND=JPRB) :: SFLUXREF(JPG,9)
+REAL(KIND=JPRB) :: RAYL              ,STRRAT
+INTEGER(KIND=JPIM) :: LAYREFFR
+
+REAL(KIND=JPRB) :: KAC(9,5,13,NG21)   ,ABSA(585,NG21)
+REAL(KIND=JPRB) :: KBC(5,5,13:59,NG21),ABSB(1175,NG21)
+REAL(KIND=JPRB) :: SELFREFC(10,NG21)  ,FORREFC(4,NG21)
+REAL(KIND=JPRB) :: SFLUXREFC(NG21,9)
+
+!EQUIVALENCE (KA(1,1,1,1),ABSA(1,1)), (KB(1,1,13,1),ABSB(1,1))
+EQUIVALENCE (KAC(1,1,1,1),ABSA(1,1)), (KBC(1,1,13,1),ABSB(1,1))
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM SW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      02/10/29
+!     M. J. IACONO          AER             12/09/03
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! KA      : REAL     absorption coefficient of major absorber
+! KB      : REAL     absorption coefficient of secondary absorber
+! SELFREF : REAL     self brodening coefficient for water vapour
+! FORREF  : REAL     foreign broadening coefficient for water vapour
+! SFLUXREF: REAL     Incident solar radiation in the spectral interval
+! RAYL    : REAL     Rayleigh scattering parameter
+! STRRAT  : REAL     weighting factor for the transition between tropospheric 
+!                    and stratospheric computations
+! LAYREFFR: INTEGER  reference level for the transition
+! KAC     : REAL     Reduced g-point array for KA
+! KBC     : REAL     Reduced g-point array for KB
+! SELFREFC: REAL     Reduced g-point array for SELFREF
+! FORREFC : REAL     Reduced g-point array for FORREF
+!SFLUXREFC: REAL     Reduced g-point array for SFLUXREF
+!     -----------------------------------------------------------------
+END MODULE YOESRTA21
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoesrta22.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoesrta22.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoesrta22.F90	(revision 3908)
@@ -0,0 +1,59 @@
+MODULE YOESRTA22
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB,JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOESRTA22* - SRTM COEFFICIENTS FOR INTERVAL 22
+!     BAND 22:  7700-8050 cm-1 (low - H2O,O2; high - O2)
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: JPG = 16, NG22 = 16
+
+REAL(KIND=JPRB) :: KA(9,5,13,JPG) 
+REAL(KIND=JPRB) :: KB(5,13:59,JPG)
+REAL(KIND=JPRD) :: KA_D(9,5,13,JPG) 
+REAL(KIND=JPRD) :: KB_D(5,13:59,JPG)
+REAL(KIND=JPRB) :: SELFREF(10,JPG),FORREF(3,JPG)
+REAL(KIND=JPRB) :: SFLUXREF(JPG,9)
+REAL(KIND=JPRB) :: RAYL            ,STRRAT
+INTEGER(KIND=JPIM) :: LAYREFFR
+
+REAL(KIND=JPRB) :: KAC(9,5,13,NG22) ,ABSA(585,NG22)
+REAL(KIND=JPRB) :: KBC(5,13:59,NG22),ABSB(235,NG22)
+REAL(KIND=JPRB) :: SELFREFC(10,NG22),FORREFC(3,NG22)
+REAL(KIND=JPRB) :: SFLUXREFC(NG22,9)
+
+!EQUIVALENCE (KA(1,1,1,1),ABSA(1,1)), (KB(1,13,1),ABSB(1,1))
+EQUIVALENCE (KAC(1,1,1,1),ABSA(1,1)), (KBC(1,13,1),ABSB(1,1))
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM SW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      02/10/29
+!     M. J. IACONO          AER             12/09/03
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! KA      : REAL     absorption coefficient of major absorber
+! KB      : REAL     absorption coefficient of secondary absorber
+! SELFREF : REAL     self brodening coefficient for water vapour
+! FORREF  : REAL     foreign broadening coefficient for water vapour
+! SFLUXREF: REAL     Incident solar radiation in the spectral interval
+! RAYL    : REAL     Rayleigh scattering parameter
+! STRRAT  : REAL     weighting factor for the transition between tropospheric 
+!                    and stratospheric computations
+! LAYREFFR: INTEGER  reference level for the transition
+! KAC     : REAL     Reduced g-point array for KA
+! KBC     : REAL     Reduced g-point array for KB
+! SELFREFC: REAL     Reduced g-point array for SELFREF
+! FORREFC : REAL     Reduced g-point array for FORREF
+!SFLUXREFC: REAL     Reduced g-point array for SFLUXREF
+!     -----------------------------------------------------------------
+END MODULE YOESRTA22
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoesrta23.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoesrta23.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoesrta23.F90	(revision 3908)
@@ -0,0 +1,55 @@
+MODULE YOESRTA23
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB,JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOESRTA23* - SRTM COEFFICIENTS FOR INTERVAL 23
+!     BAND 23:  8050-12850 cm-1 (low - H2O; high - nothing)
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: JPG = 16, NG23 = 16
+
+REAL(KIND=JPRB) :: KA(5,13,JPG)   
+REAL(KIND=JPRD) :: KA_D(5,13,JPG)   
+REAL(KIND=JPRB) :: SELFREF(10,JPG),FORREF(3,JPG)
+REAL(KIND=JPRB) :: SFLUXREF(JPG)  ,RAYL(JPG)
+REAL(KIND=JPRB) :: GIVFAC
+INTEGER(KIND=JPIM) :: LAYREFFR
+
+REAL(KIND=JPRB) :: KAC(5,13,NG23)   ,ABSA(65,NG23)
+REAL(KIND=JPRB) :: SELFREFC(10,NG23),FORREFC(3,NG23)
+REAL(KIND=JPRB) :: SFLUXREFC(NG23)  ,RAYLC(NG23)
+
+!EQUIVALENCE (KA(1,1,1),ABSA(1,1))
+EQUIVALENCE (KAC(1,1,1),ABSA(1,1))
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM SW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      02/10/29
+!     M. J. IACONO          AER             12/09/03
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! LAYREFFR: INTEGER
+! KA      : REAL     absorption coefficient of major absorber
+! SELFREF : REAL     self brodening coefficient for water vapour
+! FORREF  : REAL     foreign broadening coefficient for water vapour
+! SFLUXREF: REAL     Incident solar radiation in the spectral interval
+! RAYL    : REAL     Rayleigh scattering parameter
+! GIVFAC  : REAL     adjustment factor
+! LAYREFFR: INTEGER  reference level for the transition
+! KAC     : REAL     Reduced g-point array for KA
+! SELFREFC: REAL     Reduced g-point array for SELFREF
+! FORREFC : REAL     Reduced g-point array for FORREF
+!SFLUXREFC: REAL     Reduced g-point array for SFLUXREF
+! RAYLC   : REAL     Reduced g-point array for RAYL
+!     -----------------------------------------------------------------
+END MODULE YOESRTA23
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoesrta24.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoesrta24.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoesrta24.F90	(revision 3908)
@@ -0,0 +1,68 @@
+MODULE YOESRTA24
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB,JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOESRTA24* - SRTM COEFFICIENTS FOR INTERVAL 24
+!     BAND 24: 12850-16000 cm-1 (low - H2O,O2; high - O2)
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: JPG = 16, NG24 = 16
+
+REAL(KIND=JPRB) :: KA(9,5,13,JPG) 
+REAL(KIND=JPRB) :: KB(5,13:59,JPG)
+REAL(KIND=JPRD) :: KA_D(9,5,13,JPG) 
+REAL(KIND=JPRD) :: KB_D(5,13:59,JPG)
+REAL(KIND=JPRB) :: SELFREF(10,JPG),FORREF(3,JPG)
+REAL(KIND=JPRB) :: SFLUXREF(JPG,9)
+REAL(KIND=JPRB) :: ABSO3A(JPG), ABSO3B(JPG), RAYLA(JPG,9), RAYLB(JPG)
+REAL(KIND=JPRB) :: STRRAT
+INTEGER(KIND=JPIM) :: LAYREFFR
+
+REAL(KIND=JPRB) :: KAC(9,5,13,NG24) ,ABSA(585,NG24)
+REAL(KIND=JPRB) :: KBC(5,13:59,NG24),ABSB(235,NG24)
+REAL(KIND=JPRB) :: SELFREFC(10,NG24),FORREFC(3,NG24)
+REAL(KIND=JPRB) :: SFLUXREFC(NG24,9)
+REAL(KIND=JPRB) :: ABSO3AC(NG24), ABSO3BC(NG24), RAYLAC(NG24,9), RAYLBC(NG24)
+
+!EQUIVALENCE (KA(1,1,1,1),ABSA(1,1)), (KB(1,13,1),ABSB(1,1))
+EQUIVALENCE (KAC(1,1,1,1),ABSA(1,1)), (KBC(1,13,1),ABSB(1,1))
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM SW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      02/10/29
+!     M. J. IACONO          AER             12/09/03
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! KA      : REAL     absorption coefficient of major absorber
+! KB      : REAL     absorption coefficient of secondary absorber
+! SELFREF : REAL     self brodening coefficient for water vapour
+! FORREF  : REAL     foreign broadening coefficient for water vapour
+! SFLUXREF: REAL     Incident solar radiation in the spectral interval
+! ABSO3A  : REAL     O3 absorption coefficient in first part of band
+! ABSO3B  : REAL     O3 absorption coefficient in second part of band
+! RAYLA   : REAL     Rayleigh scattering parameter in first part of band
+! RAYLB   : REAL     Rayleigh scattering parameter in second part of band   
+! STRRAT  : REAL     weighting factor for the transition between tropospheric 
+!                    and stratospheric computations
+! LAYREFFR: INTEGER  reference level for the transition
+! KAC     : REAL     Reduced g-point array for KA
+! KBC     : REAL     Reduced g-point array for KB
+! SELFREFC: REAL     Reduced g-point array for SELFREF
+! FORREFC : REAL     Reduced g-point array for FORREF
+!SFLUXREFC: REAL     Reduced g-point array for SFLUXREF
+! ABSO3AC : REAL     Reduced g-point array for ABSO3A
+! ABSO3BC : REAL     Reduced g-point array for ABSO3B
+! RAYLAC  : REAL     Reduced g-point array for RAYLA
+! RAYLBC  : REAL     Reduced g-point array for RAYLB
+!     -----------------------------------------------------------------
+END MODULE YOESRTA24
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoesrta25.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoesrta25.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoesrta25.F90	(revision 3908)
@@ -0,0 +1,52 @@
+MODULE YOESRTA25
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB,JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOESRTA25* - SRTM COEFFICIENTS FOR INTERVAL 25
+!     BAND 25: 16000-22650 cm-1 (low - H2O; high - nothing)
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: JPG = 16, NG25 = 16
+
+REAL(KIND=JPRB) :: KA(5,13,JPG) 
+REAL(KIND=JPRD) :: KA_D(5,13,JPG) 
+REAL(KIND=JPRB) :: SFLUXREF(JPG)
+REAL(KIND=JPRB) :: RAYL(JPG), ABSO3A(JPG), ABSO3B(JPG)
+INTEGER(KIND=JPIM) :: LAYREFFR
+
+REAL(KIND=JPRB) :: KAC(5,13,NG25) ,ABSA(65,NG25)
+REAL(KIND=JPRB) :: SFLUXREFC(NG25)
+REAL(KIND=JPRB) :: RAYLC(NG25), ABSO3AC(NG25), ABSO3BC(NG25)
+
+!EQUIVALENCE (KA(1,1,1),ABSA(1,1))
+EQUIVALENCE (KAC(1,1,1),ABSA(1,1))
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM SW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      02/10/29
+!     M. J. IACONO          AER             12/09/03
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! KA      : REAL     absorption coefficient of major absorber
+! SFLUXREF: REAL     Incident solar radiation in the spectral interval
+! RAYL    : REAL     Rayleigh scattering parameter
+! ABSO3A  : REAL     O3 absorption coefficient in first part of band
+! ABSO3B  : REAL     O3 absorption coefficient in second part of band
+! LAYREFFR: INTEGER  reference level for the transition
+! KAC     : REAL     Reduced g-point array for KA
+!SFLUXREFC: REAL     Reduced g-point array for SFLUXREF
+! RAYLC   : REAL     Reduced g-point array for RAYL
+! ABSO3AC : REAL     Reduced g-point array for ABSO3A
+! ABSO3BC : REAL     Reduced g-point array for ABSO3B
+!     -----------------------------------------------------------------
+END MODULE YOESRTA25
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoesrta26.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoesrta26.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoesrta26.F90	(revision 3908)
@@ -0,0 +1,36 @@
+MODULE YOESRTA26
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOESRTA26* - SRTM COEFFICIENTS FOR INTERVAL 26
+!     BAND 26: 22650-29000 cm-1 (low - nothing; high - nothing)
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: JPG = 16, NG26 = 16
+
+REAL(KIND=JPRB) :: SFLUXREF(JPG), RAYL(JPG)
+
+REAL(KIND=JPRB) :: SFLUXREFC(NG26), RAYLC(NG26)
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM SW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      02/10/29
+!     M. J. IACONO          AER             12/09/03
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! SFLUXREF: REAL     Incident solar radiation in the spectral interval
+! RAYL    : REAL     Rayleigh scattering parameter
+!SFLUXREFC: REAL     Reduced g-point array for SFLUXREF
+! RAYLC   : REAL     Reduced g-point array for RAYL
+!     -----------------------------------------------------------------
+END MODULE YOESRTA26
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoesrta27.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoesrta27.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoesrta27.F90	(revision 3908)
@@ -0,0 +1,54 @@
+MODULE YOESRTA27
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB,JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOESRTA27* - SRTM COEFFICIENTS FOR INTERVAL 27
+!     BAND 27: 29000-38000 cm-1 (low - O3; high - O3)
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: JPG = 16, NG27 = 16
+
+REAL(KIND=JPRB) :: KA(5,13,JPG)   
+REAL(KIND=JPRB) :: KB(5,13:59,JPG)
+REAL(KIND=JPRD) :: KA_D(5,13,JPG)   
+REAL(KIND=JPRD) :: KB_D(5,13:59,JPG)
+REAL(KIND=JPRB) :: SFLUXREF(JPG)  ,RAYL(JPG)
+REAL(KIND=JPRB) :: SCALEKUR
+INTEGER(KIND=JPIM) :: LAYREFFR
+
+REAL(KIND=JPRB) :: KAC(5,13,NG27)   ,ABSA(65,NG27)
+REAL(KIND=JPRB) :: KBC(5,13:59,NG27),ABSB(235,NG27)
+REAL(KIND=JPRB) :: SFLUXREFC(NG27)  ,RAYLC(NG27)
+
+!EQUIVALENCE (KA(1,1,1),ABSA(1,1)), (KB(1,13,1),ABSB(1,1))
+EQUIVALENCE (KAC(1,1,1),ABSA(1,1)), (KBC(1,13,1),ABSB(1,1))
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM SW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      02/10/29
+!     M. J. IACONO          AER             12/09/03
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! FRACREFA: REAL
+! KA      : REAL     absorption coefficient of major absorber
+! KB      : REAL     absorption coefficient of secondary absorber
+! SFLUXREF: REAL     Incident solar radiation in the spectral interval
+! RAYL    : REAL     Rayleigh scattering parameter
+! SCALEKUR: REAL     weighting factor to account for Kurucz's correction to solar spectrum 
+! LAYREFFR: INTEGER  reference level for the transition
+! KAC     : REAL     Reduced g-point array for KA
+! KBC     : REAL     Reduced g-point array for KB
+!SFLUXREFC: REAL     Reduced g-point array for SFLUXREF
+! RAYLC   : REAL     Reduced g-point array for RAYL
+!     -----------------------------------------------------------------
+END MODULE YOESRTA27
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoesrta28.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoesrta28.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoesrta28.F90	(revision 3908)
@@ -0,0 +1,53 @@
+MODULE YOESRTA28
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB,JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOESRTA28* - SRTM COEFFICIENTS FOR INTERVAL 28
+!     BAND 28: 38000-50000 cm-1 (low - O3, O2; high - O3, O2)
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: JPG = 16, NG28 = 16
+
+REAL(KIND=JPRB) :: KA(9,5,13,JPG)   
+REAL(KIND=JPRB) :: KB(5,5,13:59,JPG)
+REAL(KIND=JPRD) :: KA_D(9,5,13,JPG)   
+REAL(KIND=JPRD) :: KB_D(5,5,13:59,JPG)
+REAL(KIND=JPRB) :: SFLUXREF(JPG,5)
+REAL(KIND=JPRB) :: RAYL              ,STRRAT
+INTEGER(KIND=JPIM) :: LAYREFFR
+
+REAL(KIND=JPRB) :: KAC(9,5,13,NG28)   ,ABSA(585,NG28)
+REAL(KIND=JPRB) :: KBC(5,5,13:59,NG28),ABSB(1175,NG28)
+REAL(KIND=JPRB) :: SFLUXREFC(NG28,5)
+
+!EQUIVALENCE (KA(1,1,1,1),ABSA(1,1)), (KB(1,1,13,1),ABSB(1,1))
+EQUIVALENCE (KAC(1,1,1,1),ABSA(1,1)), (KBC(1,1,13,1),ABSB(1,1))
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM SW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      02/10/29
+!     M. J. IACONO          AER             12/09/03
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! KA      : REAL     absorption coefficient of major absorber
+! KB      : REAL     absorption coefficient of secondary absorber
+! SFLUXREF: REAL     Incident solar radiation in the spectral interval
+! RAYL    : REAL     Rayleigh scattering parameter
+! STRRAT  : REAL     weighting factor for the transition between tropospheric 
+!                    and stratospheric computations
+! LAYREFFR: INTEGER  reference level for the transition
+! KAC     : REAL     Reduced g-point array for KA
+! KBC     : REAL     Reduced g-point array for KB
+!SFLUXREFC: REAL     Reduced g-point array for SFLUXREF
+!     -----------------------------------------------------------------
+END MODULE YOESRTA28
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoesrta29.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoesrta29.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoesrta29.F90	(revision 3908)
@@ -0,0 +1,61 @@
+MODULE YOESRTA29
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB,JPRD
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     -----------------------------------------------------------------
+!*    ** *YOESRTA29* - SRTM COEFFICIENTS FOR INTERVAL 29
+!     BAND 29:  820-2600 cm-1 (low - H2O; high - CO2)
+!     -----------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: JPG = 16, NG29 = 16
+
+REAL(KIND=JPRB) :: KA(5,13,JPG)   
+REAL(KIND=JPRB) :: KB(5,13:59,JPG)
+REAL(KIND=JPRD) :: KA_D(5,13,JPG)   
+REAL(KIND=JPRD) :: KB_D(5,13:59,JPG)
+REAL(KIND=JPRB) :: SELFREF(10,JPG),FORREF(4,JPG)
+REAL(KIND=JPRB) :: SFLUXREF(JPG)  ,ABSH2O(JPG)  , ABSCO2(JPG)
+REAL(KIND=JPRB) :: RAYL
+INTEGER(KIND=JPIM) :: LAYREFFR
+
+REAL(KIND=JPRB) :: KAC(5,13,NG29)   ,ABSA(65,NG29)
+REAL(KIND=JPRB) :: KBC(5,13:59,NG29),ABSB(235,NG29)
+REAL(KIND=JPRB) :: SELFREFC(10,NG29),FORREFC(4,NG29)
+REAL(KIND=JPRB) :: SFLUXREFC(NG29)  ,ABSH2OC(NG29)  , ABSCO2C(NG29)
+
+!EQUIVALENCE (KA(1,1,1),ABSA(1,1)), (KB(1,13,1),ABSB(1,1))
+EQUIVALENCE (KAC(1,1,1),ABSA(1,1)), (KBC(1,13,1),ABSB(1,1))
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM SW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      02/10/29
+!     M. J. IACONO          AER             12/09/03
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----   : ---------------------------------------------------
+! KA      : REAL     absorption coefficient of major absorber
+! KB      : REAL     absorption coefficient of secondary absorber
+! SELFREF : REAL     self brodening coefficient for water vapour
+! FORREF  : REAL     foreign broadening coefficient for water vapour
+! SFLUXREF: REAL     Incident solar radiation in the spectral interval
+! ABSH2O  : REAL     line absorption coefficient for H2O
+! ABSCO2  : REAL     line absorption coefficient for CO2
+! RAYL    : REAL     Rayleigh scattering parameter
+! LAYREFFR: INTEGER  reference level for the transition
+! KAC     : REAL     Reduced g-point array for KA
+! KBC     : REAL     Reduced g-point array for KB
+! SELFREFC: REAL     Reduced g-point array for SELFREF
+! FORREFC : REAL     Reduced g-point array for FORREF
+!SFLUXREFC: REAL     Reduced g-point array for SFLUXREF
+! ABSH2OC : REAL     Reduced g-point array for ABSH2O
+! ABSCO2C : REAL     Reduced g-point array for ABSCO2
+!     -----------------------------------------------------------------
+END MODULE YOESRTA29
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoesrtab.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoesrtab.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoesrtab.F90	(revision 3908)
@@ -0,0 +1,28 @@
+MODULE YOESRTAB
+
+USE PARKIND1  ,ONLY : JPRB
+
+IMPLICIT NONE
+
+SAVE
+
+!    -------------------------------------------------------------------
+
+REAL(KIND=JPRB) , DIMENSION(0:10000) :: TRANS
+REAL(KIND=JPRB) :: BPADE, RODLOW, RTBLINT
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM SW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      20080724
+!     adapted from M.J. IACONO, AER Inc, 200708
+
+!  NAME     TYPE     PURPOSE
+!  ----  :  ----   : ---------------------------------------------------
+! TRANS  :  REAL   : TABULATED REFERENCE FOR SW TRANSMISSION
+! BPADE  :  REAL   : INVERSE OF PADE APPROXIMATION CONSTANT  (= 1./0.278)
+! RODLOW :  REAL   : VALUE OF TAU BELOW WHICH EXPANSION IS USED IN LIEU OF
+!                    LOOK-UP TABLE
+! RTBLINT:  REAL   : LOOK-UP TABLE CONVERSION FACTOR   
+!     -----------------------------------------------------------------
+END MODULE YOESRTAB
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoesrtaer.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoesrtaer.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoesrtaer.F90	(revision 3908)
@@ -0,0 +1,35 @@
+MODULE YOESRTAER
+
+USE PARKIND1  ,ONLY : JPRB
+
+IMPLICIT NONE
+
+SAVE
+
+!     ------------------------------------------------------------------
+!*    ** *YOESRTAER* - AEROSOL OPTICAL PROPERTIES FOR SRTM 
+!     ------------------------------------------------------------------
+
+!-- AEROSOL OPTICAL PROPERTIES
+
+!-- coefficients and parameters related to SRTM_SW 16 sp.int.
+
+REAL(KIND=JPRB) :: RSRTAUA(14,6)
+REAL(KIND=JPRB) :: RSRPIZA(14,6)
+REAL(KIND=JPRB) :: RSRASYA(14,6)
+
+!     -----------------------------------------------------------------
+
+!        * E.C.M.W.F. PHYSICS PACKAGE *
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      03/03/07
+
+!  NAME     TYPE     PURPOSE
+!  ----  :  ----   : -------
+!RSRTAUA :  REAL     S.W. NORMALIZED OPTICAL THICKNESS AT 0.55 MICRON
+!RSRPIZA :  REAL     S.W. SINGLE SCATTERING ALBEDO
+!RSRASYA :  REAL     S.W. ASSYMETRY FACTOR
+
+!     -----------------------------------------------------------------
+END MODULE YOESRTAER
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoesrtm.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoesrtm.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoesrtm.F90	(revision 3908)
@@ -0,0 +1,63 @@
+MODULE YOESRTM
+
+USE PARKIND1  ,ONLY : JPIM
+USE PARSRTM   ,ONLY : JPGMAX
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     ------------------------------------------------------------------
+!     Parameters relevant to AER's RRTM-SW radiation scheme: Part 2
+
+!     20110610 JJMorcrette
+
+!     Modified to allow possibilities of different g-point numbers.  
+!     ------------------------------------------------------------------
+
+!INTEGER(KIND=JPIM) :: JPGPT
+!INTEGER(KIND=JPIM) :: JPGSW
+
+!INTEGER(KIND=JPIM) :: NG16
+!INTEGER(KIND=JPIM) :: NG17
+!INTEGER(KIND=JPIM) :: NG18
+!INTEGER(KIND=JPIM) :: NG19
+!INTEGER(KIND=JPIM) :: NG20
+!INTEGER(KIND=JPIM) :: NG21
+!INTEGER(KIND=JPIM) :: NG22
+!INTEGER(KIND=JPIM) :: NG23
+!INTEGER(KIND=JPIM) :: NG24
+!INTEGER(KIND=JPIM) :: NG25
+!INTEGER(KIND=JPIM) :: NG26
+!INTEGER(KIND=JPIM) :: NG27
+!INTEGER(KIND=JPIM) :: NG28
+!INTEGER(KIND=JPIM) :: NG29
+
+!-- NGnn : number of g-points in bands nn=16 to 29
+!- as used for the (operational) 112 g-points version of RRTM_SW
+INTEGER(KIND=JPIM), PARAMETER :: JPGPT  = 112
+INTEGER(KIND=JPIM), PARAMETER :: JPGSW  = 112
+
+INTEGER(KIND=JPIM), PARAMETER :: NG16 = 6
+INTEGER(KIND=JPIM), PARAMETER :: NG17 = 12
+INTEGER(KIND=JPIM), PARAMETER :: NG18 = 8
+INTEGER(KIND=JPIM), PARAMETER :: NG19 = 8
+INTEGER(KIND=JPIM), PARAMETER :: NG20 = 10
+INTEGER(KIND=JPIM), PARAMETER :: NG21 = 10
+INTEGER(KIND=JPIM), PARAMETER :: NG22 = 2
+INTEGER(KIND=JPIM), PARAMETER :: NG23 = 10
+INTEGER(KIND=JPIM), PARAMETER :: NG24 = 8
+INTEGER(KIND=JPIM), PARAMETER :: NG25 = 6
+INTEGER(KIND=JPIM), PARAMETER :: NG26 = 6
+INTEGER(KIND=JPIM), PARAMETER :: NG27 = 8
+INTEGER(KIND=JPIM), PARAMETER :: NG28 = 6
+INTEGER(KIND=JPIM), PARAMETER :: NG29 = 12
+
+
+INTEGER(KIND=JPIM) :: NGN(JPGMAX), NGBSW(JPGMAX)
+
+!     ------------------------------------------------------------------
+END MODULE YOESRTM
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoesrtwn.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoesrtwn.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoesrtwn.F90	(revision 3908)
@@ -0,0 +1,68 @@
+MODULE YOESRTWN
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!    -------------------------------------------------------------------
+
+INTEGER(KIND=JPIM) , DIMENSION(16:29) :: NG
+INTEGER(KIND=JPIM) , DIMENSION(16:29) :: NSPA
+INTEGER(KIND=JPIM) , DIMENSION(16:29) :: NSPB
+INTEGER(KIND=JPIM) , DIMENSION(14)    :: NMPSRTM
+
+REAL(KIND=JPRB), DIMENSION(59) :: PREF
+REAL(KIND=JPRB), DIMENSION(59) :: PREFLOG
+REAL(KIND=JPRB), DIMENSION(59) :: TREF
+
+INTEGER(KIND=JPIM), DIMENSION(224) :: NGM
+INTEGER(KIND=JPIM), DIMENSION(14)  :: NGC, NGS
+
+REAL(KIND=JPRB), DIMENSION(16)  :: WT, WTSM
+REAL(KIND=JPRB), DIMENSION(224) :: RWGT
+
+
+! Use for 56 g-points
+!INTEGER(KIND=JPIM), DIMENSION(56) :: NGBSW, NGN
+! Use for 112 g-points
+!INTEGER(KIND=JPIM), DIMENSION(112) :: NGBSW, NGN
+! Use for 224 g-points
+!INTEGER(KIND=JPIM), DIMENSION(224) :: NGBSW, NGN
+
+!     -----------------------------------------------------------------
+!        * E.C.M.W.F. PHYSICS PACKAGE ** RRTM SW RADIATION **
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      03-03-07
+!     M. J. IACONO          AER             12/09/03
+
+!  NAME     TYPE     PURPOSE
+!  ----   : ----    : -------
+!  NG     : INTEGER : Number of k-coefficients in spectral intervals
+!  NSPA   : INTEGER :
+!  NSPB   : INTEGER :
+! NMPSRTM : INTEGER : MAPPING INDICES FOR 6-SPECTRAL INT. SURFACE ALBEDO 
+! WAVENUM1: REAL    : Lower wavenumber spectral limit
+! WAVENUM2: REAL    : Higher wavenumber spectral limit
+! DELWAVE : REAL    : Spectral interval width
+! PREF    : REAL    : Reference pressure
+! PREFLOG : REAL    : Log reference pressure
+! TREF    : REAL    : Reference temperature
+!  NGC    : INTEGER : The number of new g-points in each band
+!  NGS    : INTEGER : The cumulative sum of new g-points for each band
+!  NGM    : INTEGER : The index of each new g-point relative to the
+!                     original 16 g-points for each band.
+!
+!  WT     : REAL    : RRTM weights for 16 g-points.
+!  WTSUM  : REAL    : Sum of the weights
+!  RWGT   : REAL    :
+! 
+!  NGN    : INTEGER : The number of original g-points that are combined 
+!                     to make each new g-point in each band.
+!  NGBSW  : INTEGER : The band index for each new g-point.
+!     -----------------------------------------------------------------
+END MODULE YOESRTWN
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/yoesw.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yoesw.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yoesw.F90	(revision 3908)
@@ -0,0 +1,213 @@
+MODULE YOESW
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+
+IMPLICIT NONE
+
+SAVE
+
+!     ------------------------------------------------------------------
+!*    ** *YOESW* - COEFFICIENTS FOR SHORTWAVE RADIATION TRANSFER
+!     ------------------------------------------------------------------
+
+REAL(KIND=JPRB) :: APAD(6,3,7)
+REAL(KIND=JPRB) :: BPAD(6,3,7)
+REAL(KIND=JPRB) :: RRAY(6,6)
+REAL(KIND=JPRB), ALLOCATABLE :: RSUN(:)
+REAL(KIND=JPRB) :: RPDH1
+REAL(KIND=JPRB) :: RPDU1
+REAL(KIND=JPRB) :: RPNH
+REAL(KIND=JPRB) :: RPNU
+REAL(KIND=JPRB) :: RSWCE(6)
+REAL(KIND=JPRB) :: RSWCP(6)
+REAL(KIND=JPRB) :: RTDH2O
+REAL(KIND=JPRB) :: RTDUMG
+REAL(KIND=JPRB) :: RTH2O
+REAL(KIND=JPRB) :: RTUMG
+REAL(KIND=JPRB) :: D(6,3)
+REAL(KIND=JPRB) :: REXPO3(6,2,7)
+INTEGER(KIND=JPIM) :: NEXPO3(6)
+
+REAL(KIND=JPRB) :: RYFWCA(6)
+REAL(KIND=JPRB) :: RYFWCB(6)
+REAL(KIND=JPRB) :: RYFWCC(6)
+REAL(KIND=JPRB) :: RYFWCD(6)
+REAL(KIND=JPRB) :: RYFWCE(6)
+REAL(KIND=JPRB) :: RYFWCF(6)
+
+REAL(KIND=JPRB) :: REBCUA(6)
+REAL(KIND=JPRB) :: REBCUB(6)
+REAL(KIND=JPRB) :: REBCUC(6)
+REAL(KIND=JPRB) :: REBCUD(6)
+REAL(KIND=JPRB) :: REBCUE(6)
+REAL(KIND=JPRB) :: REBCUF(6)
+REAL(KIND=JPRB) :: REBCUG(16)
+REAL(KIND=JPRB) :: REBCUH(16)
+REAL(KIND=JPRB) :: REBCUI(6)
+REAL(KIND=JPRB) :: REBCUJ(6)
+
+REAL(KIND=JPRB) :: RASWCA(6)
+REAL(KIND=JPRB) :: RASWCB(6)
+REAL(KIND=JPRB) :: RASWCC(6)
+REAL(KIND=JPRB) :: RASWCD(6)
+REAL(KIND=JPRB) :: RASWCE(6)
+REAL(KIND=JPRB) :: RASWCF(6)
+
+REAL(KIND=JPRB) :: RFUETA(16,3),RFUETB(16,4), RFUETC(16,4)
+REAL(KIND=JPRB) :: RFULIO(16,3)
+REAL(KIND=JPRB) :: RHSAVI(16,3)
+REAL(KIND=JPRB) :: RLILIA(16,5),RLILIB(16,4)
+
+REAL(KIND=JPRB) :: RFLAA0(6)
+REAL(KIND=JPRB) :: RFLAA1(6)
+REAL(KIND=JPRB) :: RFLBB0(6)
+REAL(KIND=JPRB) :: RFLBB1(6)
+REAL(KIND=JPRB) :: RFLBB2(6)
+REAL(KIND=JPRB) :: RFLBB3(6)
+REAL(KIND=JPRB) :: RFLCC0(6)
+REAL(KIND=JPRB) :: RFLCC1(6)
+REAL(KIND=JPRB) :: RFLCC2(6)
+REAL(KIND=JPRB) :: RFLCC3(6)
+
+REAL(KIND=JPRB) :: RFUAA0(6)
+REAL(KIND=JPRB) :: RFUAA1(6)
+REAL(KIND=JPRB) :: RFUBB0(6)
+REAL(KIND=JPRB) :: RFUBB1(6)
+REAL(KIND=JPRB) :: RFUBB2(6)
+REAL(KIND=JPRB) :: RFUBB3(6)
+REAL(KIND=JPRB) :: RFUCC0(6)
+REAL(KIND=JPRB) :: RFUCC1(6)
+REAL(KIND=JPRB) :: RFUCC2(6)
+REAL(KIND=JPRB) :: RFUCC3(6)
+REAL(KIND=JPRB) :: RFLDD0(6)
+REAL(KIND=JPRB) :: RFLDD1(6)
+REAL(KIND=JPRB) :: RFLDD2(6)
+REAL(KIND=JPRB) :: RFLDD3(6)
+
+REAL(KIND=JPRB) :: REFFIA
+
+REAL(KIND=JPRB) :: RTAUA(6,6)
+REAL(KIND=JPRB) :: RPIZA(6,6)
+REAL(KIND=JPRB) :: RCGA(6,6)
+REAL(KIND=JPRB) :: RAER(6,6)
+
+INTEGER(KIND=JPIM) :: NMPSRTM(14), NTYPS
+
+REAL(KIND=JPRB) :: RADJUST
+
+!        * E.C.M.W.F. PHYSICS PACKAGE *
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      89/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----  :  ----   : ---------------------------------------------------
+!  APAD  :  REAL     PADE APPROXIMANTS NUMERATOR
+!  BPAD  :  REAL     PADE APPROXIMANTS DENOMINATOR
+!  D     :  REAL     TRANSMISSION LIMIT FOR INFINITE ABSORBER AMOUNT
+!  RRAY  :  REAL     RAYLEIGH SCATTERING COEFFICIENTS
+!  RSUN  :  REAL     SOLAR FRACTION IN SPECTRAL INTERVALS
+!  RPDH1 :  1 + EXPONENT PRESSURE DEPENDENCE H2O
+!  RPDU1 :  1 + EXPONENT PRESSURE DEPENDENCE UNIFORMLY MIXED GASES
+!  RPNH  :  REFERENCE PRESSURE FACTOR FOR H2O
+!  RPNU  :  REFERENCE PRESSURE FACTOR FOR UNIFORMLY MIXED GASES
+!  RSWCE :  E-TYPE, H2O CONTINUUM ABSORPTION COEFFICIENT 
+!  RSWCP :  P-TYPE, H2O CONTINUUM ABSORPTION COEFFICIENT 
+!  RTDH2O:  EXPONENT TEMPERATURE DEPENDENCE H2O
+!  RTDUMG:  EXPONENT TEMPERATURE DEPENDENCE UNIFORMLY MIXED GASES
+!  RTH2O :  REFERENCE TEMPERATURE H2O
+!  RTUMG :  REFERENCE TEMPERATURE UNIFORMLY MIXED GASES
+!     -----------------------------------------------------------------
+
+!        * E.C.M.W.F. PHYSICS PACKAGE *
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      89/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----  :  ----   : ---------------------------------------------------
+!*    FOUQUART (1987) WATER CLOUD OPTICAL PROPERTIES
+
+! RYFWCA :  REAL   : C1 IN OPTICAL THICKNESS FORMULA
+! RYFWCB :  REAL   : C2 IN OPTICAL THICKNESS FORMULA
+! RYFWCC :  REAL   : SINGLE SCATTERING ALBEDO PARAMETER
+! RYFWCD :  REAL   : SINGLE SCATTERING ALBEDO PARAMETER
+! RYFWCE :  REAL   : SINGLE SCATTERING ALBEDO PARAMETER
+! RYFWCF :  REAL   : ASSYMETRY FACTOR
+
+!*    SLINGO (1989) WATER CLOUD OPTICAL PROPERTIES
+
+! RASWCA :  REAL   : C1 IN OPTICAL THICKNESS FORMULA
+! RASWCB :  REAL   : C2 IN OPTICAL THICKNESS FORMULA
+! RASWCC :  REAL   : SINGLE SCATTERING ALBEDO PARAMETER
+! RASWCD :  REAL   : SINGLE SCATTERING ALBEDO PARAMETER
+! RASWCE :  REAL   : SINGLE SCATTERING ALBEDO PARAMETER
+! RASWCF :  REAL   : ASSYMETRY FACTOR
+
+!*   LINDNER,LI (2000) WATER CLOUD OPTICAL PROPERTIES (RRTM)
+
+! RLILIA : REAL    : MASS ABSORPTION COEFFICIENTS (POLYNOMIAL DEVELOPM)
+! RLILIB : REAL    : 1-SSA COEFFICIENTS  (POLYNOMIAL DEVELOPM)
+
+!*    ICE CLOUD OPTICAL PROPERTIES DERIVED FROM EBERT-CURRY (1992)
+
+! REBCUA :  REAL   : C1 IN OPTICAL THICKNESS FORMULA
+! REBCUB :  REAL   : C2 IN OPTICAL THICKNESS FORMULA
+! REBCUC :  REAL   : 1-C3  IN SINGLE SCATTERING ALBEDO FORMULA
+! REBCUD :  REAL   : C4 IN SINGLE SCATTERING ALBEDO FORMULA
+! REBCUE :  REAL   : C5 IN ASSYMETRY FACTOR FORMULA
+! REBCUF :  REAL   : C6 IN ASSYMETRY FACTOR FORMULA
+! REBCUG :  REAL   : C7 IN MASS ABSORPTION COEFFICIENT FORMULA
+! REBCUH :  REAL   : C8 IN MASS ABSORPTION COEFFICIENT FORMULA
+! REBCUI :  REAL   : C7 IN MASS ABSORPTION COEFFICIENT SPECTRAL FORMULA
+! REBCUJ :  REAL   : C8 IN MASS ABSORPTION COEFFICIENT SPECTRAL FORMULA
+
+!*    ICE CLOUD OPTICAL PROPERTIES DERIVED FROM SUN-SHINE (1995)
+
+! RSHSUE :  REAL   : E IN SINGLE SCATTERING ALBEDO FORMULA
+! RSHSUF :  REAL   : F IN SINGLE SCATTERING ALBEDO FORMULA
+! RSHSUH :  REAL   : H IN ASSYMETRY FACTOR FORMULA
+! RSHSUK :  REAL   : K IN ASSYMETRY FACTOR FORMULA
+! RSHSUA :  REAL   : ALPHA IN SSA CORRECTION FACTOR FORMULA
+! RSHSUG :  REAL   : GAMMA IN ASSYMETRY CORRECTION FACTOR FORMULA
+! RSHSUFA:  REAL   : COEFFICIENTS IN TEMPERATURE CORRECTION FACTOR
+
+! REFFIA :  REAL   : C9  IN EFFECTIVE RADIUS FORMULA
+
+!*    ICE CLOUD OPTICAL PROPERTIES DERIVED FROM FU-LIOU (1993)
+
+! RFULIO :  REAL   : COEFFICIENTS IN EXPRESSION FOR LW EXTINCTION COEFF.
+! RFLAA  :  REAL   : COEFFICIENTS IN EXPRESSION FOR SW EXTINCTION COEFF.
+! RFLBB  :  REAL   : COEFFICIENTS IN EXPRESSION FOR SW SINGLE SCATT.ALB.
+! RFLCC  :  REAL   : COEFFICIENTS IN EXPRESSION FOR SW ASSYMETRY FACTOR
+! RFLDD  :  REAL   : COEFFICIENTS IN EXPRESSION FOR SW ASSYMETRY FACTOR
+
+!*    ICE CLOUD OPTICAL PROPERTIES DERIVED FROM FU (1996) & FU ET AL. (1998)
+
+! RFUETA :  REAL   : COEFFICIENTS IN EXPRESSION FOR LW EXTINCTION COEFF.
+! RFUAA  :  REAL   : COEFFICIENTS IN EXPRESSION FOR SW EXTINCTION COEFF.
+! RFUBB  :  REAL   : COEFFICIENTS IN EXPRESSION FOR SW SINGLE SCATT.ALB.
+! RFUCC  :  REAL   : COEFFICIENTS IN EXPRESSION FOR SW ASSYMETRY FACTOR
+
+!     -----------------------------------------------------------------
+
+!        * E.C.M.W.F. PHYSICS PACKAGE *
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      89/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----  :  ----   : -------
+!  RTAUA :  REAL     S.W. NORMALIZED OPTICAL THICKNESS AT 0.55 MICRON
+!  RPIZA :  REAL     S.W. SINGLE SCATTERING ALBEDO
+!  RCGA  :  REAL     S.W. ASSYMETRY FACTOR
+!  RAER  :  REAL     L.W. ABSORPTION COEFFICIENTS
+!     -----------------------------------------------------------------
+
+!        * E.C.M.W.F. PHYSICS PACKAGE *
+
+!     J.-J. MORCRETTE       E.C.M.W.F.      89/07/14
+
+!  NAME     TYPE     PURPOSE
+!  ----  :  ----   : -------
+!RTWEIGHT:  REAL     S.W. INTEGRATED WEIGHT 
+! NMPSRTM: INTEGER  : Indices for mapping SW[1:6] albedo into SRTM[1:14]  
+!     -----------------------------------------------------------------
+END MODULE YOESW
Index: LMDZ6/trunk/libf/phylmd/ecrad/yom_ygfl.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yom_ygfl.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yom_ygfl.F90	(revision 3908)
@@ -0,0 +1,431 @@
+MODULE YOM_YGFL
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+
+IMPLICIT NONE
+SAVE
+
+!-------------------------------------------------------------------------
+! Contains the descriptors of GFL arrays
+!-------------------------------------------------------------------------
+
+! JPGFL : Max number of GFL fields
+! JPNAMED_GFL : Number of currently pre-defined components of GFL
+! JPGHG : Number of greenhouse gas fields
+! JPGRG : Number of reactive gas fields
+! JPCHEM : Number of chemical species
+! JPAERO : Number of active aerosol fields
+! JPAEROUT: Number of output aerosol fields
+! JPUVP : Number of output from UV processor
+! JPTRAC : Number of tracers for diagnostics
+! JPERA40 : Number of ERA40 diagnostic fields
+! JPCH4S  : Number of added fields related to methane
+! JPNOGW  : Number of diagnostic fields for NORO GWD SCHEME
+! JPSLDIA : Number of SL dynamics diagnostic fields
+! JPCHEM_ASSIM : Maximum number of assimilated of chemical species
+!-------------------------------------------------------------------------
+
+INTEGER(KIND=JPIM), PARAMETER :: JPGFL=2163
+INTEGER(KIND=JPIM), PARAMETER :: JPNAMED_GFL=27
+INTEGER(KIND=JPIM), PARAMETER :: JPGHG=3
+INTEGER(KIND=JPIM), PARAMETER :: JPTRAC=10
+INTEGER(KIND=JPIM), PARAMETER :: JPCHEM=66
+INTEGER(KIND=JPIM), PARAMETER :: JPGRG=5       
+INTEGER(KIND=JPIM), PARAMETER :: JPCHEM_ASSIM=5
+INTEGER(KIND=JPIM), PARAMETER :: JPAERO=16
+INTEGER(KIND=JPIM), PARAMETER :: JPFORC=1800
+INTEGER(KIND=JPIM), PARAMETER :: JPERA40=14
+INTEGER(KIND=JPIM), PARAMETER :: JPSLDIA=7
+INTEGER(KIND=JPIM), PARAMETER :: JPEZDIAG=50
+INTEGER(KIND=JPIM), PARAMETER :: JPCH4S=2
+INTEGER(KIND=JPIM), PARAMETER :: JPNOGW=2
+INTEGER(KIND=JPIM), PARAMETER :: JPAEROUT=17
+INTEGER(KIND=JPIM), PARAMETER :: JPUVP=2
+INTEGER(KIND=JPIM), PARAMETER :: JPPHYS=8   
+INTEGER(KIND=JPIM), PARAMETER :: GRIB_CODE_GFL_PHYS=81  ! AJGDB hopefully harmless
+
+TYPE TYPE_GFL_COMP ! Individual field descriptor
+
+SEQUENCE ! daand: necessary to avoid memory corruption with gfortran 4.3.3
+
+CHARACTER(LEN=16)  :: CNAME     = ''        ! ARPEGE field name 
+INTEGER(KIND=JPIM) :: IGRBCODE  = -999      ! GRIB code
+LOGICAL            :: LADV      = .FALSE.   ! Field advected or not
+LOGICAL            :: LADV5     = .FALSE.   ! Field advected without wind increments
+LOGICAL            :: LTDIABLIN = .FALSE.   ! Diabatic tendency is interpolated by lin. int.
+LOGICAL            :: LHORTURB  = .FALSE.   ! Horizontal part affected by 3D turbulence
+INTEGER(KIND=JPIM) :: NREQIN    = 0         ! 1 if field requiered in input, 0 if not, -1 if initialised
+                                            ! with a reference value REFVALI
+LOGICAL            :: LREQOUT   = .FALSE.   ! T if field requiered in output
+LOGICAL            :: LGPINGP   = .TRUE.    ! GP field input as GP
+LOGICAL            :: LGP       = .FALSE.   ! Field exists and of grid-point type
+LOGICAL            :: LSP       = .FALSE.   ! Field exists and of spectral type
+LOGICAL            :: LCDERS    = .FALSE.   ! Derivatives required (spectral only)
+LOGICAL            :: LACTIVE   = .FALSE.   ! Field in use
+LOGICAL            :: LTHERMACT = .FALSE.   ! Field thermodynamically active
+REAL(KIND=JPRB)    :: R         = 0.0_JPRB
+REAL(KIND=JPRB)    :: RCP       = 0.0_JPRB
+LOGICAL            :: LT9       = .FALSE.   ! Field in t-dt GFL
+LOGICAL            :: LT1       = .FALSE.   ! Field in t+dt GFL
+LOGICAL            :: LT5       = .FALSE.   ! Field in trajectory GFL
+LOGICAL            :: LPHY      = .FALSE.   ! Field in physics GFL
+LOGICAL            :: LPT       = .FALSE.   ! Field in PC phy. tend. GFL (GFLPT)
+LOGICAL            :: LTRAJIO   = .FALSE.   ! Field written to and from trajectory structure
+LOGICAL            :: LDIAG     = .FALSE.   ! Field is "diagnostic" at t; e.g. cloud fraction 
+LOGICAL            :: LPC       = .FALSE.   ! Field in predictor/corrector time stepping (GFLPC)
+REAL(KIND=JPRB)    :: REFVALI   = 0.0_JPRB  ! Reference value for init, used in case NREQIN==-1
+! LAM specific attributes (Arome/Aladin)
+LOGICAL            :: LADJUST0  = .FALSE.   ! True if field is thermodynamically adjusted at t
+                                            ! (immediatly after inverse spectral transforms)
+LOGICAL            :: LADJUST1  = .FALSE.   ! True if field is thermodynamically adjusted at t+dt
+                                            ! (after SL interpolations and NL residuals)
+INTEGER(KIND=JPIM) :: NCOUPLING = 0         ! 1 if field is coupled by Davies relaxation, 0 if not,
+                                            ! -1 if coupled with reference value for coupling REFVALC
+REAL(KIND=JPRB)    :: REFVALC   = 0.0_JPRB  ! Reference value for coupling, used in case NCOUPLING==-1
+LOGICAL            :: LBIPER    = .FALSE.   ! True if field must be biperiodised inside the transforms
+! End LAM specific attributes (Arome/Aladin)
+CHARACTER(LEN=12)  :: CSLINT    = ''        ! S.L interpolaion "type"
+INTEGER(KIND=JPIM) :: MP        = -99999999 ! Basic field "pointer"
+INTEGER(KIND=JPIM) :: MPL       = -99999999 ! zonal derivative "pointer"
+INTEGER(KIND=JPIM) :: MPM       = -99999999 ! Meridional derivative "pointer"
+INTEGER(KIND=JPIM) :: MP9       = -99999999 ! Basic field "pointer" t-dt
+INTEGER(KIND=JPIM) :: MP9_PH    = -99999999 ! Basic field "pointer" for Physics
+INTEGER(KIND=JPIM) :: MP1       = -99999999 ! Basic field "pointer" t+dt
+INTEGER(KIND=JPIM) :: MP5       = -99999999 ! Basic field "pointer" trajectory
+INTEGER(KIND=JPIM) :: MP5L      = -99999999 ! zonal derivative "pointer" trajectory
+INTEGER(KIND=JPIM) :: MP5M      = -99999999 ! Meridional derivative "pointer" trajectory
+INTEGER(KIND=JPIM) :: MPSLP     = -99999999 ! Basic field "pointer" physics
+INTEGER(KIND=JPIM) :: MPSP      = -99999999 ! Basic field "pointer" spectral space
+INTEGER(KIND=JPIM) :: MP_SPL    = -99999999 ! Basic field "pointer" spline interpolation
+INTEGER(KIND=JPIM) :: MP_SL1    = -99999999 ! Basic field "pointer" in SLBUF1
+INTEGER(KIND=JPIM) :: MP_SLX    = -99999999 ! Basic field "pointer" in SLBUF1 for CPG_PT
+INTEGER(KIND=JPIM) :: MPPT      = -99999999 ! Physics tendency "pointer"
+INTEGER(KIND=JPIM) :: MPPC      = -99999999 ! Predictor/corrector auxiliary array "pointer"
+
+! daand: INTFLEX attributes
+LOGICAL            :: LWATER                ! TRUE for water species
+LOGICAL            :: LPRECIP               ! TRUE for precipitating water species
+REAL(KIND=JPRB)    :: RLZER                 ! Latent heat change at 0K
+
+! gems nl ext
+INTEGER(KIND=JPIM) :: NCOUPLO4              ! Coupled to CTM by OASIS4 intefrace
+LOGICAL            :: LASSIM                ! use as Control Variable (either monitored or assimilated)
+INTEGER(KIND=JPIM) :: IGRIBDV               ! GRIB code of deposition velocity 
+INTEGER(KIND=JPIM) :: IGRIBTC               ! GRIB code of Total Column
+INTEGER(KIND=JPIM) :: IGRIBSFC              ! GRIB code of Surface Flux 
+LOGICAL            :: LDIFF                 ! Diffusion  on
+LOGICAL            :: LCONV                 ! Convection on
+REAL(KIND=JPRB)    :: RMOLMASS              ! Molar Mass 
+REAL(KIND=JPRB)    :: REFOLD                ! Efolding decay time 
+REAL(KIND=JPRB)    :: HENRYA                ! Henry constant a 
+REAL(KIND=JPRB)    :: HENRYB                ! Henry constant b 
+LOGICAL            :: LNEGFIX               ! Cut off negative values in sugridug an
+LOGICAL            :: LMASSFIX              ! Correct mass error of sl advection in gpmodel (if LTRCMFIX)
+TYPE(TYPE_GFL_COMP),POINTER :: PREVIOUS     ! Pointer to previously def. field
+
+END TYPE TYPE_GFL_COMP
+
+TYPE TYPE_GFL_NAML ! Individual field descriptor for namelist input
+
+SEQUENCE ! daand: necessary to avoid memory corruption with gfortran 4.3.3
+
+CHARACTER(LEN=16)  :: CNAME     ! ARPEGE field name 
+INTEGER(KIND=JPIM) :: IGRBCODE  ! GRIB code
+INTEGER(KIND=JPIM) :: NREQIN    ! 1 if field required in input, 0 if not, -1 if initialised
+                                ! with a reference value REFVALI
+REAL(KIND=JPRB) :: REFVALI      ! Reference value for initialisation, used in case NREQIN==-1
+LOGICAL :: LREQOUT              ! T if field requiered in output
+LOGICAL :: LGPINGP              ! GP field input as GP
+LOGICAL :: LGP                  ! Field exists and of grid-point type
+LOGICAL :: LSP                  ! Field exists and of spectral type
+LOGICAL :: LCDERS               ! Derivatives required (spectral only)
+LOGICAL :: LT9                  ! Field in t-dt GFL
+LOGICAL :: LT1                  ! Field in t+dt GFL
+LOGICAL :: LT5                  ! Field in trajectory GFL
+LOGICAL :: LPHY                 ! Field with physics tendencies GFL
+LOGICAL :: LPT                  ! Field in PC physics tendency GFLPT
+LOGICAL :: LTRAJIO              ! Field written to and from trajectory structure
+LOGICAL :: LDIAG                ! Field is "diagnostic" at t; e.g. cloud fraction 
+LOGICAL :: LPC                  ! Field in predictor/corrector time stepping GFLPC
+LOGICAL :: LADV                 ! Field advected or not
+LOGICAL :: LADV5                ! Field advected without wind increments
+LOGICAL :: LINTLIN              ! Linear interpolation for field
+LOGICAL :: LTDIABLIN            ! Diabatic tendency is interpolated by linear int.
+LOGICAL :: LHORTURB             ! Horizontal part affected by 3D turbulence
+LOGICAL :: LQM                  ! quasi-monotonous interpolation for field
+LOGICAL :: LQMH                 ! quasi-monotonous interpolation in horizontal for field
+LOGICAL :: LQM3D                ! quasi-monotone interpolation applied directly in 3 dimensions
+LOGICAL :: LSLHD                ! Semi-lagrangian horizontal diffusion used for field
+LOGICAL :: LCOMAD               ! COMAD weights used for SL interpolation of field
+LOGICAL :: LHV                  ! Hermite vertical interpolation used for field (only ozone sofar)
+LOGICAL :: LVSPLIP              ! vertical spline interpolation used for field (only ozone sofar)
+INTEGER(KIND=JPIM) :: NCOUPLING ! 1 if field is coupled by Davies relaxation, 0 if not,
+                                ! -1 if coupled with reference value for coupling REFVALC
+REAL(KIND=JPRB) :: REFVALC      ! Reference value for coupling, used in case 
+                                ! NCOUPLING==-1
+! gems nl ext
+INTEGER(KIND=JPIM)  :: NCOUPLO4 ! Coupled to CTM by OASIS4 intefrace =1 input,=2 in&output,=-1 none
+LOGICAL             :: LASSIM   ! use as Control Variable (either monitored or assimilated)
+INTEGER(KIND=JPIM)  :: IGRIBDV  ! GRIB code of deposition velocity 
+INTEGER(KIND=JPIM)  :: IGRIBTC  ! GRIB code of Total Column
+INTEGER(KIND=JPIM)  :: IGRIBSFC ! GRIB code of Surface Flux 
+LOGICAL             :: LDIFF    ! Diffusion  on
+LOGICAL             :: LCONV    ! Convection on
+LOGICAL             :: LNEGFIX  ! Cut off negative values in sugridug and callpar
+LOGICAL             :: LMASSFIX ! Correct mass error of sl advection in gpmodel (if LTRCMFIX)
+REAL(KIND=JPRB)     :: RMOLMASS ! Molar Mass 
+REAL(KIND=JPRB)     :: REFOLD   ! Efolding  decay time 
+REAL(KIND=JPRB)     :: HENRYA   ! Henry constant a 
+REAL(KIND=JPRB)     :: HENRYB   ! Henry constant b 
+
+END TYPE TYPE_GFL_NAML
+
+!-------------------------------------------------------------------------
+! Derived types for describing the GFL structure.
+!-------------------------------------------------------------------------
+! Modifications:
+! 03/07/09 C. Fischer - add Arome/Aladin attributes
+! 03/10/01 C. Moussy  - add Arome/Aladin attributes coupling
+! 03/10/31 M. Tudor   - add physics tendencies for predictor-corrector
+! 05/10/10 J. Haseler - switch for I/O to trajectory structure
+! 2004-Nov F. Vana    - update of CSLINT attribute
+! 20-Feb-2005 Vivoda  - 3TL Eul PC scheme (GFLPC)
+! 07/06/27 E. Holm    - TL/AD advection without wind increments LADV5
+! 12/04/08 J. Flemming - GFL attribute extention for GEMS 
+! 22-Feb-11 F. Vana   - LTDIABLIN and LHORTURB
+! spring 2011 ECMWF   - LINTLIN
+! Nov. 2013           - LCOMAD
+! 2013-11, D. Degrauwe - INTFLEX attributes
+
+TYPE TYPE_GFLD
+
+SEQUENCE ! daand: necessary to avoid memory corruption with gfortran 4.3.3
+
+! Overall descriptor,dimensioning etc.
+INTEGER(KIND=JPIM) :: NUMFLDS     = 0  ! Number of GFL fields
+INTEGER(KIND=JPIM) :: NDERS       = 0  ! Number of horizontal derivatives fields
+INTEGER(KIND=JPIM) :: NUMSPFLDS   = 0  ! Number of spectrally represented GFL fields
+INTEGER(KIND=JPIM) :: NUMGPFLDS   = 0  ! Number of grid-point GFL fields
+INTEGER(KIND=JPIM) :: NUMFLDS9    = 0  ! Number of GFL fields in (t-dt) part
+INTEGER(KIND=JPIM) :: NUMFLDS1    = 0  ! Number of GFL fields in (t+dt) array
+INTEGER(KIND=JPIM) :: NUMSPFLDS1  = 0  ! Number of spectrally represented GFL fields (t+dt)
+INTEGER(KIND=JPIM) :: NUMFLDS5    = 0  ! Number of GFL fields (trajectory)
+INTEGER(KIND=JPIM) :: NUMFLDSPHY  = 0  ! Number of GFL fields (phys.)
+INTEGER(KIND=JPIM) :: NUMFLDS_SPL = 0  ! Number of GFL fields (S.L. spline interpolation)
+INTEGER(KIND=JPIM) :: NUMFLDS_SL1 = 0  ! Number of GFL fields in S.L. buffer 1
+INTEGER(KIND=JPIM) :: NUMFLDSPC   = 0  ! Number of GFL fields (predictor/corrector)
+INTEGER(KIND=JPIM) :: NDIM        = 0  ! Dimension of main array holding GFL fields(GFL)
+INTEGER(KIND=JPIM) :: NUMFLDSPT   = 0  ! Number of GFL fields (phy. tend.)
+INTEGER(KIND=JPIM) :: NDIM0       = 0  ! Dimension of t0 part of GFL
+INTEGER(KIND=JPIM) :: NDIM9       = 0  ! Dimension of t-dt part of GFL
+INTEGER(KIND=JPIM) :: NDIM1       = 0  ! Dimension of t+dt array (GFLT1)
+INTEGER(KIND=JPIM) :: NDIM5       = 0  ! Dimension of traj. GFL array (GFL5)
+INTEGER(KIND=JPIM) :: NDIMSLP     = 0  ! Diminsion of S.L. phys. GFL array (GFLSLP)
+INTEGER(KIND=JPIM) :: NDIM_SPL    = 0  ! Dim. of arrays holding GFL fields (S.L.spline int.)
+INTEGER(KIND=JPIM) :: NDIMPT      = 0  ! Dimension of phy. tend. GFL array (GFLPT)
+INTEGER(KIND=JPIM) :: NDIMPC      = 0  ! Dimension of iterative scheme auxiliary array (GFLPC)
+
+INTEGER(KIND=JPIM) :: NGFL_EXT
+INTEGER(KIND=JPIM) :: NGFL_FORC
+INTEGER(KIND=JPIM) :: NGFL_EZDIAG
+INTEGER(KIND=JPIM) :: NGHG
+INTEGER(KIND=JPIM) :: NTRAC
+INTEGER(KIND=JPIM) :: NGRG
+INTEGER(KIND=JPIM) :: NGRG_CPLO4
+INTEGER(KIND=JPIM) :: NGRG_ASSIM
+INTEGER(KIND=JPIM) :: NAERO
+INTEGER(KIND=JPIM) :: NACTAERO
+INTEGER(KIND=JPIM) :: NDDHAERO
+INTEGER(KIND=JPIM) :: NERA40
+INTEGER(KIND=JPIM) :: NNOGW
+INTEGER(KIND=JPIM) :: NAEROUT
+INTEGER(KIND=JPIM) :: NUVP
+INTEGER(KIND=JPIM) :: NSLDIA
+INTEGER(KIND=JPIM) :: NSLDIAGP
+INTEGER(KIND=JPIM) :: NGFL_PHYS
+LOGICAL :: LCO2SFC
+LOGICAL :: LCH4SFC
+LOGICAL :: LAEROSFC
+LOGICAL :: LFIRE
+LOGICAL :: LAERODIU
+LOGICAL :: LTRCMFIX       ! Activates tracer mass fixer
+LOGICAL :: LTRCMFIX_PS    ! Adjust pressure to conserve dry mass in mass fixer calculations
+LOGICAL :: LAEROUT
+LOGICAL :: LUVPOUT
+LOGICAL :: LCHEM
+
+INTEGER(KIND=JPIM) :: NGEMS   ! The total number of "GEMS" fields.
+INTEGER(KIND=JPIM) :: NCHEM
+INTEGER(KIND=JPIM) :: NCHEM_ASSIM
+INTEGER(KIND=JPIM) :: NCHEM_FLX 
+INTEGER(KIND=JPIM) :: NCHEM_DV
+INTEGER(KIND=JPIM) :: NCHEM_TC
+INTEGER(KIND=JPIM) :: NCHEM_SCV
+
+!     ------------------------------------------------------------------
+!      Mass fixers
+!     ------------------------------------------------------------------
+INTEGER(KIND=JPIM) :: NNEGAFIX     ! Num of fields to apply -ve fixer
+INTEGER(KIND=JPIM) :: NOPTNEGFIX   ! 1: simple negative fixer (reset to 0)
+                                   ! 2: reset to local minimum
+
+LOGICAL :: LQM3DCONS      ! Bermejo & Staniforth quasi-monotone limiter with improved
+                          ! conservation option. When true, applied to all GFL s.t. LQM3D=true
+LOGICAL :: LADVNEGFIX              ! Activates negative fixer for advection
+LOGICAL :: LTRCMFBC                ! Activate Bermejo & Conde if true
+LOGICAL :: LTRCMFPR                ! Activate Priestley algorithm if true
+LOGICAL :: LTRCMFMG                ! Activate Mac Gregor's algorithm if true
+LOGICAL :: LEXTRADF                ! Extra diagnostics 
+
+
+INTEGER(KIND=JPIM) :: NFLDSFIX     ! Number of fields to be fixed
+INTEGER(KIND=JPIM) :: NOPTMFIX     ! Bermejo & Conde fixer option for calculating its weight
+INTEGER(KIND=JPIM) :: NOPTVFE      ! Use Vertical FE in calculation of column mass total
+INTEGER(KIND=JPIM) :: NPMFIX       ! Parameter used in weight calculation
+INTEGER(KIND=JPIM) :: NMFDIAGLEV   ! Determines global diagnostic output level for fixer:
+                                   ! 0 - nothing, 1 - norms printed, 2 - norms + monotonicity
+INTEGER(KIND=JPIM) :: NMFIXFLDS(JPNAMED_GFL+JPGHG+JPGRG+JPCHEM+JPAERO+JPTRAC) 
+                                   ! Index of fields to be corrected by mass fixers
+INTEGER(KIND=JPIM) :: NNEGFLDS(JPNAMED_GFL+JPGHG+JPGRG+JPCHEM+JPAERO+JPTRAC)  
+                                   ! Index of fields to be corrected by SL -ve fixer
+REAL(KIND=JPRB)    :: ZMFIXEPS     ! Threshold for mass fixing scheme
+
+TYPE(TYPE_GFL_COMP) :: YCOMP(JPGFL)    ! General descriptor of all components
+
+TYPE(TYPE_GFL_COMP),POINTER  :: YQ          => NULL() ! Specific humidity
+TYPE(TYPE_GFL_COMP),POINTER  :: YI          => NULL() ! Ice water
+TYPE(TYPE_GFL_COMP),POINTER  :: YL          => NULL() ! Liquid water
+TYPE(TYPE_GFL_COMP),POINTER  :: YLCONV      => NULL() ! Liquid water (CONV. PART)
+TYPE(TYPE_GFL_COMP),POINTER  :: YICONV      => NULL() ! Ice    water (CONV. PART)
+TYPE(TYPE_GFL_COMP),POINTER  :: YRCONV      => NULL() ! Rain         (CONV. PART)
+TYPE(TYPE_GFL_COMP),POINTER  :: YSCONV      => NULL() ! Snow         (CONV. PART)
+TYPE(TYPE_GFL_COMP),POINTER  :: YIRAD       => NULL() ! Radiative cloud Ice water
+TYPE(TYPE_GFL_COMP),POINTER  :: YLRAD       => NULL() ! Radiative cloud Liquid water
+TYPE(TYPE_GFL_COMP),POINTER  :: YS          => NULL() ! Snow
+TYPE(TYPE_GFL_COMP),POINTER  :: YR          => NULL() ! Rain
+TYPE(TYPE_GFL_COMP),POINTER  :: YG          => NULL() ! Graupel
+TYPE(TYPE_GFL_COMP),POINTER  :: YH          => NULL() ! Hail
+TYPE(TYPE_GFL_COMP),POINTER  :: YTKE        => NULL() ! Turbulent Kinetic Energy
+TYPE(TYPE_GFL_COMP),POINTER  :: YTTE        => NULL() ! Turbulent Total Energy
+TYPE(TYPE_GFL_COMP),POINTER  :: YEFB1       => NULL() ! First variable EFB scheme
+TYPE(TYPE_GFL_COMP),POINTER  :: YEFB2       => NULL() ! Second variable EFB scheme
+TYPE(TYPE_GFL_COMP),POINTER  :: YEFB3       => NULL() ! Third variable EFB scheme
+TYPE(TYPE_GFL_COMP),POINTER  :: YA          => NULL() ! Cloud fraction
+TYPE(TYPE_GFL_COMP),POINTER  :: YO3         => NULL() ! Ozone
+TYPE(TYPE_GFL_COMP),POINTER  :: YSRC        => NULL() ! Second-order flux for AROME s'rc'/2Sigma_s2 multiplied by Lambda_3
+TYPE(TYPE_GFL_COMP),POINTER  :: YMXL        => NULL() ! Prognostic mixing length
+TYPE(TYPE_GFL_COMP),POINTER  :: YSCC2       => NULL() ! Saturation deficit^2 for Tompkins
+TYPE(TYPE_GFL_COMP),POINTER  :: YGCCA       => NULL() ! Skewness for Tompkins
+TYPE(TYPE_GFL_COMP),POINTER  :: YCPF        => NULL() ! Convective precipitation flux
+TYPE(TYPE_GFL_COMP),POINTER  :: YSPF        => NULL() ! Stratiform precipitation flux
+TYPE(TYPE_GFL_COMP),POINTER  :: YCVGQ       => NULL() ! Moisture Convergence for french physics
+TYPE(TYPE_GFL_COMP),POINTER  :: YQVA        => NULL() ! total humidity variation
+TYPE(TYPE_GFL_COMP),POINTER  :: YGHG(:)     => NULL() ! Greenhouse Gases
+TYPE(TYPE_GFL_COMP),POINTER  :: YGRG(:)     => NULL() ! Reactive Gases
+TYPE(TYPE_GFL_COMP),POINTER  :: YCHEM(:)    => NULL() ! Chemistry
+TYPE(TYPE_GFL_COMP),POINTER  :: YGRGTEND(:) => NULL() ! Reactive Gases Tendecies
+TYPE(TYPE_GFL_COMP),POINTER  :: YAERO(:)    => NULL() ! Aerosols
+TYPE(TYPE_GFL_COMP),POINTER  :: YTRAC(:)    => NULL() ! tracers for diagnostics
+TYPE(TYPE_GFL_COMP),POINTER  :: YLRCH4      => NULL() ! CH4 loss rate (instantaneous field)
+TYPE(TYPE_GFL_COMP),POINTER  :: YCH4S       => NULL() ! CH4 atmospheric sink (accumulated field)
+TYPE(TYPE_GFL_COMP),POINTER  :: YFORC(:)    => NULL() ! large scale forcing
+TYPE(TYPE_GFL_COMP),POINTER  :: YEZDIAG(:)  => NULL() ! easy diagnostics
+TYPE(TYPE_GFL_COMP),POINTER  :: YERA40(:)   => NULL() ! ERA40 diagnostic fields
+TYPE(TYPE_GFL_COMP),POINTER  :: YNOGW(:)    => NULL() ! NORO GWD SCHEME
+TYPE(TYPE_GFL_COMP),POINTER  :: YSLDIA(:)   => NULL() ! SL dynamics diagnostics
+TYPE(TYPE_GFL_COMP),POINTER  :: YAEROUT(:)  => NULL() ! Aerosol outputs
+TYPE(TYPE_GFL_COMP),POINTER  :: YUVP(:)     => NULL() ! UV-processor output
+TYPE(TYPE_GFL_COMP),POINTER  :: YPHYS(:)    => NULL() ! PHYS output
+
+
+TYPE(TYPE_GFL_COMP),POINTER  :: YSDSAT      => NULL() ! Standard Deviation of the
+                                                      ! SATuration Depression (Sigma_s) 
+TYPE(TYPE_GFL_COMP),POINTER  :: YCVV        => NULL() ! Convective Vertical Velocity
+TYPE(TYPE_GFL_COMP),POINTER  :: YRKTH       => NULL() ! Rasch-Kristjansson H tendency
+TYPE(TYPE_GFL_COMP),POINTER  :: YRKTQV      => NULL() ! Rasch-Kristjansson Qv tendency
+TYPE(TYPE_GFL_COMP),POINTER  :: YRKTQC      => NULL() ! Rasch-Kristjansson Qc tendency
+
+! Prognostic convection variables: add 6 named components
+TYPE(TYPE_GFL_COMP),POINTER  :: YUOM        => NULL() ! Updraught vert velocity
+TYPE(TYPE_GFL_COMP),POINTER  :: YUAL        => NULL() ! Updraught mesh fraction
+TYPE(TYPE_GFL_COMP),POINTER  :: YDOM        => NULL() ! Downdraught vert velocity
+TYPE(TYPE_GFL_COMP),POINTER  :: YDAL        => NULL() ! Downdraught mesh fraction
+TYPE(TYPE_GFL_COMP),POINTER  :: YUEN        => NULL() ! Updraught entrainment
+TYPE(TYPE_GFL_COMP),POINTER  :: YUNEBH      => NULL() ! pseudo-historic convective
+
+! Extra fields
+
+TYPE(TYPE_GFL_COMP),POINTER  :: YEXT(:)     => NULL() ! Extra fields
+
+TYPE(TYPE_GFL_NAML)  :: YQ_NL                 ! Specific humidity
+TYPE(TYPE_GFL_NAML)  :: YI_NL                 ! Ice water
+TYPE(TYPE_GFL_NAML)  :: YL_NL                 ! Liquid water
+TYPE(TYPE_GFL_NAML)  :: YLCONV_NL             ! Liquid water (CONV. PART)
+TYPE(TYPE_GFL_NAML)  :: YICONV_NL             ! Ice    water (CONV. PART)
+TYPE(TYPE_GFL_NAML)  :: YRCONV_NL             ! Rain         (CONV. PART)
+TYPE(TYPE_GFL_NAML)  :: YSCONV_NL             ! Snow         (CONV. PART)
+TYPE(TYPE_GFL_NAML)  :: YIRAD_NL              ! Radiative cloud Ice water
+TYPE(TYPE_GFL_NAML)  :: YLRAD_NL              ! Radiative cloud Liquid water
+TYPE(TYPE_GFL_NAML)  :: YS_NL                 ! Snow
+TYPE(TYPE_GFL_NAML)  :: YR_NL                 ! Rain
+TYPE(TYPE_GFL_NAML)  :: YG_NL                 ! Graupels
+TYPE(TYPE_GFL_NAML)  :: YH_NL                 ! Hail
+TYPE(TYPE_GFL_NAML)  :: YTKE_NL               ! Turbulent Kinetic Energy
+TYPE(TYPE_GFL_NAML)  :: YTTE_NL               ! Turbulent Total Energy
+TYPE(TYPE_GFL_NAML)  :: YEFB1_NL              ! First variable EFB scheme
+TYPE(TYPE_GFL_NAML)  :: YEFB2_NL              ! Second variable EFB scheme
+TYPE(TYPE_GFL_NAML)  :: YEFB3_NL              ! Third variable EFB scheme
+TYPE(TYPE_GFL_NAML)  :: YA_NL                 ! Cloud fraction
+TYPE(TYPE_GFL_NAML)  :: YO3_NL                ! Ozone
+TYPE(TYPE_GFL_NAML)  :: YSRC_NL               ! Second-order flux for AROME
+                                              ! s'rc'/2Sigma_s2
+                                              ! multiplied by Lambda_3
+TYPE(TYPE_GFL_NAML)  :: YMXL_NL               ! Prognostic mixing length
+TYPE(TYPE_GFL_NAML)  :: YSCC2_NL              ! Saturation deficit^2 for Tompkins
+TYPE(TYPE_GFL_NAML)  :: YGCCA_NL              ! Skewness for Tompkins
+TYPE(TYPE_GFL_NAML)  :: YCPF_NL               ! Convective precipitation flux
+TYPE(TYPE_GFL_NAML)  :: YSPF_NL               ! Stratiform precipitation flux
+TYPE(TYPE_GFL_NAML)  :: YCVGQ_NL              ! Moisture Convergence for french physics
+TYPE(TYPE_GFL_NAML)  :: YQVA_NL               ! Total humidity variation
+
+TYPE(TYPE_GFL_NAML)  :: YGHG_NL(JPGHG)        ! Greenhouse Gases
+TYPE(TYPE_GFL_NAML)  :: YGRG_NL(JPGRG)        ! Reactive Gases
+TYPE(TYPE_GFL_NAML)  :: YCHEM_NL(JPCHEM)      ! Chemical species
+TYPE(TYPE_GFL_NAML)  :: YGRGTEND_NL(JPGRG)    ! Reactive Gases Tendecies
+TYPE(TYPE_GFL_NAML)  :: YAERO_NL(JPAERO)      ! Aerosol fields
+TYPE(TYPE_GFL_NAML)  :: YTRAC_NL(JPTRAC)      ! Tracers for diagnostics
+TYPE(TYPE_GFL_NAML)  :: YERA40_NL(JPERA40)    ! ERA40 diagnostic fields
+TYPE(TYPE_GFL_NAML)  :: YNOGW_NL(JPNOGW)      ! NORO GWD SCHEME
+TYPE(TYPE_GFL_NAML)  :: YSLDIA_NL(JPSLDIA)    ! SL dynamics diagnostics
+TYPE(TYPE_GFL_NAML)  :: YLRCH4_NL             ! CH4 loss rate
+TYPE(TYPE_GFL_NAML)  :: YCH4S_NL              ! CH4 atmospheric sink
+TYPE(TYPE_GFL_NAML)  :: YAEROUT_NL(JPAEROUT)  ! Aerosol outputs
+TYPE(TYPE_GFL_NAML)  :: YUVP_NL(JPUVP)        ! UV-processor outputs
+TYPE(TYPE_GFL_NAML)  :: YRKTH_NL              ! Rasch-Kristjansson H tendency
+TYPE(TYPE_GFL_NAML)  :: YRKTQV_NL             ! Rasch-Kristjansson Qv tendency
+TYPE(TYPE_GFL_NAML)  :: YRKTQC_NL             ! Rasch-Kristjansson Qc tendency
+TYPE(TYPE_GFL_NAML)  :: YPHYS_NL(JPPHYS)      ! PHYS outputs 
+
+! Extra fields
+TYPE(TYPE_GFL_NAML)  :: YSDSAT_NL             ! Standard Deviation of the
+                                              ! SATuration Depression (Sigma_s) 
+TYPE(TYPE_GFL_NAML)  :: YCVV_NL               ! Convective Vertical Velocity
+TYPE(TYPE_GFL_NAML)  :: YFORC_NL(JPFORC)      ! Forcing precursor
+TYPE(TYPE_GFL_NAML)  :: YEZDIAG_NL(JPEZDIAG)  ! Easy diagnostics
+TYPE(TYPE_GFL_NAML)  :: YEXT_NL(JPGFL-JPNAMED_GFL-JPGHG-JPGRG-JPFORC-JPEZDIAG-JPAERO-JPTRAC-JPERA40-&
+ &                              JPNOGW-JPSLDIA-JPCH4S-JPAEROUT-JPUVP-JPCHEM-JPPHYS) ! Extra fields
+
+! Prognostic convection variables: 6 more namelist components
+TYPE(TYPE_GFL_NAML)  :: YUOM_NL               ! Updraught vert velocity
+TYPE(TYPE_GFL_NAML)  :: YUAL_NL               ! Updraught mesh fraction
+TYPE(TYPE_GFL_NAML)  :: YDOM_NL               ! Downdraught vert velocity
+TYPE(TYPE_GFL_NAML)  :: YDAL_NL               ! Downdraught mesh fraction
+TYPE(TYPE_GFL_NAML)  :: YUEN_NL               ! Updraught entrainment
+TYPE(TYPE_GFL_NAML)  :: YUNEBH_NL             ! Pseudi Hist Conv cloud fraction
+
+END TYPE TYPE_GFLD
+
+! GFL general descriptor
+TYPE(TYPE_GFLD), POINTER :: YGFL => NULL()
+
+END MODULE YOM_YGFL
Index: LMDZ6/trunk/libf/phylmd/ecrad/yomcst.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yomcst.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yomcst.F90	(revision 3908)
@@ -0,0 +1,37 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+MODULE YOMCST
+
+USE PARKIND1  ,ONLY : JPRB
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+! * RPI          : number Pi
+REAL(KIND=JPRB), PARAMETER :: RPI = 3.14159265358979323846_JPRB
+! * RSIGMA       : Stefan-Bolzman constant
+REAL(KIND=JPRB), PARAMETER :: RSIGMA = 5.67037321e-8_JPRB ! W m-2 K-4
+! * RG           : gravity constant
+REAL(KIND=JPRB), PARAMETER :: RG = 9.80665_JPRB ! m s-2
+! * RD           : R_dry (dry air constant)
+REAL(KIND=JPRB), PARAMETER :: RD = 287.058_JPRB! J kg-1 K-1
+! * RMD          : dry air molar mass
+REAL(KIND=JPRB), PARAMETER :: RMD = 28.9644_JPRB
+! * RMV          : vapour water molar mass
+REAL(KIND=JPRB), PARAMETER :: RMV = 18.0153_JPRB
+! * RMO3         : ozone molar mass
+REAL(KIND=JPRB), PARAMETER :: RMO3 = 47.9942_JPRB
+! * RI0          : solar constant
+REAL(KIND=JPRB), PARAMETER :: RI0 = 1366.0_JPRB
+
+END MODULE YOMCST
Index: LMDZ6/trunk/libf/phylmd/ecrad/yomdimv.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yomdimv.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yomdimv.F90	(revision 3908)
@@ -0,0 +1,43 @@
+MODULE YOMDIMV
+
+USE PARKIND1  ,ONLY : JPIM
+
+IMPLICIT NONE
+
+SAVE
+
+!     ------------------------------------------------------------------
+
+TYPE :: TDIMV
+
+!*    Dimensions of model working arrays
+
+! === VERTICAL RESOLUTION =====================================================
+
+! NFLEVG : number of levels in grid point space
+! NFLEVL : number of levels in Fourier and Legendre space
+! NFLEVLMX : maximum NFLEVL among all PEs
+! NFLSUR : over dimensioning of NFLEVL for technical reasons, always odd
+! NFLSUL : number of additional levels for semi-lagrangian
+! NFLSA  = 1    -NFLSUL
+! NFLEN  = NFLEVG+NFLSUL
+! NIOLEVG : number of levels in the whole atmosphere (used for I/Os and definitions) ; 
+!           NFLEVG can be a truncation of NIOLEVG
+
+INTEGER(KIND=JPIM) :: NFLEVG
+INTEGER(KIND=JPIM) :: NFLEVL
+INTEGER(KIND=JPIM) :: NFLEVLMX
+INTEGER(KIND=JPIM) :: NFLSUR
+INTEGER(KIND=JPIM) :: NFLSUL
+INTEGER(KIND=JPIM) :: NFLSA
+INTEGER(KIND=JPIM) :: NFLEN
+INTEGER(KIND=JPIM) :: NFLEVSF
+INTEGER(KIND=JPIM) :: NIOLEVG
+
+END TYPE TDIMV
+
+TYPE(TDIMV), POINTER :: YRDIMV => NULL()
+
+!     ------------------------------------------------------------------
+
+END MODULE YOMDIMV
Index: LMDZ6/trunk/libf/phylmd/ecrad/yomdyncore.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yomdyncore.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yomdyncore.F90	(revision 3908)
@@ -0,0 +1,26 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+MODULE YOMDYNCORE
+
+USE PARKIND1  ,ONLY : JPRB
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+! Aqua planet?
+LOGICAL, PARAMETER :: LAQUA = .false.
+! Small-planet factor
+REAL(KIND=JPRB)    :: RPLRG = 1.0
+
+
+END MODULE YOMDYNCORE
Index: LMDZ6/trunk/libf/phylmd/ecrad/yomhook.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yomhook.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yomhook.F90	(revision 3908)
@@ -0,0 +1,35 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! DR_HOOK is a profiling and debugging system for the IFS, and should
+! be called at the beginning and end of each subroutine. This is a
+! dummy implementation for offline packages.
+
+module yomhook
+
+  public
+
+  save
+
+  logical :: lhook = .false.
+
+contains
+
+  subroutine dr_hook(proc_name, iswitch, proc_key)
+
+    use parkind1, only : jprb
+
+    character(len=*), intent(in)    :: proc_name
+    integer,          intent(in)    :: iswitch
+    real(jprb),       intent(inout) :: proc_key
+    ! Do nothing!
+
+  end subroutine dr_hook
+
+end module yomhook
Index: LMDZ6/trunk/libf/phylmd/ecrad/yomhook.F90.or
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yomhook.F90.or	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yomhook.F90.or	(revision 3908)
@@ -0,0 +1,114 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+MODULE YOMHOOK
+
+USE PARKIND1  ,ONLY : JPIM, JPRB, JPRM, JPRD
+
+IMPLICIT NONE
+
+! Used by "hook" function
+! LHOOK = true implies "hook" function will be called
+! Altough initialized to TRUE it will be reset by first call to 
+! DR_HOOK unless we really want to use the hook function
+
+SAVE
+PUBLIC
+
+LOGICAL :: LHOOK=.TRUE.
+
+#include "dr_hook_util.h"
+#include "dr_hook_util_multi.h"
+
+INTERFACE DR_HOOK  
+
+MODULE PROCEDURE &
+  DR_HOOK_DEFAULT4, &
+  DR_HOOK_DEFAULT8, &
+  DR_HOOK_FILE, &
+  DR_HOOK_SIZE, &
+  DR_HOOK_FILE_SIZE, &
+  DR_HOOK_MULTI_DEFAULT, &
+  DR_HOOK_MULTI_FILE, &
+  DR_HOOK_MULTI_SIZE, &
+  DR_HOOK_MULTI_FILE_SIZE
+END INTERFACE
+
+CONTAINS 
+
+SUBROUTINE DR_HOOK_DEFAULT4(CDNAME,KSWITCH,PKEY)
+CHARACTER(LEN=*), INTENT(IN) :: CDNAME
+INTEGER(KIND=JPIM),        INTENT(IN) :: KSWITCH
+REAL(KIND=JPRM),        INTENT(INOUT) :: PKEY
+REAL(KIND=JPRB) :: ZKEY
+ZKEY = TRANSFER(PKEY,ZKEY)
+CALL DR_HOOK_UTIL(LHOOK,CDNAME,KSWITCH,ZKEY,'',0_JPIM)
+PKEY = TRANSFER(ZKEY,PKEY)
+END SUBROUTINE DR_HOOK_DEFAULT4
+
+SUBROUTINE DR_HOOK_DEFAULT8(CDNAME,KSWITCH,PKEY)
+CHARACTER(LEN=*), INTENT(IN) :: CDNAME
+INTEGER(KIND=JPIM),        INTENT(IN) :: KSWITCH
+REAL(KIND=JPRD),        INTENT(INOUT) :: PKEY
+REAL(KIND=JPRB) :: ZKEY
+ZKEY = TRANSFER(PKEY,ZKEY)
+CALL DR_HOOK_UTIL(LHOOK,CDNAME,KSWITCH,ZKEY,'',0_JPIM)
+PKEY = TRANSFER(ZKEY,PKEY)
+END SUBROUTINE DR_HOOK_DEFAULT8
+
+SUBROUTINE DR_HOOK_MULTI_DEFAULT(CDNAME,KSWITCH,PKEY)
+CHARACTER(LEN=*), INTENT(IN) :: CDNAME
+INTEGER(KIND=JPIM),        INTENT(IN) :: KSWITCH
+REAL(KIND=JPRB),        INTENT(INOUT) :: PKEY(:)
+CALL DR_HOOK_UTIL_MULTI(LHOOK,CDNAME,KSWITCH,PKEY,INT(SIZE(PKEY)),'',0_JPIM)
+END SUBROUTINE DR_HOOK_MULTI_DEFAULT
+
+SUBROUTINE DR_HOOK_FILE(CDNAME,KSWITCH,PKEY,CDFILE)
+CHARACTER(LEN=*), INTENT(IN) :: CDNAME,CDFILE
+INTEGER(KIND=JPIM),        INTENT(IN) :: KSWITCH
+REAL(KIND=JPRB),        INTENT(INOUT) :: PKEY
+CALL DR_HOOK_UTIL(LHOOK,CDNAME,KSWITCH,PKEY,CDFILE,0_JPIM)
+END SUBROUTINE DR_HOOK_FILE
+
+SUBROUTINE DR_HOOK_MULTI_FILE(CDNAME,KSWITCH,PKEY,CDFILE)
+CHARACTER(LEN=*), INTENT(IN) :: CDNAME,CDFILE
+INTEGER(KIND=JPIM),        INTENT(IN) :: KSWITCH
+REAL(KIND=JPRB),        INTENT(INOUT) :: PKEY(:)
+CALL DR_HOOK_UTIL_MULTI(LHOOK,CDNAME,KSWITCH,PKEY,INT(SIZE(PKEY)),CDFILE,0_JPIM)
+END SUBROUTINE DR_HOOK_MULTI_FILE
+
+SUBROUTINE DR_HOOK_SIZE(CDNAME,KSWITCH,PKEY,KSIZEINFO)
+CHARACTER(LEN=*), INTENT(IN) :: CDNAME
+INTEGER(KIND=JPIM),        INTENT(IN) :: KSWITCH,KSIZEINFO
+REAL(KIND=JPRB),        INTENT(INOUT) :: PKEY
+CALL DR_HOOK_UTIL(LHOOK,CDNAME,KSWITCH,PKEY,'',KSIZEINFO)
+END SUBROUTINE DR_HOOK_SIZE
+
+SUBROUTINE DR_HOOK_MULTI_SIZE(CDNAME,KSWITCH,PKEY,KSIZEINFO)
+CHARACTER(LEN=*), INTENT(IN) :: CDNAME
+INTEGER(KIND=JPIM),        INTENT(IN) :: KSWITCH,KSIZEINFO
+REAL(KIND=JPRB),        INTENT(INOUT) :: PKEY(:)
+CALL DR_HOOK_UTIL_MULTI(LHOOK,CDNAME,KSWITCH,PKEY,INT(SIZE(PKEY)),'',KSIZEINFO)
+END SUBROUTINE DR_HOOK_MULTI_SIZE
+
+SUBROUTINE DR_HOOK_FILE_SIZE(CDNAME,KSWITCH,PKEY,CDFILE,KSIZEINFO)
+CHARACTER(LEN=*), INTENT(IN) :: CDNAME,CDFILE
+INTEGER(KIND=JPIM),        INTENT(IN) :: KSWITCH,KSIZEINFO
+REAL(KIND=JPRB),        INTENT(INOUT) :: PKEY
+CALL DR_HOOK_UTIL(LHOOK,CDNAME,KSWITCH,PKEY,CDFILE,KSIZEINFO)
+END SUBROUTINE DR_HOOK_FILE_SIZE
+
+SUBROUTINE DR_HOOK_MULTI_FILE_SIZE(CDNAME,KSWITCH,PKEY,CDFILE,KSIZEINFO)
+CHARACTER(LEN=*), INTENT(IN) :: CDNAME,CDFILE
+INTEGER(KIND=JPIM),        INTENT(IN) :: KSWITCH,KSIZEINFO
+REAL(KIND=JPRB),        INTENT(INOUT) :: PKEY(:)
+CALL DR_HOOK_UTIL_MULTI(LHOOK,CDNAME,KSWITCH,PKEY,INT(SIZE(PKEY)),CDFILE,KSIZEINFO)
+END SUBROUTINE DR_HOOK_MULTI_FILE_SIZE
+
+END MODULE YOMHOOK
Index: LMDZ6/trunk/libf/phylmd/ecrad/yomlun.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yomlun.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yomlun.F90	(revision 3908)
@@ -0,0 +1,24 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+MODULE YOMLUN
+
+USE PARKIND1,      ONLY : JPIM
+USE YOMLUN_IFSAUX, ONLY : NULOUT, NULERR
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+INTEGER(KIND=JPIM) :: NULRAD = 25
+
+!     ------------------------------------------------------------------
+END MODULE YOMLUN
Index: LMDZ6/trunk/libf/phylmd/ecrad/yomlun_ifsaux.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yomlun_ifsaux.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yomlun_ifsaux.F90	(revision 3908)
@@ -0,0 +1,33 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+! This is taken from yomlun_ifsaux in the IFS
+
+MODULE YOMLUN_IFSAUX
+
+USE PARKIND1  ,ONLY : JPIM
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+!     ------------------------------------------------------------------
+
+!*    Logical units used by code
+
+!     NULOUT :   output unit
+!     NULERR :   unit number for comparison with reference run
+
+INTEGER(KIND=JPIM) :: NULOUT = 6
+INTEGER(KIND=JPIM) :: NULERR = 0
+
+!     ------------------------------------------------------------------
+END MODULE YOMLUN_IFSAUX
Index: LMDZ6/trunk/libf/phylmd/ecrad/yommp0.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yommp0.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yommp0.F90	(revision 3908)
@@ -0,0 +1,19 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+MODULE YOMMP0
+
+IMPLICIT NONE
+
+PUBLIC
+
+INTEGER, PARAMETER :: NPROC = 1
+INTEGER, PARAMETER :: MYPROC = 1
+
+END MODULE YOMMP0
Index: LMDZ6/trunk/libf/phylmd/ecrad/yomtag.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/yomtag.F90	(revision 3908)
+++ LMDZ6/trunk/libf/phylmd/ecrad/yomtag.F90	(revision 3908)
@@ -0,0 +1,23 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+MODULE YOMTAG
+
+USE PARKIND1  ,ONLY : JPIM
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+! MTAGRAD : tag for communications done in SUECRAD (ECMWF physics)
+INTEGER(KIND=JPIM), PARAMETER :: MTAGRAD               =  2800
+
+END MODULE YOMTAG
Index: LMDZ6/trunk/libf/phylmd/physiq_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/physiq_mod.F90	(revision 3906)
+++ LMDZ6/trunk/libf/phylmd/physiq_mod.F90	(revision 3908)
@@ -3967,5 +3967,6 @@
 
        IF (ok_newmicro) then
-          IF (iflag_rrtm.NE.0) THEN 
+! AI          IF (iflag_rrtm.NE.0) THEN 
+          IF (iflag_rrtm.EQ.1) THEN
 #ifdef CPP_RRTM
              IF (ok_cdnc.AND.NRADLP.NE.3) THEN
Index: LMDZ6/trunk/libf/phylmd/radlwsw_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/radlwsw_m.F90	(revision 3906)
+++ LMDZ6/trunk/libf/phylmd/radlwsw_m.F90	(revision 3908)
@@ -19,6 +19,6 @@
    flag_aerosol_strat, flag_aer_feedback, &
    tau_aero, piz_aero, cg_aero,&
-   tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& ! rajoute par OB pour RRTM
-   tau_aero_lw_rrtm, &                                   ! rajoute par C. Kleinschmitt pour RRTM
+   tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& ! rajoute par OB RRTM
+   tau_aero_lw_rrtm, &              ! rajoute par C.Kleinschmitt pour RRTM
    cldtaupi, &
    qsat, flwc, fiwc, &
@@ -45,21 +45,17 @@
    ZSWFT0_i, ZFSDN0, ZFSUP0)
 
-
-
+! Modules necessaires
   USE DIMPHY
   USE assert_m, ONLY : assert
   USE infotrac_phy, ONLY : type_trac
   USE write_field_phy
+
 #ifdef REPROBUS
   USE CHEM_REP, ONLY : solaireTIME, ok_SUNTIME, ndimozon
 #endif
+
 #ifdef CPP_RRTM
 !    modules necessaires au rayonnement 
 !    -----------------------------------------
-!     USE YOMCST   , ONLY : RG       ,RD       ,RTT      ,RPI
-!     USE YOERAD   , ONLY : NSW      ,LRRTM    ,LINHOM   , LCCNL,LCCNO,
-!     USE YOERAD   , ONLY : NSW      ,LRRTM    ,LCCNL    ,LCCNO ,&
-! NSW mis dans .def MPL 20140211
-! NLW ajoute par OB
       USE YOERAD   , ONLY : NLW, LRRTM    ,LCCNL    ,LCCNO ,&
           NRADIP   , NRADLP , NICEOPT, NLIQOPT ,RCCNLND  , RCCNSEA
@@ -73,7 +69,5 @@
           RFLDD1   ,RFLDD2   ,RFLDD3   ,RFUETA   ,RASWCA,& 
           RASWCB   ,RASWCC   ,RASWCD   ,RASWCE   ,RASWCF
-!    &    RASWCB   ,RASWCC   ,RASWCD   ,RASWCE   ,RASWCF, RLINLI
       USE YOERDU   , ONLY : NUAER  ,NTRAER ,REPLOG ,REPSC  ,REPSCW ,DIFF
-!      USE YOETHF   , ONLY : RTICE
       USE YOERRTWN , ONLY : DELWAVE   ,TOTPLNK      
       USE YOMPHY3  , ONLY : RII0
@@ -81,34 +75,46 @@
       USE aero_mod
 
+! AI 02.2021
+! Besoin pour ECRAD de pctsrf, zmasq, longitude, altitude
+#ifdef CPP_ECRAD
+      USE geometry_mod, ONLY: latitude, longitude
+      USE phys_state_var_mod, ONLY: pctsrf
+      USE indice_sol_mod
+      USE time_phylmdz_mod, only: current_time
+      USE phys_cal_mod, only: day_cur
+#endif
+
   !======================================================================
   ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19960719
   ! Objet: interface entre le modele et les rayonnements
   ! Arguments:
-  ! dist-----input-R- distance astronomique terre-soleil
-  ! rmu0-----input-R- cosinus de l'angle zenithal
-  ! fract----input-R- duree d'ensoleillement normalisee
-  ! co2_ppm--input-R- concentration du gaz carbonique (en ppm)
-  ! paprs----input-R- pression a inter-couche (Pa)
-  ! pplay----input-R- pression au milieu de couche (Pa)
-  ! tsol-----input-R- temperature du sol (en K)
-  ! alb1-----input-R- albedo du sol(entre 0 et 1) dans l'interval visible 
-  ! alb2-----input-R- albedo du sol(entre 0 et 1) dans l'interval proche infra-rouge   
-  ! t--------input-R- temperature (K)
-  ! q--------input-R- vapeur d'eau (en kg/kg)
-  ! cldfra---input-R- fraction nuageuse (entre 0 et 1)
-  ! cldtaupd---input-R- epaisseur optique des nuages dans le visible (present-day value)
-  ! cldemi---input-R- emissivite des nuages dans l'IR (entre 0 et 1)
-  ! ok_ade---input-L- apply the Aerosol Direct Effect or not?
-  ! ok_aie---input-L- apply the Aerosol Indirect Effect or not?
-  ! ok_volcan-input-L- activate volcanic diags (SW heat & LW cool rate, SW & LW flux)
-  ! flag_aerosol-input-I- aerosol flag from 0 to 6
-  ! flag_aerosol_strat-input-I- use stratospheric aerosols flag (0, 1, 2)
-  ! flag_aer_feedback-input-I- activate aerosol radiative feedback (T, F)
-  ! tau_ae, piz_ae, cg_ae-input-R- aerosol optical properties (calculated in aeropt.F)
-  ! cldtaupi-input-R- epaisseur optique des nuages dans le visible
+  !                  INPUTS
+  ! dist----- input-R- distance astronomique terre-soleil
+  ! rmu0----- input-R- cosinus de l'angle zenithal
+  ! fract---- input-R- duree d'ensoleillement normalisee
+  ! co2_ppm-- input-R- concentration du gaz carbonique (en ppm)
+  ! paprs---- input-R- pression a inter-couche (Pa)
+  ! pplay---- input-R- pression au milieu de couche (Pa)
+  ! tsol----- input-R- temperature du sol (en K)
+  ! alb1----- input-R- albedo du sol(entre 0 et 1) dans l'interval visible 
+  ! alb2----- input-R- albedo du sol(entre 0 et 1) dans l'interval proche infra-rouge   
+  ! t-------- input-R- temperature (K)
+  ! q-------- input-R- vapeur d'eau (en kg/kg)
+  ! cldfra--- input-R- fraction nuageuse (entre 0 et 1)
+  ! cldtaupd- input-R- epaisseur optique des nuages dans le visible (present-day value)
+  ! cldemi--- input-R- emissivite des nuages dans l'IR (entre 0 et 1)
+  ! ok_ade--- input-L- apply the Aerosol Direct Effect or not?
+  ! ok_aie--- input-L- apply the Aerosol Indirect Effect or not?
+  ! ok_volcan input-L- activate volcanic diags (SW heat & LW cool rate, SW & LW flux)
+  ! flag_aerosol input-I- aerosol flag from 0 to 6
+  ! flag_aerosol_strat input-I- use stratospheric aerosols flag (0, 1, 2)
+  ! flag_aer_feedback  input-I- activate aerosol radiative feedback (T, F)
+  ! tau_ae, piz_ae, cg_ae input-R- aerosol optical properties (calculated in aeropt.F)
+  ! cldtaupi  input-R- epaisseur optique des nuages dans le visible
   !                   calculated for pre-industrial (pi) aerosol concentrations, i.e. with smaller
   !                   droplet concentration, thus larger droplets, thus generally cdltaupi cldtaupd
   !                   it is needed for the diagnostics of the aerosol indirect radiative forcing      
   !
+  !                  OUTPUTS
   ! heat-----output-R- echauffement atmospherique (visible) (K/jour)
   ! cool-----output-R- refroidissement dans l'IR (K/jour)
@@ -177,4 +183,8 @@
   ! 
   ! ====================================================================
+
+! ==============
+! DECLARATIONS
+! ==============
   include "YOETHF.h"
   include "YOMCST.h"
@@ -286,4 +296,41 @@
   REAL(KIND=8) PTAVE(kdlon,kflev)
   REAL(KIND=8) PWV(kdlon,kflev), PQS(kdlon,kflev)
+
+!!!!!!! Declarations specifiques pour ECRAD !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! AI 02.2021
+#ifdef CPP_ECRAD
+! ATTENTION les dimensions klon, kdlon ???
+! INPUTS
+  REAL(KIND=8) ZEMISW(klon), &              ! LW emissivity inside the window region
+               ZEMIS(klon)                  ! LW emissivity outside the window region
+  REAL(KIND=8) ZGELAM(klon), &              ! longitudes en rad
+               ZGEMU(klon)                  ! sin(latitude)
+  REAL(KIND=8) ZCO2(klon,klev), &           ! CO2 mass mixing ratios on full levels
+               ZCH4(klon,klev), &           ! CH4 mass mixing ratios on full levels
+               ZN2O(klon,klev), &           ! N2O mass mixing ratios on full levels
+               ZNO2(klon,klev), &           ! NO2 mass mixing ratios on full levels
+               ZCFC11(klon,klev), &         ! CFC11
+               ZCFC12(klon,klev), &         ! CFC12
+               ZHCFC22(klon,klev), &        ! HCFC22
+               ZCCL4(klon,klev), &          ! CCL4
+               ZO3_DP(klon,klev), ZO3_DP_i(klon,klev)            ! Ozone
+  REAL(KIND=8) ZQ_RAIN(klon,klev), &        ! Rain cloud mass mixing ratio (kg/kg) ?
+               ZQ_SNOW(klon,klev)           ! Snow cloud mass mixing ratio (kg/kg) ?
+  REAL(KIND=8) ZAEROSOL_OLD(KLON,6,KLEV), &  ! 
+               ZAEROSOL(KLON,KLEV,naero_tot) !
+! OUTPUTS
+  REAL(KIND=8) ZFLUX_DIR(klon), &           ! Direct compt of surf flux into horizontal plane
+               ZFLUX_DIR_CLEAR(klon), &     ! CS Direct 
+               ZFLUX_DIR_INTO_SUN(klon), &  ! 
+               ZFLUX_UV(klon), &            ! UV flux
+               ZFLUX_PAR(klon), &           ! photosynthetically active radiation similarly
+               ZFLUX_PAR_CLEAR(klon), &     ! CS photosynthetically 
+               ZFLUX_SW_DN_TOA(klon), &     ! DN SW flux at TOA
+               ZEMIS_OUT(klon)              ! effective broadband emissivity
+  REAL(KIND=8) ZLWDERIVATIVE(klon,klev+1)   ! LW derivatives
+  REAL(KIND=8) ZSWDIFFUSEBAND(klon,NSW), &  ! SW DN flux in diffuse albedo band 
+               ZSWDIRECTBAND(klon,NSW)      ! SW DN flux in direct albedo band
+#endif
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
   REAL(kind=8) POZON(kdlon, kflev, size(wo, 3)) ! mass fraction of ozone
@@ -401,10 +448,18 @@
   REAL zdir, zdif
 
+! =========  INITIALISATIONS ==============================================
+ IF (lldebug) THEN
+  print*,'Entree dans radlwsw '
+  print*,'************* INITIALISATIONS *****************************'
+  print*,'klon, kdlon, klev, kflev =',klon, kdlon, klev, kflev
+ ENDIF
+
   CALL assert(size(wo, 1) == klon, size(wo, 2) == klev, "radlwsw wo")
-  ! initialisation
+  
   ist=1
   iend=klon
   ktdia=1
   kmode=ist 
+! Aeros
   tauaero(:,:,:,:)=0.
   pizaero(:,:,:,:)=0.
@@ -462,23 +517,23 @@
   ENDIF
 
+ IF (lldebug) THEN
+  print*,'************** Debut boucle de 1 a ', nb_gr
+ ENDIF
+
   DO j = 1, nb_gr
     iof = kdlon*(j-1)
     DO i = 1, kdlon
       zfract(i) = fract(iof+i)
-!     zfract(i) = 1.     !!!!!!  essai MPL 19052010
       zrmu0(i) = rmu0(iof+i)
 
 
-!albedo SB >>>
-!
       IF (iflag_rrtm==0) THEN
-!
+!     Albedo
         PALBD(i,1)=alb_dif(iof+i,1)
         PALBD(i,2)=alb_dif(iof+i,2)
         PALBP(i,1)=alb_dir(iof+i,1)
         PALBP(i,2)=alb_dir(iof+i,2)
-!
-      ELSEIF (iflag_rrtm==1) THEn
-!
+! AI 02.2021 cas iflag_rrtm=1 et 2
+       ELSEIF (iflag_rrtm==1.OR.iflag_rrtm==2) THEN
         DO kk=1,NSW
           PALBD_NEW(i,kk)=alb_dif(iof+i,kk)
@@ -488,5 +543,4 @@
       ENDIF
 !albedo SB <<<
-
 
       PEMIS(i) = 1.0    !!!!! A REVOIR (MPL) 
@@ -513,4 +567,5 @@
         POZON(i,k, :) = wo(iof+i, k, :) * RG * dobson_u * 1e3 &
              / (paprs(iof+i, k) - paprs(iof+i, k+1))
+        ZO3_DP(i,k) = wo(iof+i, k, 1) * RG * dobson_u * 1e3
 !       A activer pour CCMVAL on prend l'ozone impose (MPL 07042010)
 !       POZON(i,k,:) = wo(i,k,:)  
@@ -569,4 +624,24 @@
       ENDDO
     ENDDO
+!
+! AI 02.2021
+#ifdef CPP_ECRAD
+  ZEMIS = 1.0
+  ZEMISW = 1.0
+  ZGELAM = longitude
+  ZGEMU = sin(latitude)
+  ZCO2 = RCO2 
+  ZCH4 = RCH4
+  ZN2O = RN2O
+  ZNO2 = 0.0
+  ZCFC11 = RCFC11
+  ZCFC12 = RCFC12 
+  ZHCFC22 = 0.0 
+  ZCCL4 = 0.0
+  ZQ_RAIN = 0.0
+  ZQ_SNOW = 0.0
+  ZAEROSOL_OLD = 0.0
+  ZAEROSOL = 0.0
+#endif
 !
 !===== iflag_rrtm ================================================
@@ -693,5 +768,5 @@
        ENDDO  
 !
-    ELSE  
+    ELSE IF (iflag_rrtm == 1) then  
 #ifdef CPP_RRTM
 !      if (prt_level.gt.10)write(lunout,*)'CPP_RRTM=.T.' 
@@ -804,4 +879,5 @@
             ENDDO
          ENDDO
+
 !       print *,'RADLWSW: avant RECMWFL, RI0,rmu0=',solaire,rmu0
 
@@ -850,19 +926,35 @@
 ! Nouvel appel a RECMWF (celui du cy32t0)
          CALL RECMWF_AERO (ist , iend, klon , ktdia  , klev   , kmode ,&
+!                          KST,  KEND, KPROMA, KTDIA , KLEV,  KMODE
          PALBD_NEW,PALBP_NEW, paprs_i , pplay_i , RCO2   , cldfra_i,&
+!        PALBD ,   PALBP ,    PAPRS ,   PAPRSF ,  PCCO2 , PCLFR
          POZON_i  , PAER_i  , PDP_i   , PEMIS   , rmu0   ,&
+!        PQO3  ,    PAER  ,   PDP   ,   PEMIS  , PMU0
           q_i     , qsat_i  , fiwc_i  , flwc_i  , zmasq  , t_i  ,tsol,&
+!         PQ       , PQS   , PQIWP ,     PQLWP , PSLM   , PT    , PTS, 
          ref_liq_i, ref_ice_i, &
+!        PREF_LIQ, PREF_ICE
          ref_liq_pi_i, ref_ice_pi_i, &   ! rajoute par OB pour diagnostiquer effet indirect
+!        PREF_LIQ_PI, PREF_ICE_PI
          ZEMTD_i  , ZEMTU_i , ZTRSO_i ,&
+!        PEMTD , PEMTU , PTRSO
          ZTH_i    , ZCTRSO  , ZCEMTR  , ZTRSOD  ,&
+!        PTH   ,     PCTRSO,   PCEMTR, PTRSOD
          ZLWFC    , ZLWFT_i , ZSWFC   , ZSWFT_i ,&
+!        PLWFC,     PLWFT,    PSWFC,    PSWFT, 
          PSFSWDIR , PSFSWDIF, PFSDNN  , PFSDNV  ,&
+!        PSFSWDIR,  PSFSWDIF, PFSDNN,    PFSDNV
          PPIZA_TOT, PCGA_TOT,PTAU_TOT,&
+!        PPIZA_TOT, PCGA_TOT,PTAU_TOT
          PPIZA_NAT, PCGA_NAT,PTAU_NAT,           &  ! rajoute par OB pour diagnostiquer effet direct
+!        PPIZA_NAT,PCGA_NAT,PTAU_NAT
          PTAU_LW_TOT, PTAU_LW_NAT,               &  ! rajoute par C. Kleinschmitt
+!        PTAU_LW_TOT, PTAU_LW_NAT,
          ZFLUX_i  , ZFLUC_i ,&
+!        PFLUX,      PFLUC
          ZFSDWN_i , ZFSUP_i , ZFCDWN_i, ZFCUP_i, ZFCCDWN_i, ZFCCUP_i, ZFLCCDWN_i, ZFLCCUP_i, &
+!        PFSDN ,    PFSUP ,   PFSCDN , PFSCUP,   PFSCCDN,   PFSCCUP,  PFLCCDN,    PFLCCUP
          ZTOPSWADAERO,ZSOLSWADAERO,&  ! rajoute par OB pour diagnostics
+!        PTOPSWADAERO,PSOLSWADAERO
          ZTOPSWAD0AERO,ZSOLSWAD0AERO,&
          ZTOPSWAIAERO,ZSOLSWAIAERO, &
@@ -874,4 +966,18 @@
          ZLWADAERO, & !--NL
          ok_ade, ok_aie, ok_volcan, flag_aerosol,flag_aerosol_strat, flag_aer_feedback) ! flags aerosols
+
+!--OB diagnostics
+! & PTOPSWAIAERO,PSOLSWAIAERO,&
+! & PTOPSWCFAERO,PSOLSWCFAERO,&
+! & PSWADAERO,& !--NL
+!!--LW diagnostics CK
+! & PTOPLWADAERO,PSOLLWADAERO,&
+! & PTOPLWAD0AERO,PSOLLWAD0AERO,&
+! & PTOPLWAIAERO,PSOLLWAIAERO,&
+! & PLWADAERO,& !--NL
+!!..end
+! & ok_ade, ok_aie, ok_volcan, flag_aerosol,flag_aerosol_strat,&
+! & flag_aer_feedback)
+
             
 !        print *,'RADLWSW: apres RECMWF'
@@ -1061,5 +1167,318 @@
     call abort_physic(modname, abort_message, 1)
 #endif
-    ENDIF ! iflag_rrtm
+!======================================================================
+! AI fev 2021
+    ELSE IF(iflag_rrtm == 2) THEN
+    print*,'Traitement cas iflag_rrtm = ',iflag_rrtm
+!    print*,'Mise a zero des flux '
+#ifdef CPP_ECRAD
+      DO k = 1, kflev+1
+      DO i = 1, kdlon
+        ZEMTD_i(i,k)=0.
+        ZEMTU_i(i,k)=0.
+        ZTRSO_i(i,k)=0.
+        ZTH_i(i,k)=0.
+        ZLWFT_i(i,k)=0.
+        ZSWFT_i(i,k)=0.
+        ZFLUX_i(i,1,k)=0.
+        ZFLUX_i(i,2,k)=0.
+        ZFLUC_i(i,1,k)=0.
+        ZFLUC_i(i,2,k)=0.
+        ZFSDWN_i(i,k)=0.
+        ZFCDWN_i(i,k)=0.
+        ZFCCDWN_i(i,k)=0.
+        ZFSUP_i(i,k)=0.
+        ZFCUP_i(i,k)=0.
+        ZFCCUP_i(i,k)=0.
+        ZFLCCDWN_i(i,k)=0.
+        ZFLCCUP_i(i,k)=0.
+      ENDDO
+      ENDDO
+!
+! Aerosols A REVOIR
+!      DO i = 1, kdlon
+!      DO k = 1, kflev
+!      DO kk=1, NSW
+!
+!      PTAU_TOT(i,kflev+1-k,kk)=tau_aero_sw_rrtm(i,k,2,kk)
+!      PPIZA_TOT(i,kflev+1-k,kk)=piz_aero_sw_rrtm(i,k,2,kk)
+!      PCGA_TOT(i,kflev+1-k,kk)=cg_aero_sw_rrtm(i,k,2,kk)
+!
+!      PTAU_NAT(i,kflev+1-k,kk)=tau_aero_sw_rrtm(i,k,1,kk)
+!      PPIZA_NAT(i,kflev+1-k,kk)=piz_aero_sw_rrtm(i,k,1,kk)
+!      PCGA_NAT(i,kflev+1-k,kk)=cg_aero_sw_rrtm(i,k,1,kk)
+!
+!      ENDDO
+!      ENDDO
+!      ENDDO
+!-end OB
+!
+!      DO i = 1, kdlon
+!      DO k = 1, kflev
+!      DO kk=1, NLW
+!
+!      PTAU_LW_TOT(i,kflev+1-k,kk)=tau_aero_lw_rrtm(i,k,2,kk)
+!      PTAU_LW_NAT(i,kflev+1-k,kk)=tau_aero_lw_rrtm(i,k,1,kk)
+!
+!      ENDDO
+!      ENDDO
+!      ENDDO
+!-end C. Kleinschmitt
+!      
+      DO i = 1, kdlon
+      ZCTRSO(i,1)=0.
+      ZCTRSO(i,2)=0.
+      ZCEMTR(i,1)=0.
+      ZCEMTR(i,2)=0.
+      ZTRSOD(i)=0.
+      ZLWFC(i,1)=0.
+      ZLWFC(i,2)=0.
+      ZSWFC(i,1)=0.
+      ZSWFC(i,2)=0.
+      PFSDNN(i)=0.
+      PFSDNV(i)=0.
+      DO kk = 1, NSW
+        PSFSWDIR(i,kk)=0.
+        PSFSWDIF(i,kk)=0.
+      ENDDO
+      ENDDO
+!----- Fin des mises a zero des tableaux output -------------------              
+
+! On met les donnees dans l'ordre des niveaux ecrad
+!         print*,'On inverse sur la verticale '
+         paprs_i(:,1)=paprs(:,klev+1)
+         DO k=1,klev
+            paprs_i(1:klon,k+1) =paprs(1:klon,klev+1-k)
+            pplay_i(1:klon,k)   =pplay(1:klon,klev+1-k)
+            cldfra_i(1:klon,k)  =cldfra(1:klon,klev+1-k)
+            PDP_i(1:klon,k)     =PDP(1:klon,klev+1-k)
+            t_i(1:klon,k)       =t(1:klon,klev+1-k)
+            q_i(1:klon,k)       =q(1:klon,klev+1-k)
+            qsat_i(1:klon,k)    =qsat(1:klon,klev+1-k)
+            flwc_i(1:klon,k)    =flwc(1:klon,klev+1-k)
+            fiwc_i(1:klon,k)    =fiwc(1:klon,klev+1-k)
+            ref_liq_i(1:klon,k) =ref_liq(1:klon,klev+1-k)
+            ref_ice_i(1:klon,k) =ref_ice(1:klon,klev+1-k)
+!-OB
+            ref_liq_pi_i(1:klon,k) =ref_liq_pi(1:klon,klev+1-k)
+            ref_ice_pi_i(1:klon,k) =ref_ice_pi(1:klon,klev+1-k)
+         ENDDO
+         DO k=1,kflev
+            ZO3_DP_i(1:klon,k)=ZO3_DP(1:klon,kflev+1-k)
+            DO i=1,6
+            PAER_i(1:klon,k,i)=PAER(1:klon,kflev+1-k,i)
+            ENDDO
+         ENDDO
+! AI 02.2021
+! Calcul of ZTH_i
+         DO K=2,KLEV
+            ZTH_i(:,K)=&
+              & (t_i(:,K-1)*pplay_i(:,K-1)*(pplay_i(:,K)-paprs_i(:,K))&
+              & +t_i(:,K)*pplay_i(:,K)*(paprs_i(:,K)-pplay_i(:,K-1)))&
+              & *(1.0/(paprs_i(:,K)*(pplay_i(:,K)-pplay_i(:,K-1))))
+         ENDDO
+            ZTH_i(:,KLEV+1)=tsol(:)
+            ZTH_i(:,1)=t_i(:,1)-pplay_i(:,1)*(t_i(:,1)-ZTH_i(:,2))&
+                      & /(pplay_i(:,1)-paprs_i(:,2))
+
+      print *,'RADLWSW: avant RADIATION_SCHEME '
+      IF (lldebug) THEN
+        CALL writefield_phy('rmu0',rmu0,1)
+        CALL writefield_phy('tsol',tsol,1)
+        CALL writefield_phy('emissiv_out',ZEMIS,1)
+        CALL writefield_phy('emissiv_in',ZEMISW,1)
+        CALL writefield_phy('pctsrf_ter',pctsrf(:,is_ter),1)
+        CALL writefield_phy('pctsrf_oce',pctsrf(:,is_oce),1)
+        CALL writefield_phy('ZGELAM',ZGELAM,1)
+        CALL writefield_phy('ZGEMU',ZGEMU,1)
+        CALL writefield_phy('zmasq',zmasq,1)
+        CALL writefield_phy('paprs_i',paprs_i,klev+1)
+        CALL writefield_phy('pplay_i',pplay_i,klev)
+        CALL writefield_phy('t_i',t_i,klev)
+        CALL writefield_phy('ZTH_i',ZTH_i,klev+1)
+        CALL writefield_phy('cldfra_i',cldfra_i,klev)
+        CALL writefield_phy('paer_i',PAER_i,klev)
+        CALL writefield_phy('q_i',q_i,klev)
+        CALL writefield_phy('fiwc_i',fiwc_i,klev)
+        CALL writefield_phy('flwc_i',flwc_i,klev)
+        CALL writefield_phy('palbd_new',PALBD_NEW,NSW)
+        CALL writefield_phy('palbp_new',PALBP_NEW,NSW)
+        CALL writefield_phy('ZO3_DP',ZO3_DP,klev)
+      ENDIF
+
+      CALL RADIATION_SCHEME &
+      & (ist, iend, klon, klev, naero_tot, NSW, &
+! ??? naero_tot
+      & day_cur, current_time, & 
+      & solaire, &
+      & rmu0, tsol, PALBD_NEW,PALBP_NEW, &   
+!       PEMIS_WINDOW (???), &
+      &  ZEMIS, ZEMISW, &
+!       PCCN_LAND, PCCN_SEA, & ???
+      & pctsrf(:,is_ter), pctsrf(:,is_oce), &
+!       longitude(rad), sin(latitude), PMASQ_ ???
+      & ZGELAM, ZGEMU, zmasq, &
+      & pplay_i, t_i, &
+!       PTEMPERATURE_H ?, &
+      & paprs_i, ZTH_i, q_i, qsat_i, & 
+      & ZCO2, ZCH4, ZN2O, ZNO2, ZCFC11, ZCFC12, ZHCFC22, ZCCL4, ZO3_DP_i, &
+      & cldfra_i, flwc_i, fiwc_i, ZQ_RAIN, ZQ_SNOW, &  
+      & ref_liq_i, ref_ice_i, &
+!       aerosols
+      & ZAEROSOL_OLD, ZAEROSOL, &
+! Outputs
+!       Net flux
+      & ZSWFT_i, ZLWFT_i, ZSWFT0_i, ZLWFT0_i, &
+!       DN flux
+      & ZFSDWN_i, ZFLUX_i(:,2,:), ZFCDWN_i, ZFLUC_i(:,2,:), &
+!       UP flux
+      & ZFSUP_i, ZFLUX_i(:,1,:), ZFCUP_i, ZFLUC_i(:,1,:), &
+!       Surf Direct flux
+      & ZFLUX_DIR, ZFLUX_DIR_CLEAR, ZFLUX_DIR_INTO_SUN, &
+!       UV and para flux
+      & ZFLUX_UV, ZFLUX_PAR, ZFLUX_PAR_CLEAR, &
+!      & ZFLUX_SW_DN_TOA, 
+      & ZEMIS_OUT, ZLWDERIVATIVE, &
+      & PSFSWDIF, PSFSWDIR)
+
+      print *,'========= RADLWSW: apres RADIATION_SCHEME ==================== '
+  IF (lldebug) THEN
+    if (0.eq.0) then
+      print *,' Net Flux '
+      print *,'ZSWFT_i =', ZSWFT_i
+      print *,'ZLWFT_i =', ZLWFT_i
+      print *,'ZSWFT0_i =', ZSWFT0_i
+      print*,'ZLWFT0_i =', ZLWFT0_i
+
+      print*,'DN Flux '
+      print*,'ZFSDWN_i =', ZFSDWN_i
+      print*,'ZFLUX_i(:,2,:)', ZFLUX_i(:,2,:)
+      print*,'ZFCDWN_i =', ZFCDWN_i
+      print*,'ZFLUC_i(:,2,:) =', ZFLUC_i(:,2,:) 
+
+      print*,'UP Flux '
+      print*,'ZFSUP_i =', ZFSUP_i 
+      print*,'ZFLUX_i(:,1,:) =', ZFLUX_i(:,1,:)
+      print*,'ZFCUP_i =', ZFCUP_i
+      print*,'ZFLUC_i(:,1,:) =', ZFLUC_i(:,1,:)
+
+      print*,'UV and para flux '
+      print*,'ZFLUX_DIR =', ZFLUX_DIR
+      print*,'ZFLUX_DIR_CLEAR', ZFLUX_DIR_CLEAR
+      print*,'ZFLUX_DIR_INTO_SUN', ZFLUX_DIR_INTO_SUN
+    endif
+   ENDIF
+
+      IF (lldebug) THEN
+        CALL writefield_phy('zlwft_i',ZLWFT_i,klev+1)
+        CALL writefield_phy('zlwft0_i',ZLWFT0_i,klev+1)
+        CALL writefield_phy('zswft_i',ZSWFT_i,klev+1)
+        CALL writefield_phy('zswft0_i',ZSWFT0_i,klev+1)
+        CALL writefield_phy('psfswdir',PSFSWDIR,6)
+        CALL writefield_phy('psfswdif',PSFSWDIF,6)
+        CALL writefield_phy('zflux_i',ZFLUX_i,klev+1)
+        CALL writefield_phy('zfluc_i',ZFLUC_i,klev+1)
+        CALL writefield_phy('zfsdwn_i',ZFSDWN_i,klev+1)
+        CALL writefield_phy('zfsup_i',ZFSUP_i,klev+1)
+        CALL writefield_phy('zfcdwn_i',ZFCDWN_i,klev+1)
+        CALL writefield_phy('zfcup_i',ZFCUP_i,klev+1)
+      ENDIF
+! ---------
+! On retablit l'ordre des niveaux lmd pour les tableaux de sortie
+! D autre part, on multiplie les resultats SW par fract pour etre coherent
+! avec l ancien rayonnement AR4. Si nuit, fract=0 donc pas de 
+! rayonnement SW. (MPL 260609)
+      print*,'On retablit ordre des niveaux verticaux'
+      print*,'On multiplie les flux SW par fract ?'
+      DO k=0,klev
+         DO i=1,klon
+         ZEMTD(i,k+1)  = ZEMTD_i(i,k+1)
+         ZEMTU(i,k+1)  = ZEMTU_i(i,k+1)
+         ZTRSO(i,k+1)  = ZTRSO_i(i,k+1)
+         ZTH(i,k+1)    = ZTH_i(i,k+1)
+         ZFLUP(i,k+1)  = ZFLUX_i(i,1,k+1)
+         ZFLDN(i,k+1)  = ZFLUX_i(i,2,k+1)
+         ZFLUP0(i,k+1) = ZFLUC_i(i,1,k+1)
+         ZFLDN0(i,k+1) = ZFLUC_i(i,2,k+1)
+         ZFSDN(i,k+1)  = ZFSDWN_i(i,k+1)*fract(i)
+         ZFSDN0(i,k+1) = ZFCDWN_i(i,k+1)*fract(i)
+         ZFSDNC0(i,k+1)= ZFCCDWN_i(i,k+1)*fract(i)
+         ZFSUP (i,k+1) = ZFSUP_i(i,k+1)*fract(i)
+         ZFSUP0(i,k+1) = ZFCUP_i(i,k+1)*fract(i)
+         ZFSUPC0(i,k+1)= ZFCCUP_i(i,k+1)*fract(i)
+         ZFLDNC0(i,k+1)= ZFLCCDWN_i(i,k+1)
+         ZFLUPC0(i,k+1)= ZFLCCUP_i(i,k+1)
+         IF (ok_volcan) THEN
+            ZSWADAERO(i,k+1)=ZSWADAERO(i,k+1)*fract(i) !--NL
+         ENDIF
+         
+!   Nouveau calcul car visiblement ZSWFT et ZSWFC sont nuls dans RRTM cy32
+!   en sortie de radlsw.F90 - MPL 7.01.09
+         ZSWFT(i,k+1)  = (ZFSDWN_i(i,k+1)-ZFSUP_i(i,k+1))*fract(i)
+         ZSWFT0_i(i,k+1) = (ZFCDWN_i(i,k+1)-ZFCUP_i(i,k+1))*fract(i)
+         ZLWFT(i,k+1) =-ZFLUX_i(i,2,k+1)-ZFLUX_i(i,1,k+1)
+         ZLWFT0_i(i,k+1)=-ZFLUC_i(i,2,k+1)-ZFLUC_i(i,1,k+1)
+         ENDDO
+      ENDDO
+
+!--ajout OB
+      ZTOPSWADAERO(:) =ZTOPSWADAERO(:) *fract(:)
+      ZSOLSWADAERO(:) =ZSOLSWADAERO(:) *fract(:)
+      ZTOPSWAD0AERO(:)=ZTOPSWAD0AERO(:)*fract(:)
+      ZSOLSWAD0AERO(:)=ZSOLSWAD0AERO(:)*fract(:)
+      ZTOPSWAIAERO(:) =ZTOPSWAIAERO(:) *fract(:)
+      ZSOLSWAIAERO(:) =ZSOLSWAIAERO(:) *fract(:)
+      ZTOPSWCF_AERO(:,1)=ZTOPSWCF_AERO(:,1)*fract(:) 
+      ZTOPSWCF_AERO(:,2)=ZTOPSWCF_AERO(:,2)*fract(:) 
+      ZTOPSWCF_AERO(:,3)=ZTOPSWCF_AERO(:,3)*fract(:) 
+      ZSOLSWCF_AERO(:,1)=ZSOLSWCF_AERO(:,1)*fract(:)
+      ZSOLSWCF_AERO(:,2)=ZSOLSWCF_AERO(:,2)*fract(:)
+      ZSOLSWCF_AERO(:,3)=ZSOLSWCF_AERO(:,3)*fract(:)
+
+! ---------
+! On renseigne les champs LMDz, pour avoir la meme chose qu'en sortie de
+! LW_LMDAR4 et SW_LMDAR4
+
+      !--fraction of diffuse radiation in surface SW downward radiation
+      DO i = 1, kdlon
+       IF (fract(i).GT.0.0) THEN
+         zdir=SUM(PSFSWDIR(i,:))
+         zdif=SUM(PSFSWDIF(i,:))
+         zsolswfdiff(i) = zdif/(zdir+zdif)
+       ELSE  !--night
+         zsolswfdiff(i) = 1.0
+       ENDIF
+      ENDDO 
+!
+      DO i = 1, kdlon
+         zsolsw(i)    = ZSWFT(i,1)
+         zsolsw0(i)   = ZSWFT0_i(i,1)
+         ztopsw(i)    = ZSWFT(i,klev+1)
+         ztopsw0(i)   = ZSWFT0_i(i,klev+1)
+         zsollw(i)    = ZLWFT(i,1)
+         zsollw0(i)   = ZLWFT0_i(i,1)
+         ztoplw(i)    = ZLWFT(i,klev+1)*(-1)
+         ztoplw0(i)   = ZLWFT0_i(i,klev+1)*(-1)
+!         
+         zsollwdown(i)= -1.*ZFLDN(i,1)
+      ENDDO
+
+      DO k=1,kflev
+         DO i=1,kdlon
+           zheat(i,k)=(ZSWFT(i,k+1)-ZSWFT(i,k))*RDAY*RG/RCPD/PDP(i,k)
+           zheat0(i,k)=(ZSWFT0_i(i,k+1)-ZSWFT0_i(i,k))*RDAY*RG/RCPD/PDP(i,k)
+           zcool(i,k)=(ZLWFT(i,k)-ZLWFT(i,k+1))*RDAY*RG/RCPD/PDP(i,k)
+           zcool0(i,k)=(ZLWFT0_i(i,k)-ZLWFT0_i(i,k+1))*RDAY*RG/RCPD/PDP(i,k)
+           IF (ok_volcan) THEN
+              zheat_volc(i,k)=(ZSWADAERO(i,k+1)-ZSWADAERO(i,k))*RG/RCPD/PDP(i,k) !NL
+              zcool_volc(i,k)=(ZLWADAERO(i,k)-ZLWADAERO(i,k+1))*RG/RCPD/PDP(i,k) !NL
+           ENDIF
+         ENDDO
+      ENDDO
+#endif  
+  print*,'Fin traitement ECRAD'
+! Fin ECRAD
+  ENDIF        ! iflag_rrtm
+! ecrad
 !======================================================================
 
@@ -1102,9 +1521,4 @@
           solswad_aero(iof+i) = zsolswadaero(i)
           solswad0_aero(iof+i) = zsolswad0aero(i)
-! MS the following lines seem to be wrong, why is iof on right hand side???
-!          topsw_aero(iof+i,:) = ztopsw_aero(iof+i,:)
-!          topsw0_aero(iof+i,:) = ztopsw0_aero(iof+i,:)
-!          solsw_aero(iof+i,:) = zsolsw_aero(iof+i,:)
-!          solsw0_aero(iof+i,:) = zsolsw0_aero(iof+i,:)
           topsw_aero(iof+i,:) = ztopsw_aero(i,:)
           topsw0_aero(iof+i,:) = ztopsw0_aero(i,:)
