Index: LMDZ6/trunk/DefLists/namelist_ecrad
===================================================================
--- LMDZ6/trunk/DefLists/namelist_ecrad	(revision 4488)
+++ LMDZ6/trunk/DefLists/namelist_ecrad	(revision 4489)
@@ -66,5 +66,6 @@
 iverbose    	 	= 1, 
 use_aerosols		= false,          ! Include aerosols in radiation calculations?
-n_aerosol_types         = 12,             
+n_aerosol_types         = 13,             
+aerosol_optics_override_file_name = "aerosol_optics_lmdz.nc"
 do_save_spectral_flux   = false,          ! Save spectral fluxes in output file?
 do_save_gpoint_flux     = false,          ! Save fluxes per g-point in output file?
Index: LMDZ6/trunk/arch/arch-ES_MOON.path
===================================================================
--- LMDZ6/trunk/arch/arch-ES_MOON.path	(revision 4488)
+++ LMDZ6/trunk/arch/arch-ES_MOON.path	(revision 4489)
@@ -1,4 +1,6 @@
 NETCDF_LIBDIR="-L/S/home010/c0010/ES/lib -lnetcdf"
 NETCDF_INCDIR=-I/S/home010/c0010/ES/include
+NETCDF95_INCDIR=-I$LMDGCM/../../include
+NETCDF95_LIBDIR=-L$LMDGCM/../../lib
 IOIPSL_INCDIR=$LMDGCM/../../lib
 IOIPSL_LIBDIR=$LMDGCM/../../lib
Index: LMDZ6/trunk/arch/arch-IA64_PLATINE.path
===================================================================
--- LMDZ6/trunk/arch/arch-IA64_PLATINE.path	(revision 4488)
+++ LMDZ6/trunk/arch/arch-IA64_PLATINE.path	(revision 4489)
@@ -1,4 +1,6 @@
 NETCDF_LIBDIR="-L/usr/lib -lnetcdff  -lnetcdf"
 NETCDF_INCDIR=-I/usr/include
+NETCDF95_INCDIR=$LMDGCM/../../include
+NETCDF95_LIBDIR=$LMDGCM/../../lib
 IOIPSL_INCDIR=$LMDGCM/../../lib
 IOIPSL_LIBDIR=$LMDGCM/../../lib
Index: LMDZ6/trunk/arch/arch-PW6_VARGAS.path
===================================================================
--- LMDZ6/trunk/arch/arch-PW6_VARGAS.path	(revision 4488)
+++ LMDZ6/trunk/arch/arch-PW6_VARGAS.path	(revision 4489)
@@ -1,4 +1,6 @@
 NETCDF_LIBDIR="${NETCDF_LDFLAGS:--L/usr/local/pub/NetCDF/3.6.2/lib -lnetcdf}"
 NETCDF_INCDIR="${NETCDF_FFLAGS:--I/usr/local/pub/NetCDF/3.6.2/include}"
+NETCDF95_INCDIR=$LMDGCM/../../include
+NETCDF95_LIBDIR=$LMDGCM/../../lib
 IOIPSL_INCDIR=$LMDGCM/../../lib
 IOIPSL_LIBDIR=$LMDGCM/../../lib
Index: LMDZ6/trunk/arch/arch-SX8_BRODIE.path
===================================================================
--- LMDZ6/trunk/arch/arch-SX8_BRODIE.path	(revision 4488)
+++ LMDZ6/trunk/arch/arch-SX8_BRODIE.path	(revision 4489)
@@ -1,4 +1,6 @@
 NETCDF_LIBDIR="-L/SXlocal/pub/netCDF/3.6.1-openmp/lib -lnetcdf"
 NETCDF_INCDIR=-I/SXlocal/pub/netCDF/3.6.1-openmp/include
+NETCDF95_INCDIR=$LMDGCM/../../include
+NETCDF95_LIBDIR=$LMDGCM/../../lib
 IOIPSL_INCDIR=$LMDGCM/../../lib
 IOIPSL_LIBDIR=$LMDGCM/../../lib
Index: LMDZ6/trunk/arch/arch-SX8_MERCURE.path
===================================================================
--- LMDZ6/trunk/arch/arch-SX8_MERCURE.path	(revision 4488)
+++ LMDZ6/trunk/arch/arch-SX8_MERCURE.path	(revision 4489)
@@ -1,4 +1,6 @@
 NETCDF_LIBDIR="-L ${NETCDF_SX_LIBDIR:-/usr/local/SX8/soft/netcdf/lib} -lnetcdf"
 NETCDF_INCDIR=-I${NETCDF_SX_INCLUDEDIR:-/usr/local/SX8/soft/netcdf/include}
+NETCDF95_INCDIR=$LMDGCM/../../include
+NETCDF95_LIBDIR=$LMDGCM/../../lib
 IOIPSL_INCDIR=$LMDGCM/../../lib
 IOIPSL_LIBDIR=$LMDGCM/../../lib
Index: LMDZ6/trunk/arch/arch-SX9_MERCURE.path
===================================================================
--- LMDZ6/trunk/arch/arch-SX9_MERCURE.path	(revision 4488)
+++ LMDZ6/trunk/arch/arch-SX9_MERCURE.path	(revision 4489)
@@ -1,4 +1,6 @@
 NETCDF_LIBDIR="-L${NETCDF_SX_LIBDIR:-/ccc/applications/sx9/netcdf-3.6.1/lib} -lnetcdf"
 NETCDF_INCDIR=-I${NETCDF_SX_INCLUDEDIR:-/ccc/applications/sx9/netcdf-3.6.1/include}
+NETCDF95_INCDIR=$LMDGCM/../../include
+NETCDF95_LIBDIR=$LMDGCM/../../lib
 IOIPSL_INCDIR=$LMDGCM/../../lib
 IOIPSL_LIBDIR=$LMDGCM/../../lib
Index: LMDZ6/trunk/arch/arch-X64_ADA.path
===================================================================
--- LMDZ6/trunk/arch/arch-X64_ADA.path	(revision 4488)
+++ LMDZ6/trunk/arch/arch-X64_ADA.path	(revision 4489)
@@ -1,4 +1,6 @@
 NETCDF_LIBDIR="${NETCDF_LDFLAGS:--L/smplocal/pub/NetCDF/4.1.3/mpi/lib -lnetcdff -lnetcdf -L/smplocal/pub/HDF5/1.8.9/par/lib -Bstatic -lhdf5hl_fortran -lhdf5_hl -lhdf5_fortran -lhdf5 -Bdynamic -lz}"
 NETCDF_INCDIR="${NETCDF_FFLAGS:--I/smplocal/pub/HDF5/1.8.9/par/include -I/smplocal/pub/NetCDF/4.1.3/mpi/include}"
+NETCDF95_INCDIR=$LMDGCM/../../include/NetCDF95
+NETCDF95_LIBDIR=$LMDGCM/../../lib
 IOIPSL_INCDIR="$LMDGCM/../../lib -I$LMDGCM/../IOIPSL/inc"
 IOIPSL_LIBDIR="$LMDGCM/../../lib -lioipsl -L$LMDGCM/../IOIPSL/lib"
Index: LMDZ6/trunk/arch/arch-X64_CURIE.path
===================================================================
--- LMDZ6/trunk/arch/arch-X64_CURIE.path	(revision 4488)
+++ LMDZ6/trunk/arch/arch-X64_CURIE.path	(revision 4489)
@@ -1,4 +1,6 @@
 NETCDF_LIBDIR="-L$NETCDF_LIB_DIR -lnetcdff -lnetcdf"
 NETCDF_INCDIR=-I$NETCDF_INC_DIR
+NETCDF95_INCDIR=$LMDGCM/../../include/NetCDF95
+NETCDF95_LIBDIR=$LMDGCM/../../lib
 IOIPSL_INCDIR=$LMDGCM/../../lib
 IOIPSL_LIBDIR=$LMDGCM/../../lib
Index: LMDZ6/trunk/arch/arch-X64_IRENE-AMD.path
===================================================================
--- LMDZ6/trunk/arch/arch-X64_IRENE-AMD.path	(revision 4488)
+++ LMDZ6/trunk/arch/arch-X64_IRENE-AMD.path	(revision 4489)
@@ -2,4 +2,8 @@
 NETCDF_LIBDIR="-L$NETCDFFORTRAN_LIBDIR -L$NETCDF_LIBDIR"
 NETCDF_LIB="-lnetcdff -lnetcdf"
+
+NETCDF95_INCDIR=-I$LMDGCM/../../include/NetCDF95
+NETCDF95_LIBDIR=-L$LMDGCM/../../lib
+NETCDF95_LIB=-lnetcdf95
 
 IOIPSL_INCDIR="-I$LMDGCM/../../lib -I$LMDGCM/../IOIPSL/inc"
Index: LMDZ6/trunk/arch/arch-X64_IRENE.path
===================================================================
--- LMDZ6/trunk/arch/arch-X64_IRENE.path	(revision 4488)
+++ LMDZ6/trunk/arch/arch-X64_IRENE.path	(revision 4489)
@@ -3,4 +3,8 @@
 NETCDF_LIBDIR="-L$NETCDFFORTRAN_LIBDIR -L$NETCDF_LIBDIR"
 NETCDF_LIB="-lnetcdff -lnetcdf"
+
+NETCDF95_INCDIR=-I$LMDGCM/../../include/NetCDF95
+NETCDF95_LIBDIR=-L$LMDGCM/../../lib
+NETCDF95_LIB=-lnetcdf95
 
 IOIPSL_INCDIR="-I$LMDGCM/../../lib -I$LMDGCM/../IOIPSL/inc"
Index: LMDZ6/trunk/arch/arch-X64_JEANZAY.path
===================================================================
--- LMDZ6/trunk/arch/arch-X64_JEANZAY.path	(revision 4488)
+++ LMDZ6/trunk/arch/arch-X64_JEANZAY.path	(revision 4489)
@@ -5,4 +5,8 @@
 NETCDF_LIBDIR=""
 NETCDF_LIB="-lnetcdff -lnetcdf"
+
+NETCDF95_INCDIR=-I$LMDGCM/../../include/NetCDF95
+NETCDF95_LIBDIR=-L$LMDGCM/../../lib
+NETCDF95_LIB=-lnetcdf95
 
 IOIPSL_INCDIR="-I$LMDGCM/../../lib -I$LMDGCM/../IOIPSL/inc"
Index: LMDZ6/trunk/arch/arch-X64_OCCIGEN.path
===================================================================
--- LMDZ6/trunk/arch/arch-X64_OCCIGEN.path	(revision 4488)
+++ LMDZ6/trunk/arch/arch-X64_OCCIGEN.path	(revision 4489)
@@ -1,4 +1,6 @@
 NETCDF_LIBDIR="-L/opt/software/libraries/netcdf/bullxmpi/netcdf-fortran-4.4.1-4.3.3-rc2/lib -lnetcdff -L/opt/software/libraries/netcdf/bullxmpi/netcdf-4.3.3-rc2/lib -lnetcdf -L/opt/software/libraries/hdf5/hdf5_with_bullxmpi/1.8.14/lib -lhdf5_hl -lhdf5 -lz"
 NETCDF_INCDIR="-I/opt/software/libraries/hdf5/hdf5_with_bullxmpi/1.8.14/include -I/opt/software/libraries/netcdf/bullxmpi/netcdf-fortran-4.4.1-4.3.3-rc2/include"
+NETCDF95_INCDIR=$LMDGCM/../../include/NetCDF95
+NETCDF95_LIBDIR=$LMDGCM/../../lib
 IOIPSL_INCDIR=$LMDGCM/../../lib
 IOIPSL_LIBDIR=$LMDGCM/../../lib
Index: LMDZ6/trunk/arch/arch-X64_TITANE.path
===================================================================
--- LMDZ6/trunk/arch/arch-X64_TITANE.path	(revision 4488)
+++ LMDZ6/trunk/arch/arch-X64_TITANE.path	(revision 4489)
@@ -1,4 +1,6 @@
 NETCDF_LIBDIR="-L$NETCDF_LIB_DIR -lnetcdff -lnetcdf"
 NETCDF_INCDIR=-I$NETCDF_INC_DIR
+NETCDF95_INCDIR=$LMDGCM/../../include
+NETCDF95_LIBDIR=$LMDGCM/../../lib
 IOIPSL_INCDIR=$LMDGCM/../../lib
 IOIPSL_LIBDIR=$LMDGCM/../../lib
Index: LMDZ6/trunk/arch/arch-g95.path
===================================================================
--- LMDZ6/trunk/arch/arch-g95.path	(revision 4488)
+++ LMDZ6/trunk/arch/arch-g95.path	(revision 4489)
@@ -1,4 +1,6 @@
 NETCDF_LIBDIR=...
 NETCDF_INCDIR=...
+NETCDF95_LIBDIR=...
+NETCDF95_INCDIR=...
 IOIPSL_INCDIR=...
 IOIPSL_LIBDIR=...
Index: LMDZ6/trunk/arch/arch-gfortran.path
===================================================================
--- LMDZ6/trunk/arch/arch-gfortran.path	(revision 4488)
+++ LMDZ6/trunk/arch/arch-gfortran.path	(revision 4489)
@@ -2,4 +2,8 @@
 NETCDF_LIBDIR=""
 NETCDF_LIB="-lnetcdff -lnetcdf"
+
+NETCDF95_INCDIR=-I$LMDGCM/../../include/NetCDF95
+NETCDF95_LIBDIR=-L$LMDGCM/../../lib
+NETCDF95_LIB=-lnetcdf95
 
 IOIPSL_INCDIR="-I$LMDGCM/../../lib -I$LMDGCM/../IOIPSL/inc"
Index: LMDZ6/trunk/arch/arch-gfortran_CICLAD.path
===================================================================
--- LMDZ6/trunk/arch/arch-gfortran_CICLAD.path	(revision 4488)
+++ LMDZ6/trunk/arch/arch-gfortran_CICLAD.path	(revision 4489)
@@ -1,4 +1,6 @@
 NETCDF_LIBDIR="-L${NETCDF_HOME}/lib -lnetcdf -lnetcdff"
 NETCDF_INCDIR=-I${NETCDF_HOME}/include
+NETCDF95_INCDIR=$LMDGCM/../../include
+NETCDF95_LIBDIR=$LMDGCM/../../lib
 IOIPSL_INCDIR=$LMDGCM/../../lib
 IOIPSL_LIBDIR=$LMDGCM/../../lib
Index: LMDZ6/trunk/arch/arch-ifort_CICLAD.path
===================================================================
--- LMDZ6/trunk/arch/arch-ifort_CICLAD.path	(revision 4488)
+++ LMDZ6/trunk/arch/arch-ifort_CICLAD.path	(revision 4489)
@@ -1,4 +1,6 @@
 NETCDF_LIBDIR="-L${NETCDF_HOME}/lib -lnetcdf -lnetcdff"
 NETCDF_INCDIR=-I${NETCDF_HOME}/include
+NETCDF95_INCDIR=$LMDGCM/../../include/NetCDF95
+NETCDF95_LIBDIR=$LMDGCM/../../lib
 IOIPSL_INCDIR="$LMDGCM/../../lib -I$LMDGCM/../IOIPSL/inc"
 IOIPSL_LIBDIR="$LMDGCM/../../lib -lioipsl -L$LMDGCM/../IOIPSL/lib" 
Index: LMDZ6/trunk/arch/arch-ifort_LSCE.path
===================================================================
--- LMDZ6/trunk/arch/arch-ifort_LSCE.path	(revision 4488)
+++ LMDZ6/trunk/arch/arch-ifort_LSCE.path	(revision 4489)
@@ -1,4 +1,6 @@
 NETCDF_LIBDIR="-L/usr/local/install/netcdf-4.3.2p/lib -lnetcdff -lnetcdf -L/usr/local/install/hdf5-1.8.9p/lib -lhdf5_hl -lhdf5 -lhdf5 -lz -lcurl"
 NETCDF_INCDIR=-I/usr/local/install/netcdf-4.3.2p/include
+NETCDF95_INCDIR=$LMDGCM/../../include
+NETCDF95_LIBDIR=$LMDGCM/../../lib
 IOIPSL_INCDIR="$LMDGCM/../../lib -I$LMDGCM/../IOIPSL/inc"
 IOIPSL_LIBDIR="$LMDGCM/../../lib -lioipsl -L$LMDGCM/../IOIPSL/lib" 
Index: LMDZ6/trunk/arch/arch-linux-32bit.path
===================================================================
--- LMDZ6/trunk/arch/arch-linux-32bit.path	(revision 4488)
+++ LMDZ6/trunk/arch/arch-linux-32bit.path	(revision 4489)
@@ -1,4 +1,6 @@
 NETCDF_LIBDIR="-L/usr/local/netcdf-pgi/lib -lnetcdf"
 NETCDF_INCDIR=-I/usr/local/netcdf-pgi/include
+NETCDF95_INCDIR=...
+NETCDF95_LIBDIR=...
 IOIPSL_INCDIR=...
 IOIPSL_LIBDIR=...
Index: LMDZ6/trunk/arch/arch-pgf_CICLAD.path
===================================================================
--- LMDZ6/trunk/arch/arch-pgf_CICLAD.path	(revision 4488)
+++ LMDZ6/trunk/arch/arch-pgf_CICLAD.path	(revision 4489)
@@ -1,4 +1,6 @@
 NETCDF_LIBDIR="-L${NETCDF_HOME}/lib -lnetcdf -lnetcdff"
 NETCDF_INCDIR=-I${NETCDF_HOME}/include
+NETCDF95_INCDIR=$LMDGCM/../../include/NetCDF95
+NETCDF95_LIBDIR=$LMDGCM/../../lib
 IOIPSL_INCDIR=$LMDGCM/../../lib
 IOIPSL_LIBDIR=$LMDGCM/../../lib
Index: LMDZ6/trunk/bld.cfg
===================================================================
--- LMDZ6/trunk/bld.cfg	(revision 4488)
+++ LMDZ6/trunk/bld.cfg	(revision 4489)
@@ -100,4 +100,5 @@
 bld::excl_dep        use::ifile_attr
 bld::excl_dep        use::ixml_tree
+bld::excl_dep        use::netcdf95
 # The following for INCA used with CPL
 bld::excl_dep        use::incaoasis
Index: LMDZ6/trunk/libf/misc/handle_err_m.F90
===================================================================
--- LMDZ6/trunk/libf/misc/handle_err_m.F90	(revision 4488)
+++ 	(revision )
@@ -1,47 +1,0 @@
-! $Id$
-module handle_err_m
-
-  implicit none
-
-contains
-
-  subroutine handle_err(message, ncerr, ncid, varid)
-
-    use netcdf, only: nf90_strerror, nf90_noerr, nf90_close
-
-    character(len=*), intent(in):: message
-    ! (should include name of calling procedure)
-
-    integer, intent(in):: ncerr
-
-    integer, intent(in), optional :: ncid
-    ! (Provide this argument if you want "handle_err" to try to close
-    ! the file.)
-
-    integer, intent(in), optional :: varid
-
-    ! Variable local to the procedure:
-    integer ncerr_close
-
-    !-------------------
-
-    if (ncerr /= nf90_noerr) then
-       print *, "NetCDF95 handle_err:"
-       print *, message, ":"
-       if (present(varid)) print *, "varid = ", varid
-       print *, trim(nf90_strerror(ncerr))
-       if (present(ncid)) then
-          ! Try to close, to leave the file in a consistent state:
-          ncerr_close = nf90_close(ncid)
-          ! (do not call "nf95_close", we do not want to recurse)
-          if (ncerr_close /= nf90_noerr) then
-             print *, "nf90_close:"
-             print *, trim(nf90_strerror(ncerr_close))
-          end if
-       end if
-       call abort_physic("NetCDF95 handle_err", "see above", 1)
-    end if
-
-  end subroutine handle_err
-
-end module handle_err_m
Index: LMDZ6/trunk/libf/misc/netcdf95.F90
===================================================================
--- LMDZ6/trunk/libf/misc/netcdf95.F90	(revision 4488)
+++ 	(revision )
@@ -1,17 +1,0 @@
-! $Id$
-module netcdf95
-
-  ! Author: Lionel GUEZ
-  ! See:
-  ! http://www.lmd.jussieu.fr/~lglmd/NetCDF95
-
-  use nf95_def_var_m
-  use nf95_put_var_m
-  use nf95_get_var_m
-  use nf95_gw_var_m
-  use nf95_put_att_m
-  use nf95_get_att_m
-  use simple
-  use handle_err_m
-
-end module netcdf95
Index: LMDZ6/trunk/libf/misc/nf95_def_var_m.F90
===================================================================
--- LMDZ6/trunk/libf/misc/nf95_def_var_m.F90	(revision 4488)
+++ 	(revision )
@@ -1,102 +1,0 @@
-! $Id$
-module nf95_def_var_m
-
-  ! The generic procedure name "nf90_def_var" applies to
-  ! "nf90_def_var_Scalar" but we cannot apply the generic procedure name
-  ! "nf95_def_var" to "nf95_def_var_scalar" because of the additional
-  ! optional argument.
-  ! "nf95_def_var_scalar" cannot be distinguished from "nf95_def_var_oneDim".
-
-  implicit none
-
-  interface nf95_def_var
-    module procedure nf95_def_var_oneDim, nf95_def_var_ManyDims
-  end interface
-
-  private
-  public nf95_def_var, nf95_def_var_scalar
-
-contains
-
-  subroutine nf95_def_var_scalar(ncid, name, xtype, varid, ncerr)
-
-    use netcdf, only: nf90_def_var
-    use handle_err_m, only: handle_err
-
-    integer,               intent( in) :: ncid
-    character (len = *),   intent( in) :: name
-    integer,               intent( in) :: xtype
-    integer,               intent(out) :: varid
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_def_var(ncid, name, xtype, varid)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_def_var_scalar " // name, ncerr_not_opt, ncid)
-    end if
-
-  end subroutine nf95_def_var_scalar
-
-  !***********************
-
-  subroutine nf95_def_var_oneDim(ncid, name, xtype, dimids, varid, ncerr)
-
-    use netcdf, only: nf90_def_var
-    use handle_err_m, only: handle_err
-
-    integer,               intent( in) :: ncid
-    character (len = *),   intent( in) :: name
-    integer,               intent( in) :: xtype
-    integer,               intent( in) :: dimids
-    integer,               intent(out) :: varid
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_def_var(ncid, name, xtype, dimids, varid)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_def_var_oneDim " // name, ncerr_not_opt, ncid)
-    end if
-
-  end subroutine nf95_def_var_oneDim
-
-  !***********************
-
-  subroutine nf95_def_var_ManyDims(ncid, name, xtype, dimids, varid, ncerr)
-
-    use netcdf, only: nf90_def_var
-    use handle_err_m, only: handle_err
-
-    integer,               intent( in) :: ncid
-    character (len = *),   intent( in) :: name
-    integer,               intent( in) :: xtype
-    integer, dimension(:), intent( in) :: dimids
-    integer,               intent(out) :: varid
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_def_var(ncid, name, xtype, dimids, varid)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_def_var_ManyDims " // name, ncerr_not_opt, ncid)
-    end if
-
-  end subroutine nf95_def_var_ManyDims
-
-end module nf95_def_var_m
Index: LMDZ6/trunk/libf/misc/nf95_get_att_m.F90
===================================================================
--- LMDZ6/trunk/libf/misc/nf95_get_att_m.F90	(revision 4488)
+++ 	(revision )
@@ -1,105 +1,0 @@
-! $Id$
-module nf95_get_att_m
-
-  use handle_err_m, only: handle_err
-  use netcdf, only: nf90_get_att, nf90_noerr
-  use simple, only: nf95_inquire_attribute
-
-  implicit none
-
-  interface nf95_get_att
-     module procedure nf95_get_att_text, nf95_get_att_one_FourByteInt
-
-     ! The difference between the specific procedures is the type of
-     ! argument "values".
-  end interface
-
-  private
-  public nf95_get_att
-
-contains
-
-  subroutine nf95_get_att_text(ncid, varid, name, values, ncerr)
-
-    integer,                          intent( in) :: ncid, varid
-    character(len = *),               intent( in) :: name
-    character(len = *),               intent(out) :: values
-    integer, intent(out), optional:: ncerr
-
-    ! Variables local to the procedure:
-    integer ncerr_not_opt
-    integer att_len
-
-    !-------------------
-
-    ! Check that the length of "values" is large enough:
-    call nf95_inquire_attribute(ncid, varid, name, nclen=att_len, &
-         ncerr=ncerr_not_opt)
-    if (ncerr_not_opt == nf90_noerr) then
-       if (len(values) < att_len) then
-          print *, "nf95_get_att_text"
-          print *, "varid = ", varid
-          print *, "attribute name: ", name
-          print *, 'length of "values" is not large enough'
-          print *, "len(values) = ", len(values)
-          print *, "number of characters in attribute: ", att_len
-          stop 1
-       end if
-    end if
-
-    values = "" ! useless in NetCDF version 3.6.2 or better
-    ncerr_not_opt = nf90_get_att(ncid, varid, name, values)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_get_att_text " // trim(name), ncerr_not_opt, &
-            ncid, varid)
-    end if
-
-    if (att_len >= 1 .and. ncerr_not_opt == nf90_noerr) then
-       ! Remove null terminator, if any:
-       if (iachar(values(att_len:att_len)) == 0) values(att_len:att_len) = " "
-    end if
-
-  end subroutine nf95_get_att_text
-
-  !***********************
-
-  subroutine nf95_get_att_one_FourByteInt(ncid, varid, name, values, ncerr)
-
-    integer,                                    intent( in) :: ncid, varid
-    character(len = *),                         intent( in) :: name
-    integer ,               intent(out) :: values
-    integer, intent(out), optional:: ncerr
-
-    ! Variables local to the procedure:
-    integer ncerr_not_opt
-    integer att_len
-
-    !-------------------
-
-    ! Check that the attribute contains a single value:
-    call nf95_inquire_attribute(ncid, varid, name, nclen=att_len, &
-         ncerr=ncerr_not_opt)
-    if (ncerr_not_opt == nf90_noerr) then
-       if (att_len /= 1) then
-          print *, "nf95_get_att_one_FourByteInt"
-          print *, "varid = ", varid
-          print *, "attribute name: ", name
-          print *, 'the attribute does not contain a single value'
-          print *, "number of values in attribute: ", att_len
-          stop 1
-       end if
-    end if
-
-    ncerr_not_opt = nf90_get_att(ncid, varid, name, values)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_get_att_one_FourByteInt " // trim(name), &
-            ncerr_not_opt, ncid, varid)
-    end if
-
-  end subroutine nf95_get_att_one_FourByteInt
-
-end module nf95_get_att_m
Index: LMDZ6/trunk/libf/misc/nf95_get_var_m.F90
===================================================================
--- LMDZ6/trunk/libf/misc/nf95_get_var_m.F90	(revision 4488)
+++ 	(revision )
@@ -1,391 +1,0 @@
-module nf95_get_var_m
-
-  use netcdf, only: nf90_get_var
-  use handle_err_m, only: handle_err
-
-  implicit none
-
-  interface nf95_get_var
-     module procedure nf95_get_var_FourByteReal, nf95_get_var_FourByteInt, &
-          nf95_get_var_1D_FourByteReal, nf95_get_var_1D_FourByteInt, &
-          nf95_get_var_2D_FourByteReal, &
-          nf95_get_var_3D_FourByteInt, &
-          nf95_get_var_3D_FourByteReal, &
-          nf95_get_var_4D_FourByteReal, &
-          nf95_get_var_5D_FourByteReal
-  end interface
-
-  private
-  public nf95_get_var
-
-contains
-
-  subroutine nf95_get_var_FourByteReal(ncid, varid, values, start, ncerr)
-
-    integer, intent(in) :: ncid, varid
-    real, intent(out) :: values
-    integer, dimension(:), optional, intent(in) :: start
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_get_var(ncid, varid, values, start)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_get_var_FourByteReal", ncerr_not_opt, ncid, &
-            varid)
-    end if
-
-  end subroutine nf95_get_var_FourByteReal
-
-  !***********************
-
-  subroutine nf95_get_var_FourByteInt(ncid, varid, values, start, ncerr)
-
-    integer, intent(in) :: ncid, varid
-    integer, intent(out) :: values
-    integer, dimension(:), optional, intent(in) :: start
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_get_var(ncid, varid, values, start)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_get_var_FourByteInt", ncerr_not_opt, ncid, &
-            varid)
-    end if
-
-  end subroutine nf95_get_var_FourByteInt
-
-  !***********************
-
-  subroutine nf95_get_var_1D_FourByteReal(ncid, varid, values, start, &
-       count_nc, stride, map, ncerr)
-
-    integer,                         intent(in) :: ncid, varid
-    real, intent(out) :: values(:)
-    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_get_var(ncid, varid, values, start, count_nc, &
-         stride, map)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_get_var_1D_FourByteReal", ncerr_not_opt, ncid, &
-            varid)
-    end if
-
-  end subroutine nf95_get_var_1D_FourByteReal
-
-  !***********************
-
-  subroutine nf95_get_var_1D_FourByteInt(ncid, varid, values, start, &
-       count_nc, stride, map, ncerr)
-
-    integer,                         intent(in) :: ncid, varid
-    integer, intent(out) :: values(:)
-    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_get_var(ncid, varid, values, start, count_nc, &
-         stride, map)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_get_var_1D_FourByteInt", ncerr_not_opt, ncid, &
-            varid)
-    end if
-
-  end subroutine nf95_get_var_1D_FourByteInt
-
-  !***********************
-
-  subroutine nf95_get_var_1D_EightByteReal(ncid, varid, values, start, &
-       count_nc, stride, map, ncerr)
-
-    use typesizes, only: eightByteReal
-
-    integer,                         intent(in) :: ncid, varid
-    real (kind = EightByteReal),     intent(out) :: values(:)
-    integer, dimension(:), optional, intent(in):: start, count_nc, stride, map
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_get_var(ncid, varid, values, start, count_nc, &
-         stride, map)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_get_var_1D_eightByteReal", ncerr_not_opt, ncid, &
-            varid)
-    end if
-
-  end subroutine nf95_get_var_1D_EightByteReal
-
-  !***********************
-
-  subroutine nf95_get_var_2D_FourByteReal(ncid, varid, values, start, &
-       count_nc, stride, map, ncerr)
-
-    integer,                         intent(in) :: ncid, varid
-    real , intent(out) :: values(:, :)
-    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_get_var(ncid, varid, values, start, count_nc, &
-         stride, map)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_get_var_2D_FourByteReal", ncerr_not_opt, ncid, &
-            varid)
-    end if
-
-  end subroutine nf95_get_var_2D_FourByteReal
-
-  !***********************
-
-  subroutine nf95_get_var_2D_EightByteReal(ncid, varid, values, start, &
-       count_nc, stride, map, ncerr)
-
-    use typesizes, only: EightByteReal
-
-    integer,                         intent(in) :: ncid, varid
-    real (kind = EightByteReal), intent(out) :: values(:, :)
-    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_get_var(ncid, varid, values, start, count_nc, &
-         stride, map)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_get_var_2D_EightByteReal", ncerr_not_opt, ncid, &
-            varid)
-    end if
-
-  end subroutine nf95_get_var_2D_EightByteReal
-
-  !***********************
-
-  subroutine nf95_get_var_3D_FourByteInt(ncid, varid, values, start, &
-       count_nc, stride, map, ncerr)
-
-    integer, intent(in):: ncid, varid
-    integer, intent(out):: values(:, :, :)
-    integer, dimension(:), optional, intent(in):: start, count_nc, stride, map
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_get_var(ncid, varid, values, start, count_nc, &
-         stride, map)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_get_var_3D_FourByteInt", ncerr_not_opt, ncid, &
-            varid)
-    end if
-
-  end subroutine nf95_get_var_3D_FourByteInt
-
-  !***********************
-
-  subroutine nf95_get_var_3D_FourByteReal(ncid, varid, values, start, &
-       count_nc, stride, map, ncerr)
-
-    integer,                         intent(in) :: ncid, varid
-    real , intent(out) :: values(:, :, :)
-    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_get_var(ncid, varid, values, start, count_nc, &
-         stride, map)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_get_var_3D_FourByteReal", ncerr_not_opt, ncid, &
-            varid)
-    end if
-
-  end subroutine nf95_get_var_3D_FourByteReal
-
-  !***********************
-
-  subroutine nf95_get_var_3D_EightByteReal(ncid, varid, values, start, &
-       count_nc, stride, map, ncerr)
-
-    use typesizes, only: eightByteReal
-
-    integer,                         intent(in) :: ncid, varid
-    real (kind = EightByteReal),     intent(out) :: values(:, :, :)
-    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_get_var(ncid, varid, values, start, count_nc, &
-         stride, map)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_get_var_3D_eightByteReal", ncerr_not_opt, ncid, &
-            varid)
-    end if
-
-  end subroutine nf95_get_var_3D_EightByteReal
-
-  !***********************
-
-  subroutine nf95_get_var_4D_FourByteReal(ncid, varid, values, start, &
-       count_nc, stride, map, ncerr)
-
-    integer,                         intent(in) :: ncid, varid
-    real , intent(out) :: values(:, :, :, :)
-    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_get_var(ncid, varid, values, start, count_nc, &
-         stride, map)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_get_var_4D_FourByteReal", ncerr_not_opt, ncid, &
-            varid)
-    end if
-
-  end subroutine nf95_get_var_4D_FourByteReal
-
-  !***********************
-
-  subroutine nf95_get_var_4D_EightByteReal(ncid, varid, values, start, &
-       count_nc, stride, map, ncerr)
-
-    use typesizes, only: EightByteReal
-
-    integer, intent(in):: ncid, varid
-    real(kind = EightByteReal), intent(out):: values(:, :, :, :)
-    integer, dimension(:), optional, intent(in):: start, count_nc, stride, map
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_get_var(ncid, varid, values, start, count_nc, &
-         stride, map)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_get_var_4D_EightByteReal", ncerr_not_opt, ncid, &
-            varid)
-    end if
-
-  end subroutine nf95_get_var_4D_EightByteReal
-
-  !***********************
-
-  subroutine nf95_get_var_5D_FourByteReal(ncid, varid, values, start, &
-       count_nc, stride, map, ncerr)
-
-    integer, intent(in):: ncid, varid
-    real, intent(out):: values(:, :, :, :, :)
-    integer, dimension(:), optional, intent(in):: start, count_nc, stride, map
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_get_var(ncid, varid, values, start, count_nc, &
-         stride, map)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_get_var_5D_FourByteReal", ncerr_not_opt, ncid, &
-            varid)
-    end if
-
-  end subroutine nf95_get_var_5D_FourByteReal
-
-  !***********************
-
-  subroutine nf95_get_var_5D_EightByteReal(ncid, varid, values, start, &
-       count_nc, stride, map, ncerr)
-
-    use typesizes, only: EightByteReal
-
-    integer, intent(in):: ncid, varid
-    real(kind = EightByteReal), intent(out):: values(:, :, :, :, :)
-    integer, dimension(:), optional, intent(in):: start, count_nc, stride, map
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_get_var(ncid, varid, values, start, count_nc, &
-         stride, map)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_get_var_5D_EightByteReal", ncerr_not_opt, ncid, &
-            varid)
-    end if
-
-  end subroutine nf95_get_var_5D_EightByteReal
-
-end module nf95_get_var_m
Index: LMDZ6/trunk/libf/misc/nf95_gw_var_m.F90
===================================================================
--- LMDZ6/trunk/libf/misc/nf95_gw_var_m.F90	(revision 4488)
+++ 	(revision )
@@ -1,336 +1,0 @@
-! $Id$
-module nf95_gw_var_m
-
-  use nf95_get_var_m, only: NF95_GET_VAR
-  use simple, only: nf95_inquire_variable, nf95_inquire_dimension
-
-  implicit none
-
-  interface nf95_gw_var
-     ! "nf95_gw_var" stands for "NetCDF 1995 get whole variable".
-     ! These procedures read a whole NetCDF variable (coordinate or
-     ! primary) into an array.
-     ! The difference between the procedures is the rank and type of
-     ! argument "values".
-     ! The procedures do not check the type of the NetCDF variable.
-
-     ! Not including double precision procedures in the generic
-     ! interface because we use a compilation option that changes default
-     ! real precision.
-     module procedure nf95_gw_var_real_1d, nf95_gw_var_real_2d, &
-          nf95_gw_var_real_3d, nf95_gw_var_real_4d, nf95_gw_var_real_5d, &
-          nf95_gw_var_int_1d, nf95_gw_var_int_3d
-  end interface
-
-  private
-  public nf95_gw_var
-
-contains
-
-  subroutine nf95_gw_var_real_1d(ncid, varid, values)
-
-    ! Real type, the array has rank 1.
-
-    integer, intent(in):: ncid
-    integer, intent(in):: varid
-    real, pointer:: values(:)
-
-    ! Variables local to the procedure:
-    integer nclen
-    integer, pointer:: dimids(:)
-
-    !---------------------
-
-    call nf95_inquire_variable(ncid, varid, dimids=dimids)
-
-    if (size(dimids) /= 1) then
-       print *, "nf95_gw_var_real_1d:"
-       print *, "varid = ", varid
-       print *, "rank of NetCDF variable is ", size(dimids), ", not 1"
-       stop 1
-    end if
-
-    call nf95_inquire_dimension(ncid, dimids(1), nclen=nclen)
-    deallocate(dimids) ! pointer
-
-    allocate(values(nclen))
-    if (nclen /= 0) call NF95_GET_VAR(ncid, varid, values)
-
-  end subroutine nf95_gw_var_real_1d
-
-  !************************************
-
-  subroutine nf95_gw_var_real_2d(ncid, varid, values)
-
-    ! Real type, the array has rank 2.
-
-    integer, intent(in):: ncid
-    integer, intent(in):: varid
-    real, pointer:: values(:, :)
-
-    ! Variables local to the procedure:
-    integer nclen1, nclen2
-    integer, pointer:: dimids(:)
-
-    !---------------------
-
-    call nf95_inquire_variable(ncid, varid, dimids=dimids)
-
-    if (size(dimids) /= 2) then
-       print *, "nf95_gw_var_real_2d:"
-       print *, "varid = ", varid
-       print *, "rank of NetCDF variable is ", size(dimids), ", not 2"
-       stop 1
-    end if
-
-    call nf95_inquire_dimension(ncid, dimids(1), nclen=nclen1)
-    call nf95_inquire_dimension(ncid, dimids(2), nclen=nclen2)
-    deallocate(dimids) ! pointer
-
-    allocate(values(nclen1, nclen2))
-    if (nclen1 /= 0 .and. nclen2 /= 0) call NF95_GET_VAR(ncid, varid, values)
-
-  end subroutine nf95_gw_var_real_2d
-
-  !************************************
-
-  subroutine nf95_gw_var_real_3d(ncid, varid, values)
-
-    ! Real type, the array has rank 3.
-
-    integer, intent(in):: ncid
-    integer, intent(in):: varid
-    real, pointer:: values(:, :, :)
-
-    ! Variables local to the procedure:
-    integer nclen1, nclen2, nclen3
-    integer, pointer:: dimids(:)
-
-    !---------------------
-
-    call nf95_inquire_variable(ncid, varid, dimids=dimids)
-
-    if (size(dimids) /= 3) then
-       print *, "nf95_gw_var_real_3d:"
-       print *, "varid = ", varid
-       print *, "rank of NetCDF variable is ", size(dimids), ", not 3"
-       stop 1
-    end if
-
-    call nf95_inquire_dimension(ncid, dimids(1), nclen=nclen1)
-    call nf95_inquire_dimension(ncid, dimids(2), nclen=nclen2)
-    call nf95_inquire_dimension(ncid, dimids(3), nclen=nclen3)
-    deallocate(dimids) ! pointer
-
-    allocate(values(nclen1, nclen2, nclen3))
-    if (nclen1 * nclen2 * nclen3 /= 0) call NF95_GET_VAR(ncid, varid, values)
-
-  end subroutine nf95_gw_var_real_3d
-
-  !************************************
-
-  subroutine nf95_gw_var_real_4d(ncid, varid, values)
-
-    ! Real type, the array has rank 4.
-
-    integer, intent(in):: ncid
-    integer, intent(in):: varid
-    real, pointer:: values(:, :, :, :)
-
-    ! Variables local to the procedure:
-    integer len_dim(4), i
-    integer, pointer:: dimids(:)
-
-    !---------------------
-
-    call nf95_inquire_variable(ncid, varid, dimids=dimids)
-
-    if (size(dimids) /= 4) then
-       print *, "nf95_gw_var_real_4d:"
-       print *, "varid = ", varid
-       print *, "rank of NetCDF variable is ", size(dimids), ", not 4"
-       stop 1
-    end if
-
-    do i = 1, 4
-       call nf95_inquire_dimension(ncid, dimids(i), nclen=len_dim(i))
-    end do
-    deallocate(dimids) ! pointer
-
-    allocate(values(len_dim(1), len_dim(2), len_dim(3), len_dim(4)))
-    if (all(len_dim /= 0)) call NF95_GET_VAR(ncid, varid, values)
-
-  end subroutine nf95_gw_var_real_4d
-
-  !************************************
-
-  subroutine nf95_gw_var_real_5d(ncid, varid, values)
-
-    ! Real type, the array has rank 5.
-
-    integer, intent(in):: ncid
-    integer, intent(in):: varid
-    real, pointer:: values(:, :, :, :, :)
-
-    ! Variables local to the procedure:
-    integer len_dim(5), i
-    integer, pointer:: dimids(:)
-
-    !---------------------
-
-    call nf95_inquire_variable(ncid, varid, dimids=dimids)
-
-    if (size(dimids) /= 5) then
-       print *, "nf95_gw_var_real_5d:"
-       print *, "varid = ", varid
-       print *, "rank of NetCDF variable is ", size(dimids), ", not 5"
-       stop 1
-    end if
-
-    do i = 1, 5
-       call nf95_inquire_dimension(ncid, dimids(i), nclen=len_dim(i))
-    end do
-    deallocate(dimids) ! pointer
-
-    allocate(values(len_dim(1), len_dim(2), len_dim(3), len_dim(4), len_dim(5)))
-    if (all(len_dim /= 0)) call NF95_GET_VAR(ncid, varid, values)
-
-  end subroutine nf95_gw_var_real_5d
-
-  !************************************
-
-!!$  subroutine nf95_gw_var_dble_1d(ncid, varid, values)
-!!$
-!!$    ! Double precision, the array has rank 1.
-!!$
-!!$    integer, intent(in):: ncid
-!!$    integer, intent(in):: varid
-!!$    double precision, pointer:: values(:)
-!!$
-!!$    ! Variables local to the procedure:
-!!$    integer nclen
-!!$    integer, pointer:: dimids(:)
-!!$
-!!$    !---------------------
-!!$
-!!$    call nf95_inquire_variable(ncid, varid, dimids=dimids)
-!!$
-!!$    if (size(dimids) /= 1) then
-!!$       print *, "nf95_gw_var_dble_1d:"
-!!$       print *, "varid = ", varid
-!!$       print *, "rank of NetCDF variable is ", size(dimids), ", not 1"
-!!$        stop 1
-!!$    end if
-!!$
-!!$    call nf95_inquire_dimension(ncid, dimids(1), nclen=nclen)
-!!$    deallocate(dimids) ! pointer
-!!$
-!!$    allocate(values(nclen))
-!!$    if (nclen /= 0) call NF95_GET_VAR(ncid, varid, values)
-!!$
-!!$  end subroutine nf95_gw_var_dble_1d
-!!$
-!!$  !************************************
-!!$
-!!$  subroutine nf95_gw_var_dble_3d(ncid, varid, values)
-!!$
-!!$    ! Double precision, the array has rank 3.
-!!$
-!!$    integer, intent(in):: ncid
-!!$    integer, intent(in):: varid
-!!$    double precision, pointer:: values(:, :, :)
-!!$
-!!$    ! Variables local to the procedure:
-!!$    integer nclen1, nclen2, nclen3
-!!$    integer, pointer:: dimids(:)
-!!$
-!!$    !---------------------
-!!$
-!!$    call nf95_inquire_variable(ncid, varid, dimids=dimids)
-!!$
-!!$    if (size(dimids) /= 3) then
-!!$       print *, "nf95_gw_var_dble_3d:"
-!!$       print *, "varid = ", varid
-!!$       print *, "rank of NetCDF variable is ", size(dimids), ", not 3"
-!!$       stop 1
-!!$    end if
-!!$
-!!$    call nf95_inquire_dimension(ncid, dimids(1), nclen=nclen1)
-!!$    call nf95_inquire_dimension(ncid, dimids(2), nclen=nclen2)
-!!$    call nf95_inquire_dimension(ncid, dimids(3), nclen=nclen3)
-!!$    deallocate(dimids) ! pointer
-!!$
-!!$    allocate(values(nclen1, nclen2, nclen3))
-!!$    if (nclen1 * nclen2 * nclen3 /= 0) call NF95_GET_VAR(ncid, varid, values)
-!!$
-!!$  end subroutine nf95_gw_var_dble_3d
-!!$
-  !************************************
-
-  subroutine nf95_gw_var_int_1d(ncid, varid, values)
-
-    ! Integer type, the array has rank 1.
-
-    integer, intent(in):: ncid
-    integer, intent(in):: varid
-    integer, pointer:: values(:)
-
-    ! Variables local to the procedure:
-    integer nclen
-    integer, pointer:: dimids(:)
-
-    !---------------------
-
-    call nf95_inquire_variable(ncid, varid, dimids=dimids)
-
-    if (size(dimids) /= 1) then
-       print *, "nf95_gw_var_int_1d:"
-       print *, "varid = ", varid
-       print *, "rank of NetCDF variable is ", size(dimids), ", not 1"
-       stop 1
-    end if
-
-    call nf95_inquire_dimension(ncid, dimids(1), nclen=nclen)
-    deallocate(dimids) ! pointer
-
-    allocate(values(nclen))
-    if (nclen /= 0) call NF95_GET_VAR(ncid, varid, values)
-
-  end subroutine nf95_gw_var_int_1d
-
-  !************************************
-
-  subroutine nf95_gw_var_int_3d(ncid, varid, values)
-
-    ! Integer type, the array has rank 3.
-
-    integer, intent(in):: ncid
-    integer, intent(in):: varid
-    integer, pointer:: values(:, :, :)
-
-    ! Variables local to the procedure:
-    integer nclen1, nclen2, nclen3
-    integer, pointer:: dimids(:)
-
-    !---------------------
-
-    call nf95_inquire_variable(ncid, varid, dimids=dimids)
-
-    if (size(dimids) /= 3) then
-       print *, "nf95_gw_var_int_3d:"
-       print *, "varid = ", varid
-       print *, "rank of NetCDF variable is ", size(dimids), ", not 3"
-       stop 1
-    end if
-
-    call nf95_inquire_dimension(ncid, dimids(1), nclen=nclen1)
-    call nf95_inquire_dimension(ncid, dimids(2), nclen=nclen2)
-    call nf95_inquire_dimension(ncid, dimids(3), nclen=nclen3)
-    deallocate(dimids) ! pointer
-
-    allocate(values(nclen1, nclen2, nclen3))
-    if (nclen1 * nclen2 * nclen3 /= 0) call NF95_GET_VAR(ncid, varid, values)
-
-  end subroutine nf95_gw_var_int_3d
-
-end module nf95_gw_var_m
Index: LMDZ6/trunk/libf/misc/nf95_put_att_m.F90
===================================================================
--- LMDZ6/trunk/libf/misc/nf95_put_att_m.F90	(revision 4488)
+++ 	(revision )
@@ -1,67 +1,0 @@
-! $Id$
-module nf95_put_att_m
-
-  implicit none
-
-  interface nf95_put_att
-     module procedure nf95_put_att_text, nf95_put_att_one_FourByteInt
-  end interface
-
-  private
-  public nf95_put_att
-
-contains
-
-  subroutine nf95_put_att_text(ncid, varid, name, values, ncerr)
-
-    use netcdf, only: nf90_put_att
-    use handle_err_m, only: handle_err
-
-    integer, intent(in) :: ncid, varid
-    character(len = *), intent(in) :: name
-    character(len = *), intent(in) :: values
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_put_att(ncid, varid, name, values)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_put_att_text", ncerr_not_opt, ncid, varid)
-    end if
-
-  end subroutine nf95_put_att_text
-
-  !************************************
-
-  subroutine nf95_put_att_one_FourByteInt(ncid, varid, name, values, ncerr)
-
-    use netcdf, only: nf90_put_att
-    use handle_err_m, only: handle_err
-    use typesizes, only: FourByteInt
-
-    integer, intent(in) :: ncid, varid
-    character(len = *), intent(in) :: name
-    integer(kind = FourByteInt), intent(in) :: values
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_put_att(ncid, varid, name, values)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_put_att_one_FourByteInt", ncerr_not_opt, ncid, &
-            varid)
-    end if
-
-  end subroutine nf95_put_att_one_FourByteInt
-
-end module nf95_put_att_m
Index: LMDZ6/trunk/libf/misc/nf95_put_var_m.F90
===================================================================
--- LMDZ6/trunk/libf/misc/nf95_put_var_m.F90	(revision 4488)
+++ 	(revision )
@@ -1,335 +1,0 @@
-! $Id$
-module nf95_put_var_m
-
-  implicit none
-
-  interface nf95_put_var
-     module procedure nf95_put_var_FourByteReal, nf95_put_var_FourByteInt, &
-          nf95_put_var_1D_FourByteReal, nf95_put_var_1D_FourByteInt, &
-          nf95_put_var_2D_FourByteReal, nf95_put_var_3D_FourByteReal, &
-          nf95_put_var_4D_FourByteReal
-  end interface
-
-  private
-  public nf95_put_var
-
-contains
-
-  subroutine nf95_put_var_FourByteReal(ncid, varid, values, start, ncerr)
-
-    use netcdf, only: nf90_put_var
-    use handle_err_m, only: handle_err
-
-    integer, intent(in) :: ncid, varid
-    real, intent(in) :: values
-    integer, dimension(:), optional, intent(in) :: start
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_put_var(ncid, varid, values, start)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_put_var_FourByteReal", ncerr_not_opt, ncid, &
-            varid)
-    end if
-
-  end subroutine nf95_put_var_FourByteReal
-
-  !***********************
-
-  subroutine nf95_put_var_FourByteInt(ncid, varid, values, start, ncerr)
-
-    use netcdf, only: nf90_put_var
-    use handle_err_m, only: handle_err
-
-    integer, intent(in) :: ncid, varid
-    integer, intent(in) :: values
-    integer, dimension(:), optional, intent(in) :: start
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_put_var(ncid, varid, values, start)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_put_var_FourByteInt", ncerr_not_opt, ncid, &
-            varid)
-    end if
-
-  end subroutine nf95_put_var_FourByteInt
-
-  !***********************
-
-  subroutine nf95_put_var_1D_FourByteReal(ncid, varid, values, start, &
-       count_nc, stride, map, ncerr)
-
-    use netcdf, only: nf90_put_var
-    use handle_err_m, only: handle_err
-
-    integer,                         intent(in) :: ncid, varid
-    real, intent(in) :: values(:)
-    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count_nc, &
-         stride, map)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_put_var_1D_FourByteReal", ncerr_not_opt, ncid, &
-            varid)
-    end if
-
-  end subroutine nf95_put_var_1D_FourByteReal
-
-  !***********************
-
-  subroutine nf95_put_var_1D_FourByteInt(ncid, varid, values, start, &
-       count_nc, stride, map, ncerr)
-
-    use netcdf, only: nf90_put_var
-    use handle_err_m, only: handle_err
-
-    integer,                         intent(in) :: ncid, varid
-    integer, intent(in) :: values(:)
-    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count_nc, &
-         stride, map)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_put_var_1D_FourByteInt", ncerr_not_opt, ncid, &
-            varid)
-    end if
-
-  end subroutine nf95_put_var_1D_FourByteInt
-
-  !***********************
-
-  subroutine nf95_put_var_1D_EightByteReal(ncid, varid, values, start, &
-       count_nc, stride, map, ncerr)
-
-    use typesizes, only: eightByteReal
-    use netcdf, only: nf90_put_var
-    use handle_err_m, only: handle_err
-
-    integer,                         intent(in) :: ncid, varid
-    real (kind = EightByteReal),     intent(in) :: values(:)
-    integer, dimension(:), optional, intent(in):: start, count_nc, stride, map
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count_nc, &
-         stride, map)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_put_var_1D_eightByteReal", ncerr_not_opt, ncid, &
-            varid)
-    end if
-
-  end subroutine nf95_put_var_1D_EightByteReal
-
-  !***********************
-
-  subroutine nf95_put_var_2D_FourByteReal(ncid, varid, values, start, &
-       count_nc, stride, map, ncerr)
-
-    use netcdf, only: nf90_put_var
-    use handle_err_m, only: handle_err
-
-    integer,                         intent(in) :: ncid, varid
-    real, intent(in) :: values(:, :)
-    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count_nc, &
-         stride, map)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_put_var_2D_FourByteReal", ncerr_not_opt, ncid, &
-            varid)
-    end if
-
-  end subroutine nf95_put_var_2D_FourByteReal
-
-  !***********************
-
-  subroutine nf95_put_var_2D_EightByteReal(ncid, varid, values, start, &
-       count_nc, stride, map, ncerr)
-
-    use typesizes, only: EightByteReal
-    use netcdf, only: nf90_put_var
-    use handle_err_m, only: handle_err
-
-    integer,                         intent(in) :: ncid, varid
-    real (kind = EightByteReal), intent(in) :: values(:, :)
-    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count_nc, &
-         stride, map)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_put_var_2D_EightByteReal", ncerr_not_opt, ncid, &
-            varid)
-    end if
-
-  end subroutine nf95_put_var_2D_EightByteReal
-
-  !***********************
-
-  subroutine nf95_put_var_3D_FourByteReal(ncid, varid, values, start, &
-       count_nc, stride, map, ncerr)
-
-    use netcdf, only: nf90_put_var
-    use handle_err_m, only: handle_err
-
-    integer,                         intent(in) :: ncid, varid
-    real, intent(in) :: values(:, :, :)
-    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count_nc, &
-         stride, map)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_put_var_3D_FourByteReal", ncerr_not_opt, ncid, &
-            varid)
-    end if
-
-  end subroutine nf95_put_var_3D_FourByteReal
-
-  !***********************
-
-  subroutine nf95_put_var_3D_EightByteReal(ncid, varid, values, start, &
-       count_nc, stride, map, ncerr)
-
-    use typesizes, only: eightByteReal
-    use netcdf, only: nf90_put_var
-    use handle_err_m, only: handle_err
-
-    integer,                         intent(in) :: ncid, varid
-    real (kind = EightByteReal),     intent(in) :: values(:, :, :)
-    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count_nc, &
-         stride, map)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_put_var_3D_eightByteReal", ncerr_not_opt, ncid, &
-            varid)
-    end if
-
-  end subroutine nf95_put_var_3D_EightByteReal
-
-  !***********************
-
-  subroutine nf95_put_var_4D_FourByteReal(ncid, varid, values, start, &
-       count_nc, stride, map, ncerr)
-
-    use netcdf, only: nf90_put_var
-    use handle_err_m, only: handle_err
-
-    integer,                         intent(in) :: ncid, varid
-    real, intent(in) :: values(:, :, :, :)
-    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count_nc, &
-         stride, map)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_put_var_4D_FourByteReal", ncerr_not_opt, ncid, &
-            varid)
-    end if
-
-  end subroutine nf95_put_var_4D_FourByteReal
-
-  !***********************
-
-  subroutine nf95_put_var_4D_EightByteReal(ncid, varid, values, start, &
-       count_nc, stride, map, ncerr)
-
-    use typesizes, only: EightByteReal
-    use netcdf, only: nf90_put_var
-    use handle_err_m, only: handle_err
-
-    integer, intent(in):: ncid, varid
-    real(kind = EightByteReal), intent(in):: values(:, :, :, :)
-    integer, dimension(:), optional, intent(in):: start, count_nc, stride, map
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count_nc, &
-         stride, map)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_put_var_4D_EightByteReal", ncerr_not_opt, ncid, &
-            varid)
-    end if
-
-  end subroutine nf95_put_var_4D_EightByteReal
-
-end module nf95_put_var_m
Index: LMDZ6/trunk/libf/misc/simple.F90
===================================================================
--- LMDZ6/trunk/libf/misc/simple.F90	(revision 4488)
+++ 	(revision )
@@ -1,361 +1,0 @@
-! $Id$
-module simple
-
-  use handle_err_m, only: handle_err
-  
-  implicit none
-
-  private handle_err
-
-contains
-
-  subroutine nf95_open(path, mode, ncid, chunksize, ncerr)
-
-    use netcdf, only: nf90_open
-
-    character(len=*), intent(in):: path
-    integer, intent(in):: mode
-    integer, intent(out):: ncid
-    integer, intent(inout), optional:: chunksize
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_open(path, mode, ncid, chunksize)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_open " // path, ncerr_not_opt)
-    end if
-
-  end subroutine nf95_open
-
-  !************************
-
-  subroutine nf95_inq_dimid(ncid, name, dimid, ncerr)
-
-    use netcdf, only: nf90_inq_dimid
-
-    integer,             intent(in) :: ncid
-    character (len = *), intent(in) :: name
-    integer,             intent(out) :: dimid
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_inq_dimid(ncid, name, dimid)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_inq_dimid " // name, ncerr_not_opt, ncid)
-    end if
-
-  end subroutine nf95_inq_dimid
-
-  !************************
-
-  subroutine nf95_inquire_dimension(ncid, dimid, name, nclen, ncerr)
-
-    use netcdf, only: nf90_inquire_dimension
-
-    integer,                       intent( in) :: ncid, dimid
-    character (len = *), optional, intent(out) :: name
-    integer,             optional, intent(out) :: nclen
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_inquire_dimension(ncid, dimid, name, nclen)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_inquire_dimension", ncerr_not_opt, ncid)
-    end if
-
-  end subroutine nf95_inquire_dimension
-
-  !************************
-
-  subroutine nf95_inq_varid(ncid, name, varid, ncerr)
-
-    use netcdf, only: nf90_inq_varid
-
-    integer,             intent(in) :: ncid
-    character(len=*), intent(in):: name
-    integer,             intent(out) :: varid
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_inq_varid(ncid, name, varid)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_inq_varid, name = " // name, ncerr_not_opt, ncid)
-    end if
-
-  end subroutine nf95_inq_varid
-
-  !************************
-
-  subroutine nf95_inquire_variable(ncid, varid, name, xtype, ndims, dimids, &
-       nAtts, ncerr)
-
-    ! In "nf90_inquire_variable", "dimids" is an assumed-size array.
-    ! This is not optimal.
-    ! We are in the classical case of an array the size of which is
-    ! unknown in the calling procedure, before the call.
-    ! Here we use a better solution: a pointer argument array.
-    ! This procedure associates and defines "dimids" if it is present.
-
-    use netcdf, only: nf90_inquire_variable, nf90_max_var_dims
-
-    integer, intent(in):: ncid, varid
-    character(len = *), optional, intent(out):: name
-    integer, optional, intent(out) :: xtype, ndims
-    integer, dimension(:), optional, pointer :: dimids
-    integer, optional, intent(out) :: nAtts
-    integer, intent(out), optional :: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-    integer dimids_local(nf90_max_var_dims)
-    integer ndims_not_opt
-
-    !-------------------
-
-    if (present(dimids)) then
-       ncerr_not_opt = nf90_inquire_variable(ncid, varid, name, xtype, &
-            ndims_not_opt, dimids_local, nAtts)
-       allocate(dimids(ndims_not_opt)) ! also works if ndims_not_opt == 0
-       dimids = dimids_local(:ndims_not_opt)
-       if (present(ndims)) ndims = ndims_not_opt
-    else
-       ncerr_not_opt = nf90_inquire_variable(ncid, varid, name, xtype, ndims, &
-            nAtts=nAtts)
-    end if
-
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_inquire_variable", ncerr_not_opt, ncid, varid)
-    end if
-
-  end subroutine nf95_inquire_variable
-
-  !************************
-
-  subroutine nf95_create(path, cmode, ncid, initialsize, chunksize, ncerr)
-    
-    use netcdf, only: nf90_create
-
-    character (len = *), intent(in   ) :: path
-    integer,             intent(in   ) :: cmode
-    integer,             intent(  out) :: ncid
-    integer, optional,   intent(in   ) :: initialsize
-    integer, optional,   intent(inout) :: chunksize
-    integer, intent(out), optional :: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_create(path, cmode, ncid, initialsize, chunksize)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_create " // path, ncerr_not_opt)
-    end if
-
-  end subroutine nf95_create
-
-  !************************
-
-  subroutine nf95_def_dim(ncid, name, nclen, dimid, ncerr)
-
-    use netcdf, only: nf90_def_dim
-
-    integer,             intent( in) :: ncid
-    character (len = *), intent( in) :: name
-    integer,             intent( in) :: nclen
-    integer,             intent(out) :: dimid
-    integer, intent(out), optional :: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_def_dim(ncid, name, nclen, dimid)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_def_dim " // name, ncerr_not_opt, ncid)
-    end if
-
-  end subroutine nf95_def_dim
-
-  !***********************
-
-  subroutine nf95_redef(ncid, ncerr)
-
-    use netcdf, only: nf90_redef
-
-    integer, intent( in) :: ncid
-    integer, intent(out), optional :: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_redef(ncid)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_redef", ncerr_not_opt, ncid)
-    end if
-
-  end subroutine nf95_redef
-  
-  !***********************
-
-  subroutine nf95_enddef(ncid, h_minfree, v_align, v_minfree, r_align, ncerr)
-
-    use netcdf, only: nf90_enddef
-
-    integer,           intent( in) :: ncid
-    integer, optional, intent( in) :: h_minfree, v_align, v_minfree, r_align
-    integer, intent(out), optional :: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_enddef(ncid, h_minfree, v_align, v_minfree, r_align)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_enddef", ncerr_not_opt, ncid)
-    end if
-
-  end subroutine nf95_enddef
-
-  !***********************
-
-  subroutine nf95_close(ncid, ncerr)
-
-    use netcdf, only: nf90_close
-
-    integer, intent( in) :: ncid
-    integer, intent(out), optional :: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_close(ncid)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_close", ncerr_not_opt)
-    end if
-
-  end subroutine nf95_close
-
-  !***********************
-
-  subroutine nf95_copy_att(ncid_in, varid_in, name, ncid_out, varid_out, ncerr)
-
-    use netcdf, only: nf90_copy_att
-
-    integer, intent( in):: ncid_in,  varid_in
-    character(len=*), intent( in):: name
-    integer, intent( in):: ncid_out, varid_out
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_copy_att(ncid_in, varid_in, name, ncid_out, varid_out)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_copy_att " // name, ncerr_not_opt, ncid_out)
-    end if
-
-  end subroutine nf95_copy_att
-
-  !***********************
-
-  subroutine nf95_inquire_attribute(ncid, varid, name, xtype, nclen, attnum, &
-       ncerr)
-
-    use netcdf, only: nf90_inquire_attribute
-
-    integer,             intent( in)           :: ncid, varid
-    character (len = *), intent( in)           :: name
-    integer,             intent(out), optional :: xtype, nclen, attnum
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_inquire_attribute(ncid, varid, name, xtype, nclen, &
-         attnum)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_inquire_attribute " // name, ncerr_not_opt, &
-            ncid, varid)
-    end if
-
-  end subroutine nf95_inquire_attribute
-
-  !***********************
-
-  subroutine nf95_inquire(ncid, nDimensions, nVariables, nAttributes, &
-       unlimitedDimId, formatNum, ncerr)
-
-    use netcdf, only: nf90_inquire
-
-    integer,           intent( in) :: ncid
-    integer, optional, intent(out) :: nDimensions, nVariables, nAttributes
-    integer, optional, intent(out) :: unlimitedDimId, formatNum
-    integer, intent(out), optional:: ncerr
-
-    ! Variable local to the procedure:
-    integer ncerr_not_opt
-
-    !-------------------
-
-    ncerr_not_opt = nf90_inquire(ncid, nDimensions, nVariables, nAttributes, &
-         unlimitedDimId, formatNum)
-    if (present(ncerr)) then
-       ncerr = ncerr_not_opt
-    else
-       call handle_err("nf95_inquire", ncerr_not_opt, ncid)
-    end if
-
-  end subroutine nf95_inquire
-
-end module simple
Index: LMDZ6/trunk/libf/phylmd/ecrad/easy_netcdf.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/easy_netcdf.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/easy_netcdf.F90	(revision 4489)
@@ -35,5 +35,5 @@
   ! a NetCDF file
   type netcdf_file
-    integer :: ncid             ! NetCDF file ID
+    integer :: ncid = -1! NetCDF file ID
     integer :: iverbose ! Verbosity: 0 = report only fatal errors,
                         !            1 = ...and warnings,
@@ -55,7 +55,9 @@
     procedure :: create => create_netcdf_file
     procedure :: close => close_netcdf_file
+    procedure :: is_open
     procedure :: get_real_scalar
+    procedure :: get_int_scalar
     procedure :: get_real_vector
-    procedure :: get_integer_vector
+    procedure :: get_int_vector
     procedure :: get_real_matrix
     procedure :: get_real_array3
@@ -65,9 +67,13 @@
     procedure :: get_real_array3_indexed
     procedure :: get_real_array4
-    generic   :: get => get_real_scalar, get_real_vector, &
+    procedure :: get_char_vector
+    procedure :: get_char_matrix
+    generic   :: get => get_real_scalar, get_int_scalar, &
+         &              get_real_vector, get_int_vector, &
          &              get_real_matrix, get_real_array3, &
-         &              get_real_array4, get_integer_vector, &
+         &              get_real_array4, &
          &              get_real_scalar_indexed, get_real_vector_indexed, &
-         &              get_real_matrix_indexed, get_real_array3_indexed
+         &              get_real_matrix_indexed, get_real_array3_indexed, &
+         &              get_char_vector, get_char_matrix
     procedure :: get_real_scalar_attribute
     procedure :: get_string_attribute
@@ -83,4 +89,5 @@
     procedure :: put_real_scalar
     procedure :: put_real_vector
+    procedure :: put_int_vector
     procedure :: put_real_matrix
     procedure :: put_real_array3
@@ -91,5 +98,5 @@
          &              put_real_matrix, put_real_array3, &
          &              put_real_scalar_indexed, put_real_vector_indexed, &
-         &              put_real_matrix_indexed
+         &              put_real_matrix_indexed, put_int_vector
     procedure :: set_verbose
     procedure :: transpose_matrices
@@ -101,4 +108,9 @@
     procedure :: attribute_exists
     procedure :: global_attribute_exists
+#ifdef NC_NETCDF4
+    procedure :: copy_dimensions
+#endif
+    procedure :: copy_variable_definition
+    procedure :: copy_variable
     procedure, private :: get_array_dimensions
     procedure, private :: get_variable_id
@@ -257,4 +269,6 @@
     end if
 
+    this%ncid = -1
+
   end subroutine close_netcdf_file
 
@@ -367,8 +381,8 @@
 
     integer                        :: j, istatus
-    integer                        :: dimids(NF90_MAX_VAR_DIMS)
+    integer                        :: idimids(NF90_MAX_VAR_DIMS)
 
     istatus = nf90_inquire_variable(this%ncid, ivarid, &
-         &                          ndims=ndims, dimids=dimids)
+         &                          ndims=ndims, dimids=idimids)
     if (istatus /= NF90_NOERR) then
       write(nulerr,'(a,i0,a,a)') '*** Error inquiring about NetCDF variable with id ', &
@@ -379,5 +393,5 @@
     ndimlens(:) = 0
     do j = 1,ndims
-      istatus = nf90_inquire_dimension(this%ncid, dimids(j), len=ndimlens(j))
+      istatus = nf90_inquire_dimension(this%ncid, idimids(j), len=ndimlens(j))
       if (istatus /= NF90_NOERR) then
         write(nulerr,'(a,i0,a,i0,a,a)') '*** Error reading length of dimension ', &
@@ -420,4 +434,12 @@
 
   !---------------------------------------------------------------------
+  ! Return true if file is open, false otherwise
+  function is_open(this)
+    class(netcdf_file) :: this
+    logical            :: is_open
+    is_open = (this%ncid >= 0)
+  end function is_open
+
+  !---------------------------------------------------------------------
   ! Return the number of dimensions of variable with name var_name, or
   ! -1 if the variable is not found
@@ -619,7 +641,52 @@
 
   !---------------------------------------------------------------------
+  ! Read an integer scalar
+  subroutine get_int_scalar(this, var_name, scalar)
+    class(netcdf_file)           :: this
+    character(len=*), intent(in) :: var_name
+    integer,          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_int_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)
+  subroutine get_real_scalar_indexed(this, var_name, scalar, index)
     class(netcdf_file)           :: this
     character(len=*), intent(in) :: var_name
@@ -676,6 +743,6 @@
 
   !---------------------------------------------------------------------
-  ! Read a 1D array into "vector", which must be allocatable and will
-  ! be reallocated if necessary
+  ! Read a 1D real 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
@@ -734,10 +801,10 @@
 
   !---------------------------------------------------------------------
-  ! Read a 1D integer array into "vector", which must be allocatable
+  ! Read a 1D character array into "vector", which must be allocatable
   ! and will be reallocated if necessary
-  subroutine get_integer_vector(this, var_name, vector)
+  subroutine get_char_vector(this, var_name, vector)
     class(netcdf_file)           :: this
     character(len=*), intent(in) :: var_name
-    integer, allocatable, intent(out) :: vector(:)
+    character(len=1), allocatable, intent(out) :: vector(:)
 
     integer                      :: n  ! Length of vector
@@ -784,15 +851,73 @@
     if (istatus /= NF90_NOERR) then
       write(nulerr,'(a,a,a,a)') '*** Error reading NetCDF variable ', &
+           &  var_name, ' as a vector of chars: ', trim(nf90_strerror(istatus))
+      call my_abort('Error reading NetCDF file')
+    end if
+
+  end subroutine get_char_vector
+
+
+  !---------------------------------------------------------------------
+  ! Read a 1D integer array into "vector", which must be allocatable
+  ! and will be reallocated if necessary
+  subroutine get_int_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
-
+  end subroutine get_int_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)
+  subroutine get_real_vector_indexed(this, var_name, vector, index)
     class(netcdf_file)           :: this
     character(len=*), intent(in) :: var_name
@@ -975,9 +1100,127 @@
 
   !---------------------------------------------------------------------
+  ! Read 2D array of characters 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_char_matrix(this, var_name, matrix, do_transp)
+    class(netcdf_file)           :: this
+    character(len=*), intent(in) :: var_name
+    character(len=1), allocatable, intent(inout) :: matrix(:,:)
+    logical, optional, intent(in):: do_transp ! Transpose data?
+
+    character(len=1), 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
+    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
+
+      vstart = 1
+      vcount(1:2) = [ndimlen1,1]
+      
+      do j = 1,ndimlen2
+        vstart(2) = j
+        istatus = nf90_get_var(this%ncid, ivarid, matrix(:,j), start=vstart, count=vcount)
+      end do
+    end if
+
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error reading NetCDF variable ', &
+           &    var_name, ' as a matrix of characters: ', trim(nf90_strerror(istatus))
+      call my_abort('Error reading NetCDF file')
+    end if
+
+  end subroutine get_char_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)
+  subroutine get_real_matrix_indexed(this, var_name, matrix, index, do_transp)
     class(netcdf_file)           :: this
     character(len=*), intent(in) :: var_name
@@ -1187,5 +1430,5 @@
       if (this%iverbose >= 3) then
         write(nulout,'(a,a,a,i0,i0,i0,a)',advance='no') '  Reading ', var_name, &
-             & ' (permuted dimensions ', i_permute_3d, ')'
+             & ' (permuting dimensions ', i_permute_3d, ')'
         call this%print_variable_attributes(ivarid,nulout)
       end if
@@ -1235,5 +1478,5 @@
   ! 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)
+  subroutine get_real_array3_indexed(this, var_name, var, index, ipermute)
     class(netcdf_file)                   :: this
     character(len=*), intent(in)         :: var_name
@@ -1331,5 +1574,5 @@
         write(nulout,'(a,i0,a,a,a,i0,i0,i0,a)') '  Reading slice ', index, &
              &  ' of ', var_name, &
-             & ' (permuted dimensions ', i_permute_3d, ')'
+             & ' (permuting dimensions ', i_permute_3d, ')'
       end if
 
@@ -1471,5 +1714,5 @@
       if (this%iverbose >= 3) then
         write(nulout,'(a,a,a,i0,i0,i0,a)',advance='no') '  Reading ', var_name, &
-             & ' (permuted dimensions ', i_permute_4d, ')'
+             & ' (permuting dimensions ', i_permute_4d, ')'
         call this%print_variable_attributes(ivarid,nulout)
       end if
@@ -1549,5 +1792,5 @@
     !    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
+      write(nulerr,'(a,a)') '*** Not enough space to read attribute ', attr_name
       call my_abort('Error reading NetCDF file')
     end if
@@ -1577,7 +1820,6 @@
     real(jprb),       intent(out) :: attr
 
-    integer :: i_attr_len, ivarid
+    integer :: ivarid
     integer :: istatus
-    integer :: j
 
     istatus = nf90_inq_varid(this%ncid, var_name, ivarid)
@@ -1624,5 +1866,5 @@
     !    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
+      write(nulerr,'(a,a)') '*** Not enough space to read global attribute ', attr_name
       call my_abort('Error reading NetCDF file')
     end if
@@ -1652,13 +1894,10 @@
 
     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)
+        write(iunit, '(a,a,a)', advance='no') ': "', trim(attr_str), '"'
         istatus = nf90_get_att(this%ncid, ivarid, 'units', attr_str)
         if (istatus == NF90_NOERR) then
@@ -1721,10 +1960,11 @@
   ! 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)
+       &                     dim4_name, long_name, units_str, comment_str, &
+       &                     standard_name, is_double, data_type_name, fill_value, &
+       &                     deflate_level, shuffle, chunksizes, ndims)
     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
+    character(len=*), intent(in), optional :: dim1_name, dim2_name, dim3_name, dim4_name
     logical,          intent(in), optional :: is_double
     character(len=*), intent(in), optional :: data_type_name
@@ -1733,12 +1973,21 @@
     logical,          intent(in), optional :: shuffle ! Shuffle bytes before compression
     integer, dimension(:), intent(in), optional :: chunksizes
-
-    integer :: istatus, ndims, ivarid
+    integer,          intent(in), optional :: ndims
+
+    integer :: istatus, ndims_local, ndims_input, ivarid
     integer, dimension(NF90_MAX_VAR_DIMS) :: idimids
     integer :: data_type
 
-    if (present(dim1_name)) then
+    ! Sometimes a program may not know at compile time the exact
+    ! dimensions of a variable - if ndims is present then only up to
+    ! that many dimensions will be defined
+    ndims_input = 4
+    if (present(ndims)) then
+      ndims_input = ndims
+    end if
+
+    if (present(dim1_name) .and. ndims_input >= 1) then
       ! Variable is at least one dimensional
-      ndims = 1
+      ndims_local = 1
       istatus = nf90_inq_dimid(this%ncid, dim1_name, idimids(1))
       if (istatus /= NF90_NOERR) then
@@ -1747,7 +1996,7 @@
         call my_abort('Error writing NetCDF file')
       end if
-      if (present(dim2_name)) then
+      if (present(dim2_name) .and. ndims_input >= 2) then
         ! Variable is at least two dimensional
-        ndims = 2
+        ndims_local = 2
         istatus = nf90_inq_dimid(this%ncid, dim2_name, idimids(2))
         if (istatus /= NF90_NOERR) then
@@ -1756,7 +2005,7 @@
           call my_abort('Error writing NetCDF file')
         end if
-        if (present(dim3_name)) then
+        if (present(dim3_name) .and. ndims_input >= 3) then
           ! Variable is at least three dimensional
-          ndims = 3
+          ndims_local = 3
           istatus = nf90_inq_dimid(this%ncid, dim3_name, idimids(3))
           if (istatus /= NF90_NOERR) then
@@ -1765,14 +2014,23 @@
             call my_abort('Error writing NetCDF file')
           end if
+          if (present(dim4_name) .and. ndims_input >= 4) then
+            ! Variable is at least three dimensional
+            ndims_local = 4
+            istatus = nf90_inq_dimid(this%ncid, dim4_name, idimids(4))
+            if (istatus /= NF90_NOERR) then
+              write(nulerr,'(a,a,a,a)') '*** Error inquiring ID of dimension ', &
+                   &             dim4_name, ': ', trim(nf90_strerror(istatus))
+              call my_abort('Error writing NetCDF file')
+            end if
+          end if
         end if
       end if
     else
       ! Variable is a scalar
-      ndims = 0
+      ndims_local = 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
@@ -1787,17 +2045,25 @@
         data_type = NF90_FLOAT
       else
-        write(nulerr,'(a,a,a)') '*** Error: netCDF data type "', data_type_name, '" not supported'
+        write(nulerr,'(a,a,a)') '*** NetCDF data type "', data_type_name, '" not supported'
         call my_abort('Error writing NetCDF file')
       end if
     else if (present(is_double)) then
+      if (is_double) then
+        data_type = NF90_DOUBLE
+      else
+        data_type = NF90_FLOAT
+      end if
+    else if (this%is_double_precision) then
       data_type = NF90_DOUBLE
+    else
+      data_type = NF90_FLOAT
     end if
 
     ! Define variable
 #ifdef NC_NETCDF4
-    istatus = nf90_def_var(this%ncid, var_name, data_type, idimids(1:ndims), &
+    istatus = nf90_def_var(this%ncid, var_name, data_type, idimids(1:ndims_local), &
          & ivarid, deflate_level=deflate_level, shuffle=shuffle, chunksizes=chunksizes)
 #else
-    istatus = nf90_def_var(this%ncid, var_name, data_type, idimids(1:ndims), ivarid)
+    istatus = nf90_def_var(this%ncid, var_name, data_type, idimids(1:ndims_local), ivarid)
 #endif
     if (istatus /= NF90_NOERR) then
@@ -1811,14 +2077,28 @@
       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
+        write(nulout,'(a,a,a,a,a)', advance='no') '  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
+        write(nulout,'(a,a)', advance='no') '  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 (this%iverbose >= 4) then
+        if (trim(units_str) == '1') then
+          write(nulout, '(a)') ' (dimensionless)'
+        else
+          write(nulout, '(a,a,a)') ' (', trim(units_str), ')'
+        end if
+      end if
+    else
+      if (this%iverbose >= 4) then
+        write(nulout, '(1x)')
+      end if
+    end if
+
     if (present(standard_name)) then
       istatus = nf90_put_att(this%ncid, ivarid, "standard_name", standard_name)
@@ -1863,5 +2143,5 @@
   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)
+       &  contributor_name, project_str, conventions_str, prior_history_str)
     class(netcdf_file)                     :: this
 
@@ -1872,5 +2152,5 @@
     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=*), intent(in), optional :: references_str, prior_history_str
 
     character(len=32)   :: date_time_str
@@ -1887,5 +2167,10 @@
          &   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(prior_history_str)) then
+      history_str = trim(prior_history_str) // new_line('a') &
+           &  // trim(date_time_str) // ': ' // trim(command_line_str)
+    else
+      history_str = trim(date_time_str) // ': ' // trim(command_line_str)
+    end if
 
     if (present(title_str))   i=nf90_put_att(this%ncid, NF90_GLOBAL, "title", title_str)
@@ -2057,10 +2342,44 @@
 
   !---------------------------------------------------------------------
+  ! Save an integer vector with name var_name in the file
+  subroutine put_int_vector(this, var_name, var)
+    class(netcdf_file)             :: this
+    character(len=*), intent(in)   :: var_name
+    integer,          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_int_vector
+
+
+  !---------------------------------------------------------------------
   ! Save a vector slice with name var_name in the file
-  subroutine put_real_vector_indexed(this, var_name, index, var)
+  subroutine put_real_vector_indexed(this, var_name, var, index2, index3)
     class(netcdf_file)             :: this
     character(len=*), intent(in)   :: var_name
     real(jprb), intent(in)         :: var(:)
-    integer, intent(in)            :: index
+    integer, intent(in)            :: index2
+    integer, intent(in), optional  :: index3
 
     integer :: ivarid, ndims, istatus
@@ -2070,4 +2389,7 @@
     integer :: vcount(NF90_MAX_VAR_DIMS)
 
+    character(len=512) :: var_slice_name
+    integer :: index_last
+
     call this%end_define_mode()
 
@@ -2076,12 +2398,21 @@
     call this%get_array_dimensions(ivarid, ndims, ndimlens, ntotal)
     ntotal = ntotal / ndimlens(ndims)
+    if (present(index3)) then
+      ntotal = ntotal / ndimlens(ndims-1)
+      index_last = index3
+      write(var_slice_name,'(a,a,i0,a,i0,a)') var_name, '(:,', index2, ',', index3, ')'
+    else
+      index_last = index2
+      write(var_slice_name,'(a,a,i0,a)') var_name, '(:,', index2, ')'
+    end if
+
     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
+      write(nulerr,'(a,i0,a,a,i0)') '*** Error: attempt to write vector of length ', &
+           & size(var), ' to ', trim(var_slice_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)
+    if (index_last < 1 .or. index_last > ndimlens(ndims)) then
+      write(nulerr,'(a,a,a,i0)') '*** Error: attempt to write vector to ', &
+           &  trim(var_slice_name), ' which has outer dimension  ', ndimlens(ndims)
       call my_abort('Error writing NetCDF file')
     end if
@@ -2089,11 +2420,18 @@
     ! Save the vector
     vstart(1:ndims-1) = 1
-    vstart(ndims)     = index
     vcount(1:ndims-1) = ndimlens(1:ndims-1)
     vcount(ndims)     = 1
+    if (present(index3)) then
+      vstart(ndims)   = index3
+      vstart(ndims-1) = index2
+      vcount(ndims-1) = 1
+    else
+      vstart(ndims)   = index2
+    end if
+
     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))
+      write(nulerr,'(a,a,a,a)') '*** Error writing vector to ', trim(var_slice_name), &
+           &  ': ', trim(nf90_strerror(istatus))
       call my_abort('Error writing NetCDF file')
     end if
@@ -2171,12 +2509,13 @@
   ! 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)
+  subroutine put_real_matrix_indexed(this, var_name, var, index3, index4, do_transp)
     class(netcdf_file)             :: this
     character(len=*), intent(in)   :: var_name
     real(jprb), intent(in)         :: var(:,:)
-    integer, intent(in)            :: index
+    integer, intent(in)            :: index3
+    integer, intent(in), optional  :: index4
 
     real(jprb), allocatable        :: var_transpose(:,:)
-    logical, optional, intent(in):: do_transp
+    logical, optional, intent(in)  :: do_transp
 
     integer :: ivarid, ndims, nvarlen, istatus
@@ -2186,4 +2525,6 @@
     integer :: vcount(NF90_MAX_VAR_DIMS)
 
+    character(len=512) :: var_slice_name
+
     logical :: do_transpose
 
@@ -2204,19 +2545,31 @@
     ! ntotal is zero then there must be an unlimited dimension)
     ntotal = ntotal / ndimlens(ndims)
+    if (present(index4)) then
+      ntotal = ntotal / ndimlens(ndims-1)
+      write(var_slice_name,'(a,a,i0,a,i0,a)') var_name, '(:,:,', index3, ',', index4, ')'
+    else
+      write(var_slice_name,'(a,a,i0,a)') var_name, '(:,:,', index3, ')'
+    end if
     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
+           & nvarlen, ' to ', trim(var_slice_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 (present(index4)) then
+      vstart(ndims)   = index4
+      vstart(ndims-1) = index3
+      vcount(ndims-1) = 1
+    else
+      vstart(ndims)   = index3
+    end if
 
     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, &
+        write(nulout,'(a,a,a)') '  Writing ', trim(var_slice_name), &
              & ' (transposing dimensions)'
       end if
@@ -2228,5 +2581,5 @@
       ! Save the matrix without transposition
       if (this%iverbose >= 3) then
-        write(nulout,'(a,i0,a,a)') '  Writing slice ', index, ' of ', var_name
+        write(nulout,'(a,a)') '  Writing ', trim(var_slice_name)
       end if
       istatus = nf90_put_var(this%ncid, ivarid, var, start=vstart, count=vcount)
@@ -2234,5 +2587,5 @@
 
     if (istatus /= NF90_NOERR) then
-      write(nulerr,'(a,a,a,a)') '*** Error writing matrix ', var_name, &
+      write(nulerr,'(a,a,a)') '*** Error writing ', trim(var_slice_name), &
            &                    ': ', trim(nf90_strerror(istatus))
       call my_abort('Error writing NetCDF file')
@@ -2291,15 +2644,16 @@
       if (this%iverbose >= 3) then
         write(nulout,'(a,a,a,i0,i0,i0,a)') '  Writing ', var_name, &
-             & ' (permuted dimensions: ', i_permute_3d, ')'
+             & ' (permuting 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
+      !! FIX: This makes it look like the dimensions have stayed the same
+      ! 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)))
@@ -2326,3 +2680,222 @@
   end subroutine put_real_array3
 
+
+#ifdef NC_NETCDF4
+  !---------------------------------------------------------------------
+  ! Copy dimensions from "infile" to "this"
+  subroutine copy_dimensions(this, infile)
+    class(netcdf_file)            :: this
+    type(netcdf_file), intent(in) :: infile
+
+    integer :: jdim
+    integer :: ndims
+    integer :: idimids(1024)
+    integer :: dimlen
+    character(len=512) :: dimname
+    integer :: istatus
+    integer :: include_parents
+    
+    include_parents = 0
+
+    istatus = nf90_inq_dimids(infile%ncid, ndims, idimids, include_parents)
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a)') '*** Error reading dimensions of NetCDF file: ', &
+           trim(nf90_strerror(istatus))
+      call my_abort('Error reading NetCDF file')
+    end if
+
+    do jdim = 1,ndims
+      istatus = nf90_inquire_dimension(infile%ncid, idimids(jdim), &
+           &  name=dimname, len=dimlen)
+      if (istatus /= NF90_NOERR) then
+        write(nulerr,'(a,a)') '*** Error reading NetCDF dimension properties: ', &
+             trim(nf90_strerror(istatus))
+        call my_abort('Error reading NetCDF file')
+      end if
+      call this%define_dimension(trim(dimname), dimlen)
+    end do
+
+  end subroutine copy_dimensions
+#endif
+
+  !---------------------------------------------------------------------
+  ! Copy variable definition and attributes from "infile" to "this"
+  subroutine copy_variable_definition(this, infile, var_name)
+    class(netcdf_file)            :: this
+    type(netcdf_file), intent(in) :: infile
+    character(len=*),  intent(in) :: var_name
+
+#ifdef NC_NETCDF4
+    integer :: deflate_level  ! Compression: 0 (none) to 9 (most)
+    logical :: shuffle        ! Shuffle bytes before compression
+    integer :: chunksizes(NF90_MAX_VAR_DIMS)
+#endif
+    integer :: data_type
+    integer :: ndims
+    integer :: idimids_in(NF90_MAX_VAR_DIMS)
+    integer :: idimids_out(NF90_MAX_VAR_DIMS)
+    integer :: nattr
+    character(len=512) :: attr_name
+    character(len=512) :: dim_name
+
+    integer :: istatus
+    integer :: ivarid_in, ivarid_out
+    integer :: jattr, jdim
+
+    if (this%iverbose >= 4) then
+      write(nulout,'(a,a)') '  Copying definition of ', trim(var_name)
+    end if
+
+    ! Get variable ID from name
+    istatus = nf90_inq_varid(infile%ncid, var_name, ivarid_in) 
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,i0,a)') '*** Error inquiring about NetCDF variable "', &
+           & var_name, '": ', trim(nf90_strerror(istatus))
+      call my_abort('Error reading NetCDF file')
+    end if
+
+    ! Get variable properties
+#ifdef NC_NETCDF4
+    istatus = nf90_inquire_variable(infile%ncid, ivarid_in, xtype=data_type, ndims=ndims, &
+         &  dimids=idimids_in, chunksizes=chunksizes, deflate_level=deflate_level, &
+         &  shuffle=shuffle, natts=nattr)
+#else
+    istatus = nf90_inquire_variable(infile%ncid, ivarid_in, xtype=data_type, ndims=ndims, &
+         &  dimids=idimids_in, natts=nattr)
+#endif
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a)') '*** Error reading NetCDF variable properties: ', &
+           trim(nf90_strerror(istatus))
+      call my_abort('Error reading NetCDF file')
+    end if
+
+    ! Map dimension IDs
+    do jdim = 1,ndims
+      istatus = nf90_inquire_dimension(infile%ncid, idimids_in(jdim), name=dim_name)
+      if (istatus /= NF90_NOERR) then
+        write(nulerr,'(a,a)') '*** Error reading NetCDF dimension name: ', &
+             trim(nf90_strerror(istatus))
+        call my_abort('Error reading NetCDF file')
+      end if
+
+      istatus = nf90_inq_dimid(this%ncid, trim(dim_name), idimids_out(jdim))
+      if (istatus /= NF90_NOERR) then
+        write(nulerr,'(a,a)') '*** Error reading NetCDF dimension ID: ', &
+             trim(nf90_strerror(istatus))
+        call my_abort('Error reading NetCDF file')
+      end if
+    end do
+
+    ! Create variable
+#ifdef NC_NETCDF4
+    istatus = nf90_def_var(this%ncid, var_name, data_type, idimids_out(1:ndims), &
+         & ivarid_out, deflate_level=deflate_level, shuffle=shuffle, chunksizes=chunksizes(1:ndims))
+#else
+    istatus = nf90_def_var(this%ncid, var_name, data_type, idimids_out(1:ndims), ivarid_out)
+#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
+
+    ! Copy attributes
+    do jattr = 1,nattr
+      istatus = nf90_inq_attname(infile%ncid, ivarid_in, jattr, attr_name)
+      if (istatus /= NF90_NOERR) then
+        write(nulerr,'(a,a)') '*** Error reading attribute: ', &
+             &  trim(nf90_strerror(istatus))
+        call my_abort('Error reading NetCDF file')
+      end if
+      istatus = nf90_copy_att(infile%ncid, ivarid_in, trim(attr_name), &
+           &                    this%ncid, ivarid_out)
+
+    end do
+
+  end subroutine copy_variable_definition
+
+
+  !---------------------------------------------------------------------
+  ! Copy variable from "infile" to "this"
+  subroutine copy_variable(this, infile, var_name)
+    class(netcdf_file)             :: this
+    class(netcdf_file), intent(in) :: infile
+    character(len=*),   intent(in) :: var_name
+
+    integer :: ivarid_in, ivarid_out
+    integer :: ndims
+    integer :: ndimlens(NF90_MAX_VAR_DIMS)
+    integer(kind=jpib) :: ntotal
+    integer :: data_type
+    integer :: istatus
+
+    ! We use the Fortran-77 functions because they don't check that
+    ! the rank of the arguments is correct
+    integer, external :: nf_get_var_double, nf_put_var_double
+    integer, external :: nf_get_var_int, nf_put_var_int
+
+    real(kind=jprd), allocatable :: data_real(:)
+    integer,         allocatable :: data_int(:)
+
+    ! If we are in define mode, exit define mode
+    call this%end_define_mode()
+
+    if (this%iverbose >= 4) then
+      write(nulout,'(a,a)') '  Copying ', trim(var_name)
+    end if
+
+    call infile%get_variable_id(var_name, ivarid_in)
+    call infile%get_array_dimensions(ivarid_in, ndims, ndimlens, ntotal)
+    istatus = nf90_inquire_variable(infile%ncid, ivarid_in, xtype=data_type)
+    if (istatus /= NF90_NOERR) then
+      write(nulerr,'(a,a,a,a)') '*** Error reading variable "', var_name, '": ', &
+           &  trim(nf90_strerror(istatus))
+      call my_abort('Error reading NetCDF file')
+    end if
+
+    call infile%get_variable_id(var_name, ivarid_out)
+    if (data_type == NF90_DOUBLE .or. data_type == NF90_FLOAT) then
+      allocate(data_real(ntotal))
+      !istatus = nf90_get_var(infile%ncid, ivarid_in, data_real(1))
+      istatus = nf_get_var_double(infile%ncid, ivarid_in, data_real)
+      if (istatus /= NF90_NOERR) then
+        deallocate(data_real)
+        write(nulerr,'(a,a,a,a)') '*** Error reading variable "', var_name, '": ', &
+             &  trim(nf90_strerror(istatus))
+        call my_abort('Error reading NetCDF file')
+      end if
+
+      !istatus = nf90_put_var(this%ncid, ivarid_out, data_real)
+      istatus = nf_put_var_double(this%ncid, ivarid_out, data_real)
+      deallocate(data_real)
+      if (istatus /= NF90_NOERR) then
+        write(nulerr,'(a,a,a,a)') '*** Error writing variable "', var_name, '": ', &
+             &  trim(nf90_strerror(istatus))
+        call my_abort('Error writing NetCDF file')
+      end if
+
+    else
+      allocate(data_int(ntotal))
+      !istatus = nf90_get_var(infile%ncid, ivarid_in, data_int)
+      istatus = nf_get_var_int(infile%ncid, ivarid_in, data_int)
+      if (istatus /= NF90_NOERR) then
+        deallocate(data_int)
+ 
+        write(nulerr,'(a,a,a,a)') '*** Error reading variable "', var_name, '": ', &
+             &  trim(nf90_strerror(istatus))
+        call my_abort('Error reading NetCDF file')
+      end if
+
+      !istatus = nf90_put_var(this%ncid, ivarid_out, data_int)
+      istatus = nf_put_var_int(this%ncid, ivarid_out, data_int)
+      deallocate(data_int)
+      if (istatus /= NF90_NOERR) then
+        write(nulerr,'(a,a,a,a)') '*** Error writing variable "', var_name, '": ', &
+             &  trim(nf90_strerror(istatus))
+        call my_abort('Error writing NetCDF file')
+      end if
+    end if
+
+  end subroutine copy_variable
+
 end module easy_netcdf
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_adding_ica_lw.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_adding_ica_lw.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_adding_ica_lw.F90	(revision 4489)
@@ -296,5 +296,5 @@
     
     ! Loop index for model level
-    integer :: jlev
+    integer :: jlev, jcol
 
     real(jprb) :: hook_handle
@@ -307,6 +307,10 @@
     ! Work down through the atmosphere computing the downward fluxes
     ! at each half-level
+! Added for DWD (2020)
+!NEC$ outerloop_unroll(8)
     do jlev = 1,nlev
-      flux_dn(:,jlev+1) = transmittance(:,jlev)*flux_dn(:,jlev) + source_dn(:,jlev)
+      do jcol = 1,ncol
+        flux_dn(jcol,jlev+1) = transmittance(jcol,jlev)*flux_dn(jcol,jlev) + source_dn(jcol,jlev)
+      end do
     end do
 
@@ -316,6 +320,10 @@
     ! Work back up through the atmosphere computing the upward fluxes
     ! at each half-level
+! Added for DWD (2020)
+!NEC$ outerloop_unroll(8)
     do jlev = nlev,1,-1
-      flux_up(:,jlev) = transmittance(:,jlev)*flux_up(:,jlev+1) + source_up(:,jlev)
+      do jcol = 1,ncol
+        flux_up(jcol,jlev) = transmittance(jcol,jlev)*flux_up(jcol,jlev+1) + source_up(jcol,jlev)
+      end do
     end do
     
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_adding_ica_sw.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_adding_ica_sw.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_adding_ica_sw.F90	(revision 4489)
@@ -98,4 +98,6 @@
     ! also the "source", which is the upwelling flux due to direct
     ! radiation that is scattered below that level
+! Added for DWD (2020)
+!NEC$ outerloop_unroll(8)
     do jlev = nlev,1,-1
       ! Next loop over columns. We could do this by indexing the
@@ -128,4 +130,6 @@
     ! Work back down through the atmosphere computing the fluxes at
     ! each half-level
+! Added for DWD (2020)
+!NEC$ outerloop_unroll(8)
     do jlev = 1,nlev
       do jcol = 1,ncol
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_aerosol.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_aerosol.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_aerosol.F90	(revision 4489)
@@ -115,6 +115,6 @@
       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
+      ! then the user may wish to just provide absorption optical
+      ! depth in od_lw, in which case we must set the following two
       ! variables to zero
       this%ssa_lw = 0.0_jprb
@@ -128,5 +128,5 @@
 
   !---------------------------------------------------------------------
-  ! Deallocate array
+  ! Deallocate arrays
   subroutine deallocate_aerosol_arrays(this)
 
@@ -158,5 +158,5 @@
 
     use yomhook,          only : lhook, dr_hook
-    use radiation_config, only : out_of_bounds_3d
+    use radiation_check,  only : out_of_bounds_3d
 
     class(aerosol_type),   intent(inout) :: this
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_aerosol_optics.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_aerosol_optics.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_aerosol_optics.F90	(revision 4489)
@@ -14,5 +14,7 @@
 !
 ! Modifications
-!   2018-04-15  R Hogan  Add "direct" option
+!   2018-04-15  R. Hogan  Add "direct" option
+!   2020-11-14  R. Hogan  Add setup_general_aerosol_optics for ecCKD compatibility
+!   2022-03-27  R. Hogan  Add setup_general_aerosol_optics_legacy to use RRTM aerosol files with ecCKD
 
 module radiation_aerosol_optics
@@ -36,4 +38,5 @@
     use radiation_aerosol_optics_data, only : aerosol_optics_type
     use radiation_io,                  only : nulerr, radiation_abort
+    use setup_aerosol_optics_lmdz_m,   only: setup_aerosol_optics_lmdz
 
     type(config_type), intent(inout) :: config
@@ -46,10 +49,26 @@
       ! 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)
+      if (config%use_general_aerosol_optics) then
+        ! Read file containing high spectral resolution optical
+        ! properties and average to the spectral intervals of the
+        ! current gas-optics scheme
+!        call setup_general_aerosol_optics(config)
+        call setup_general_aerosol_optics_lmdz(config,trim(config%aerosol_optics_file_name))
+      else
+        ! Read file containing optical properties already in the bands
+        ! of the gas-optics scheme
+!        call config%aerosol_optics%setup(trim(config%aerosol_optics_file_name), &
+!             &                           iverbose=config%iverbosesetup)
+        call setup_aerosol_optics_lmdz(config%aerosol_optics, &
+                                       trim(config%aerosol_optics_file_name))
+      end if
+
+      call config%aerosol_optics%initialize_types(config%n_aerosol_types)
 
       ! 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'
+        write(nulerr,'(a,i0,a,i0,a)') '*** Error: number of longwave bands (', &
+             &  config%n_bands_lw, ') does not match aerosol optics look-up table (', &
+             &  config%aerosol_optics%n_bands_lw, ')'
         call radiation_abort()
       end if
@@ -63,9 +82,699 @@
     end if
 
-    call config%aerosol_optics%print_description(config%i_aerosol_type_map(1:config%n_aerosol_types))
+    if (config%iverbosesetup >= 1) then
+      call config%aerosol_optics%print_description(config%i_aerosol_type_map(1:config%n_aerosol_types))
+    end if
 
     if (lhook) call dr_hook('radiation_aerosol_optics:setup_aerosol_optics',1,hook_handle)
 
   end subroutine setup_aerosol_optics
+
+
+  !---------------------------------------------------------------------
+  ! Read file containing high spectral resolution optical properties
+  ! and average to the spectral intervals of the current gas-optics
+  ! scheme
+  subroutine setup_general_aerosol_optics(config)
+
+    use parkind1,                      only : jprb
+    use yomhook,                       only : lhook, dr_hook
+    use easy_netcdf,                   only : netcdf_file
+    use radiation_config,              only : config_type
+    use radiation_aerosol_optics_data, only : aerosol_optics_type
+    use radiation_spectral_definition, only : SolarReferenceTemperature, &
+         &                                    TerrestrialReferenceTemperature
+    use radiation_io,                  only : nulout
+
+    type(config_type), intent(inout), target :: config
+
+    ! The NetCDF file containing the aerosol optics data
+    type(netcdf_file)  :: file
+
+    ! Wavenumber points in NetCDF file
+    real(jprb), allocatable :: wavenumber(:) ! cm-1
+
+    ! Hydrophilic aerosol properties
+    real(jprb), allocatable :: mass_ext_philic(:,:,:)    ! Mass-ext coefficient (m2 kg-1)
+    real(jprb), allocatable :: ssa_philic(:,:,:)         ! Single-scattering albedo
+    real(jprb), allocatable :: g_philic(:,:,:)           ! Asymmetry factor
+    real(jprb), allocatable :: lidar_ratio_philic(:,:,:) ! Lidar ratio (sr)
+
+    ! Hydrophobic aerosol properties
+    real(jprb), allocatable :: mass_ext_phobic(:,:)      ! Mass-ext coefficient (m2 kg-1)
+    real(jprb), allocatable :: ssa_phobic(:,:)           ! Single-scattering albedo
+    real(jprb), allocatable :: g_phobic(:,:)             ! Asymmetry factor
+    real(jprb), allocatable :: lidar_ratio_phobic(:,:)   ! Lidar ratio (sr)
+
+    ! Mapping matrix between optical properties at the wavenumbers in
+    ! the file, and spectral intervals used by the gas-optics scheme
+    real(jprb), allocatable :: mapping(:,:)
+
+    ! Pointer to the aerosol optics coefficients for brevity of access
+    type(aerosol_optics_type), pointer :: ao
+
+    ! Target monochromatic wavenumber for interpolation (cm-1)
+    real(jprb) :: wavenumber_target
+
+    ! Number of spectral points describing aerosol properties in the
+    ! shortwave and longwave
+    integer    :: nspecsw, nspeclw
+
+    ! Number of monochromatic wavelengths required
+    integer    :: nmono
+
+    integer    :: n_type_philic, n_type_phobic, nrh, nwn
+    integer    :: jtype, jwl, iwn
+
+    ! Weight of first point in interpolation
+    real(jprb) :: weight1
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_aerosol_optics:setup_general_aerosol_optics',0,hook_handle)
+
+    ao => config%aerosol_optics
+
+    call file%open(trim(config%aerosol_optics_file_name), iverbose=config%iverbosesetup)
+
+    if (.not. file%exists('wavenumber')) then
+      ! Assume we have an old-style aerosol optics file with optical
+      ! properties provided per pre-defined band
+      call file%close()
+      if (config%iverbosesetup >= 2) then
+        write(nulout,'(a)') 'Legacy aerosol optics file: mapping between bands'
+      end if
+      call setup_general_aerosol_optics_legacy(config, trim(config%aerosol_optics_file_name))
+      return
+    end if
+
+    if (file%exists('mass_ext_hydrophilic')) then
+      ao%use_hydrophilic = .true.
+    else
+      ao%use_hydrophilic = .false.
+    end if
+ 
+    call file%get('wavenumber', wavenumber)
+    nwn = size(wavenumber)
+
+    ! Read the raw scattering data
+    call file%get('mass_ext_hydrophobic',    mass_ext_phobic)
+    call file%get('ssa_hydrophobic',         ssa_phobic)
+    call file%get('asymmetry_hydrophobic',   g_phobic)
+    call file%get('lidar_ratio_hydrophobic', lidar_ratio_phobic)
+
+    call file%get_global_attribute('description_hydrophobic', &
+         &                         ao%description_phobic_str)
+
+    if (ao%use_hydrophilic) then
+      call file%get('mass_ext_hydrophilic',    mass_ext_philic)
+      call file%get('ssa_hydrophilic',         ssa_philic)
+      call file%get('asymmetry_hydrophilic',   g_philic)
+      call file%get('lidar_ratio_hydrophilic', lidar_ratio_philic)
+
+      call file%get('relative_humidity1',      ao%rh_lower)
+
+      call file%get_global_attribute('description_hydrophilic', &
+           &                         ao%description_philic_str)
+    end if
+
+    ! Close aerosol scattering file
+    call file%close()
+
+    n_type_phobic = size(mass_ext_phobic, 2)
+    if (ao%use_hydrophilic) then
+      n_type_philic = size(mass_ext_philic, 3)
+      nrh = size(ao%rh_lower)
+    else
+      n_type_philic = 0
+      nrh = 0
+    end if
+
+    if (config%do_cloud_aerosol_per_sw_g_point) then
+      nspecsw = config%gas_optics_sw%spectral_def%ng
+    else
+      nspecsw = config%gas_optics_sw%spectral_def%nband
+    end if
+
+    if (config%do_cloud_aerosol_per_lw_g_point) then
+      nspeclw = config%gas_optics_lw%spectral_def%ng
+    else
+      nspeclw = config%gas_optics_lw%spectral_def%nband
+    end if
+
+    if (allocated(ao%wavelength_mono)) then
+      ! Monochromatic wavelengths also required
+      nmono = size(ao%wavelength_mono)
+    else
+      nmono = 0
+    end if
+
+    call ao%allocate(n_type_phobic, n_type_philic, nrh, nspeclw, nspecsw, nmono)
+
+    if (config%do_sw) then
+      call config%gas_optics_sw%spectral_def%calc_mapping(SolarReferenceTemperature, &
+           &  wavenumber, mapping, use_bands=(.not. config%do_cloud_aerosol_per_sw_g_point))
+
+      ao%mass_ext_sw_phobic = matmul(mapping, mass_ext_phobic)
+      ao%ssa_sw_phobic = matmul(mapping, mass_ext_phobic*ssa_phobic) &
+           &           / ao%mass_ext_sw_phobic
+      ao%g_sw_phobic = matmul(mapping, mass_ext_phobic*ssa_phobic*g_phobic) &
+           &         / (ao%mass_ext_sw_phobic*ao%ssa_sw_phobic)
+
+      if (ao%use_hydrophilic) then
+        do jtype = 1,n_type_philic
+          ao%mass_ext_sw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype))
+          ao%ssa_sw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype) &
+               &                                        *ssa_philic(:,:,jtype)) &
+               &           / ao%mass_ext_sw_philic(:,:,jtype)
+          ao%g_sw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype) &
+               &                       *ssa_philic(:,:,jtype)*g_philic(:,:,jtype)) &
+               &         / (ao%mass_ext_sw_philic(:,:,jtype)*ao%ssa_sw_philic(:,:,jtype))
+        end do
+      end if
+    end if
+
+    if (config%do_lw) then
+      call config%gas_optics_lw%spectral_def%calc_mapping(TerrestrialReferenceTemperature, &
+           &  wavenumber, mapping, use_bands=(.not. config%do_cloud_aerosol_per_lw_g_point))
+
+      ao%mass_ext_lw_phobic = matmul(mapping, mass_ext_phobic)
+      ao%ssa_lw_phobic = matmul(mapping, mass_ext_phobic*ssa_phobic) &
+           &           / ao%mass_ext_lw_phobic
+      ao%g_lw_phobic = matmul(mapping, mass_ext_phobic*ssa_phobic*g_phobic) &
+           &         / (ao%mass_ext_lw_phobic*ao%ssa_lw_phobic)
+
+      if (ao%use_hydrophilic) then
+        do jtype = 1,n_type_philic
+          ao%mass_ext_lw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype))
+          ao%ssa_lw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype) &
+               &                                        *ssa_philic(:,:,jtype)) &
+               &           / ao%mass_ext_lw_philic(:,:,jtype)
+          ao%g_lw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype) &
+               &                       *ssa_philic(:,:,jtype)*g_philic(:,:,jtype)) &
+               &         / (ao%mass_ext_lw_philic(:,:,jtype)*ao%ssa_lw_philic(:,:,jtype))
+        end do
+      end if
+    end if
+
+    if (allocated(ao%wavelength_mono)) then
+      ! Monochromatic wavelengths also required
+      do jwl = 1,nmono
+        ! Wavelength (m) to wavenumber (cm-1)
+        wavenumber_target = 0.01_jprb / ao%wavelength_mono(jwl)
+        ! Find index to first interpolation point, and its weight
+        if (wavenumber_target <= wavenumber(1)) then
+          weight1 = 1.0_jprb
+          iwn = 1
+        else if (wavenumber_target >= wavenumber(nwn)) then
+          iwn = nwn-1
+          weight1 = 0.0_jprb
+        else
+          iwn = 1
+          do while (wavenumber(iwn+1) < wavenumber_target .and. iwn < nwn-1)
+            iwn = iwn + 1
+          end do
+          weight1 = (wavenumber(iwn+1)-wavenumber_target) &
+               &  / (wavenumber(iwn+1)-wavenumber(iwn))
+        end if
+        ! Linear interpolation
+        ao%mass_ext_mono_phobic(jwl,:) = weight1 * mass_ext_phobic(iwn,:) &
+             &             + (1.0_jprb - weight1)* mass_ext_phobic(iwn+1,:)
+        ao%ssa_mono_phobic(jwl,:)      = weight1 * ssa_phobic(iwn,:) &
+             &             + (1.0_jprb - weight1)* ssa_phobic(iwn+1,:)
+        ao%g_mono_phobic(jwl,:)        = weight1 * g_phobic(iwn,:) &
+             &             + (1.0_jprb - weight1)* g_phobic(iwn+1,:)
+        ao%lidar_ratio_mono_phobic(jwl,:) = weight1 * lidar_ratio_phobic(iwn,:) &
+             &                + (1.0_jprb - weight1)* lidar_ratio_phobic(iwn+1,:)
+        if (ao%use_hydrophilic) then
+          ao%mass_ext_mono_philic(jwl,:,:) = weight1 * mass_ext_philic(iwn,:,:) &
+               &               + (1.0_jprb - weight1)* mass_ext_philic(iwn+1,:,:)
+          ao%ssa_mono_philic(jwl,:,:)      = weight1 * ssa_philic(iwn,:,:) &
+               &               + (1.0_jprb - weight1)* ssa_philic(iwn+1,:,:)
+          ao%g_mono_philic(jwl,:,:)        = weight1 * g_philic(iwn,:,:) &
+               &               + (1.0_jprb - weight1)* g_philic(iwn+1,:,:)
+          ao%lidar_ratio_mono_philic(jwl,:,:) = weight1 * lidar_ratio_philic(iwn,:,:) &
+               &                  + (1.0_jprb - weight1)* lidar_ratio_philic(iwn+1,:,:)
+        end if
+      end do
+    end if
+
+    ! Deallocate memory local to this routine
+    deallocate(mass_ext_phobic)
+    deallocate(ssa_phobic)
+    deallocate(g_phobic)
+    deallocate(lidar_ratio_phobic)
+    if (ao%use_hydrophilic) then
+      deallocate(mass_ext_philic)
+      deallocate(ssa_philic)
+      deallocate(g_philic)
+      deallocate(lidar_ratio_philic)
+    end if
+
+    if (lhook) call dr_hook('radiation_aerosol_optics:setup_general_aerosol_optics',1,hook_handle)
+
+  end subroutine setup_general_aerosol_optics
+
+    !---------------------------------------------------------------------
+  ! Read LMDZ file containing high spectral resolution optical properties
+  ! and average to the spectral intervals of the current gas-optics
+  ! scheme
+  subroutine setup_general_aerosol_optics_lmdz(config,file_name)
+
+    use parkind1,                      only : jprb
+    use yomhook,                       only : lhook, dr_hook
+!    use easy_netcdf,                   only : netcdf_file
+    use radiation_config,              only : config_type
+    use radiation_aerosol_optics_data, only : aerosol_optics_type
+    use radiation_spectral_definition, only : SolarReferenceTemperature, &
+         &                                    TerrestrialReferenceTemperature
+    use radiation_io,                  only : nulout
+    use netcdf95, only: nf95_open, nf95_inq_grp_full_ncid, nf95_close, &
+         nf95_inq_dimid, nf95_inq_varid, nf95_inquire_dimension, &
+         nf95_get_var, nf95_gw_var
+    use netcdf, only: nf90_nowrite
+
+
+    type(config_type), intent(inout), target :: config
+
+!    ! The NetCDF file containing the aerosol optics data
+!    type(netcdf_file)  :: file
+
+    character(len=*), intent(in):: file_name
+    ! NetCDF file containing the aerosol optics data
+
+    ! Wavenumber points in NetCDF file
+    real(jprb), allocatable :: wavenumber(:) ! cm-1
+
+    ! Hydrophilic aerosol properties
+    real(jprb), allocatable :: mass_ext_philic(:,:,:)    ! Mass-ext coefficient (m2 kg-1)
+    real(jprb), allocatable :: ssa_philic(:,:,:)         ! Single-scattering albedo
+    real(jprb), allocatable :: g_philic(:,:,:)           ! Asymmetry factor
+    real(jprb), allocatable :: lidar_ratio_philic(:,:,:) ! Lidar ratio (sr)
+
+    ! Hydrophobic aerosol properties
+    real(jprb), allocatable :: mass_ext_phobic(:,:)      ! Mass-ext coefficient (m2 kg-1)
+    real(jprb), allocatable :: ssa_phobic(:,:)           ! Single-scattering albedo
+    real(jprb), allocatable :: g_phobic(:,:)             ! Asymmetry factor
+    real(jprb), allocatable :: lidar_ratio_phobic(:,:)   ! Lidar ratio (sr)
+
+    ! Mapping matrix between optical properties at the wavenumbers in
+    ! the file, and spectral intervals used by the gas-optics scheme
+    real(jprb), allocatable :: mapping(:,:)
+
+    ! Pointer to the aerosol optics coefficients for brevity of access
+    type(aerosol_optics_type), pointer :: ao
+
+    ! Target monochromatic wavenumber for interpolation (cm-1)
+    real(jprb) :: wavenumber_target
+
+    ! Number of spectral points describing aerosol properties in the
+    ! shortwave and longwave
+    integer    :: nspecsw, nspeclw
+
+    ! Number of monochromatic wavelengths required
+    integer    :: nmono
+
+    integer    :: n_type_philic, n_type_phobic, nrh, nwn
+    integer    :: jtype, jwl, iwn
+
+    ! Weight of first point in interpolation
+    real(jprb) :: weight1
+
+    real(jprb) :: hook_handle
+
+    ! Local:
+    integer ncid, grpid, dimid, varid
+
+    if (lhook) call dr_hook('radiation_aerosol_optics:setup_general_aerosol_optics',0,hook_handle)
+
+    ao => config%aerosol_optics
+
+    ao%use_hydrophilic = .true.
+    ao%use_monochromatic = .true.
+    print*,'file_name= ',file_name
+    call nf95_open(file_name, nf90_nowrite, ncid)
+    call nf95_inq_grp_full_ncid(ncid, "Hydrophilic", grpid)
+    call nf95_inq_dimid(grpid, "hur", dimid)
+    call nf95_inquire_dimension(grpid, dimid, nclen = ao%nrh)
+!    allocate(ao%rh_lower(ao%nrh))
+    call nf95_inq_varid(grpid, "hur_bounds", varid)
+    call nf95_get_var(grpid, varid, ao%rh_lower, count_nc = [1, ao%nrh])
+
+    ! Hydrophilic/LW_bands:
+    call nf95_inq_grp_full_ncid(ncid, "Hydrophilic/LW_bands", grpid)
+    call nf95_inq_varid(grpid, "asymmetry", varid)
+    call nf95_gw_var(grpid, varid, ao%g_lw_philic)
+    call nf95_inq_varid(grpid, "single_scat_alb", varid)
+    call nf95_gw_var(grpid, varid, ao%ssa_lw_philic)
+    call nf95_inq_varid(grpid, "mass_ext", varid)
+    call nf95_gw_var(grpid, varid, ao%mass_ext_lw_philic)
+
+    ! Hydrophilic/SW_bands:
+    call nf95_inq_grp_full_ncid(ncid, "Hydrophilic/SW_bands", grpid)
+    call nf95_inq_varid(grpid, "asymmetry", varid)
+    call nf95_gw_var(grpid, varid, ao%g_sw_philic)
+    ao%g_sw_philic = cshift(ao%g_sw_philic, 1)
+    call nf95_inq_varid(grpid, "single_scat_alb", varid)
+    call nf95_gw_var(grpid, varid, ao%ssa_sw_philic)
+    ao%g_sw_philic = cshift(ao%ssa_sw_philic, 1)
+    call nf95_inq_varid(grpid, "mass_ext", varid)
+    call nf95_gw_var(grpid, varid, ao%mass_ext_sw_philic)
+    ao%g_sw_philic = cshift(ao%mass_ext_sw_philic, 1)
+
+    ! Hydrophilic/Monochromatic:
+    call nf95_inq_grp_full_ncid(ncid, "Hydrophilic/Monochromatic", grpid)
+    call nf95_inq_varid(grpid, "mass_ext", varid)
+    call nf95_gw_var(grpid, varid, ao%mass_ext_mono_philic)
+
+    ! Hydrophobic/LW_bands:
+    call nf95_inq_grp_full_ncid(ncid, "Hydrophobic/LW_bands", grpid)
+    call nf95_inq_varid(grpid, "asymmetry", varid)
+    call nf95_gw_var(grpid, varid, ao%g_lw_phobic)
+    call nf95_inq_varid(grpid, "single_scat_alb", varid)
+    call nf95_gw_var(grpid, varid, ao%ssa_lw_phobic)
+    call nf95_inq_varid(grpid, "mass_ext", varid)
+    call nf95_gw_var(grpid, varid, ao%mass_ext_lw_phobic)
+
+    ! Hydrophobic/SW_bands:
+    call nf95_inq_grp_full_ncid(ncid, "Hydrophobic/SW_bands", grpid)
+    call nf95_inq_varid(grpid, "asymmetry", varid)
+    call nf95_gw_var(grpid, varid, ao%g_sw_phobic)
+    ao%g_sw_phobic = cshift(ao%g_sw_phobic, 1)
+    call nf95_inq_varid(grpid, "single_scat_alb", varid)
+    call nf95_gw_var(grpid, varid, ao%ssa_sw_phobic)
+    ao%g_sw_phobic = cshift(ao%ssa_sw_phobic, 1)
+    call nf95_inq_varid(grpid, "mass_ext", varid)
+    call nf95_gw_var(grpid, varid, ao%mass_ext_sw_phobic)
+    ao%g_sw_phobic = cshift(ao%mass_ext_sw_phobic, 1)
+! AI ATTENTION    
+    call nf95_inq_varid(grpid, "wavenumber", varid)
+    call nf95_gw_var(grpid, varid, wavenumber)
+
+    ! Hydrophobic/Monochromatic:
+    call nf95_inq_grp_full_ncid(ncid, "Hydrophobic/Monochromatic", grpid)
+    call nf95_inq_varid(grpid, "mass_ext", varid)
+    call nf95_gw_var(grpid, varid, ao%mass_ext_mono_phobic)
+
+!    call file%get('wavenumber', wavenumber)
+!    nwn = size(wavenumber)
+
+!    call file%get_global_attribute('description_hydrophobic', &
+!         &                         ao%description_phobic_str)
+
+
+!      call file%get('relative_humidity1',      ao%rh_lower)
+
+!      call file%get_global_attribute('description_hydrophilic', &
+!           &                         ao%description_philic_str)
+
+    ! Close aerosol scattering file
+!    call file%close()
+
+    call nf95_close(ncid)
+
+    ! Get array sizes
+!    ao%n_bands_lw = size(ao%mass_ext_lw_phobic, 1)
+!    ao%n_bands_sw = size(ao%mass_ext_sw_phobic, 1)
+!    ao%n_mono_wl = size(ao%mass_ext_mono_phobic, 1)
+!    ao%n_type_phobic = size(ao%mass_ext_lw_phobic, 2)
+!    ao%n_type_philic = size(ao%mass_ext_lw_philic, 3)
+
+    ! Allocate memory for mapping arrays
+!    ao%ntype = ao%n_type_phobic + ao%n_type_philic
+!    allocate(ao%iclass(ao%ntype))
+!    allocate(ao%itype(ao%ntype))
+
+!    ao%iclass = IAerosolClassUndefined
+!    ao%itype  = 0
+
+    n_type_phobic = size(mass_ext_phobic, 2)
+    if (ao%use_hydrophilic) then
+      n_type_philic = size(mass_ext_philic, 3)
+      nrh = size(ao%rh_lower)
+    else
+      n_type_philic = 0
+      nrh = 0
+    end if
+
+    if (config%do_cloud_aerosol_per_sw_g_point) then
+      nspecsw = config%gas_optics_sw%spectral_def%ng
+    else
+      nspecsw = config%gas_optics_sw%spectral_def%nband
+    end if
+
+    if (config%do_cloud_aerosol_per_lw_g_point) then
+      nspeclw = config%gas_optics_lw%spectral_def%ng
+    else
+      nspeclw = config%gas_optics_lw%spectral_def%nband
+    end if
+
+    if (allocated(ao%wavelength_mono)) then
+      ! Monochromatic wavelengths also required
+      nmono = size(ao%wavelength_mono)
+    else
+      nmono = 0
+    end if
+
+    call ao%allocate(n_type_phobic, n_type_philic, nrh, nspeclw, nspecsw, nmono)
+
+    if (config%do_sw) then
+      call config%gas_optics_sw%spectral_def%calc_mapping(SolarReferenceTemperature, &
+           &  wavenumber, mapping, use_bands=(.not. config%do_cloud_aerosol_per_sw_g_point))
+
+      ao%mass_ext_sw_phobic = matmul(mapping, mass_ext_phobic)
+      ao%ssa_sw_phobic = matmul(mapping, mass_ext_phobic*ssa_phobic) &
+           &           / ao%mass_ext_sw_phobic
+      ao%g_sw_phobic = matmul(mapping, mass_ext_phobic*ssa_phobic*g_phobic) &
+           &         / (ao%mass_ext_sw_phobic*ao%ssa_sw_phobic)
+
+      if (ao%use_hydrophilic) then
+        do jtype = 1,n_type_philic
+          ao%mass_ext_sw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype))
+          ao%ssa_sw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype) &
+               &                                        *ssa_philic(:,:,jtype)) &
+               &           / ao%mass_ext_sw_philic(:,:,jtype)
+          ao%g_sw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype) &
+               &                       *ssa_philic(:,:,jtype)*g_philic(:,:,jtype)) &
+               &         / (ao%mass_ext_sw_philic(:,:,jtype)*ao%ssa_sw_philic(:,:,jtype))
+        end do
+      end if
+    end if
+    if (config%do_lw) then
+      call config%gas_optics_lw%spectral_def%calc_mapping(TerrestrialReferenceTemperature, &
+           &  wavenumber, mapping, use_bands=(.not. config%do_cloud_aerosol_per_lw_g_point))
+
+      ao%mass_ext_lw_phobic = matmul(mapping, mass_ext_phobic)
+      ao%ssa_lw_phobic = matmul(mapping, mass_ext_phobic*ssa_phobic) &
+           &           / ao%mass_ext_lw_phobic
+      ao%g_lw_phobic = matmul(mapping, mass_ext_phobic*ssa_phobic*g_phobic) &
+           &         / (ao%mass_ext_lw_phobic*ao%ssa_lw_phobic)
+
+      if (ao%use_hydrophilic) then
+        do jtype = 1,n_type_philic
+          ao%mass_ext_lw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype))
+          ao%ssa_lw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype) &
+               &                                        *ssa_philic(:,:,jtype)) &
+               &           / ao%mass_ext_lw_philic(:,:,jtype)
+          ao%g_lw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype) &
+               &                       *ssa_philic(:,:,jtype)*g_philic(:,:,jtype)) &
+               &         / (ao%mass_ext_lw_philic(:,:,jtype)*ao%ssa_lw_philic(:,:,jtype))
+        end do
+      end if
+    end if
+
+    if (allocated(ao%wavelength_mono)) then
+      ! Monochromatic wavelengths also required
+      do jwl = 1,nmono
+        ! Wavelength (m) to wavenumber (cm-1)
+        wavenumber_target = 0.01_jprb / ao%wavelength_mono(jwl)
+        ! Find index to first interpolation point, and its weight
+        if (wavenumber_target <= wavenumber(1)) then
+          weight1 = 1.0_jprb
+          iwn = 1
+        else if (wavenumber_target >= wavenumber(nwn)) then
+          iwn = nwn-1
+          weight1 = 0.0_jprb
+        else
+          iwn = 1
+          do while (wavenumber(iwn+1) < wavenumber_target .and. iwn < nwn-1)
+            iwn = iwn + 1
+          end do
+          weight1 = (wavenumber(iwn+1)-wavenumber_target) &
+               &  / (wavenumber(iwn+1)-wavenumber(iwn))
+        end if
+        ! Linear interpolation
+        ao%mass_ext_mono_phobic(jwl,:) = weight1 * mass_ext_phobic(iwn,:) &
+             &             + (1.0_jprb - weight1)* mass_ext_phobic(iwn+1,:)
+        ao%ssa_mono_phobic(jwl,:)      = weight1 * ssa_phobic(iwn,:) &
+             &             + (1.0_jprb - weight1)* ssa_phobic(iwn+1,:)
+        ao%g_mono_phobic(jwl,:)        = weight1 * g_phobic(iwn,:) &
+             &             + (1.0_jprb - weight1)* g_phobic(iwn+1,:)
+        ao%lidar_ratio_mono_phobic(jwl,:) = weight1 * lidar_ratio_phobic(iwn,:) &
+             &                + (1.0_jprb - weight1)* lidar_ratio_phobic(iwn+1,:)
+        if (ao%use_hydrophilic) then
+          ao%mass_ext_mono_philic(jwl,:,:) = weight1 * mass_ext_philic(iwn,:,:) &
+               &               + (1.0_jprb - weight1)* mass_ext_philic(iwn+1,:,:)
+          ao%ssa_mono_philic(jwl,:,:)      = weight1 * ssa_philic(iwn,:,:) &
+               &               + (1.0_jprb - weight1)* ssa_philic(iwn+1,:,:)
+          ao%g_mono_philic(jwl,:,:)        = weight1 * g_philic(iwn,:,:) &
+               &               + (1.0_jprb - weight1)* g_philic(iwn+1,:,:)
+          ao%lidar_ratio_mono_philic(jwl,:,:) = weight1 * lidar_ratio_philic(iwn,:,:) &
+               &                  + (1.0_jprb - weight1)* lidar_ratio_philic(iwn+1,:,:)
+        end if
+      end do
+    end if
+
+    ! Deallocate memory local to this routine
+    deallocate(mass_ext_phobic)
+    deallocate(ssa_phobic)
+    deallocate(g_phobic)
+    deallocate(lidar_ratio_phobic)
+    if (ao%use_hydrophilic) then
+      deallocate(mass_ext_philic)
+      deallocate(ssa_philic)
+      deallocate(g_philic)
+      deallocate(lidar_ratio_philic)
+    end if
+
+    if (lhook) call dr_hook('radiation_aerosol_optics:setup_general_aerosol_optics',1,hook_handle)
+
+  end subroutine setup_general_aerosol_optics_lmdz
+    
+
+  !---------------------------------------------------------------------
+  ! Read file containing legacy-style band-wise aerosol optical
+  ! properties and average to the spectral intervals of the current
+  ! gas-optics scheme
+  subroutine setup_general_aerosol_optics_legacy(config, file_name)
+
+    use parkind1,                      only : jprb
+    use yomhook,                       only : lhook, dr_hook
+    use easy_netcdf,                   only : netcdf_file
+    use radiation_config,              only : config_type
+    use radiation_aerosol_optics_data, only : aerosol_optics_type
+    use radiation_spectral_definition, only : SolarReferenceTemperature, &
+         &                                    TerrestrialReferenceTemperature
+
+    type(config_type), intent(inout), target :: config
+
+    ! The NetCDF file containing the aerosol optics data
+    character(len=*), intent(in) :: file_name
+
+    ! Mapping matrix between optical properties at the wavenumbers in
+    ! the file, and spectral intervals used by the gas-optics scheme
+    real(jprb), allocatable :: mapping(:,:), mapping_transp(:,:)
+
+    ! Pointer to the aerosol optics coefficients for brevity of access
+    type(aerosol_optics_type), pointer :: ao
+
+    ! Local copy of aerosol optical properties in the spectral
+    ! intervals of the file, which is deallocated when it goes out of
+    ! scope
+    type(aerosol_optics_type) :: ao_legacy
+
+    integer :: jtype
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_aerosol_optics:setup_general_aerosol_optics_legacy',0,hook_handle)
+    ao => config%aerosol_optics
+
+    ! Load file into a local structure
+    call ao_legacy%setup(file_name, iverbose=config%iverbosesetup)
+
+    ! Copy over scalars and coordinate variables
+    call ao%allocate(ao_legacy%n_type_phobic, ao_legacy%n_type_philic, ao_legacy%nrh, &
+         &           config%n_bands_lw, config%n_bands_sw, ao_legacy%n_mono_wl)
+    ao%description_phobic_str = ao_legacy%description_phobic_str
+    ao%description_philic_str = ao_legacy%description_philic_str
+    ao%rh_lower = ao_legacy%rh_lower
+
+    ! use_hydrophilic = ao_legacy%use_hydrophilic
+    ! ao%iclass = ao_legacy%iclass
+    ! ao%itype = ao_legacy%itype
+    ! ao%ntype = ao_legacy%ntype
+    ! ao%n_type_phobic = ao_legacy%n_type_phobic
+    ! ao%n_type_philic = ao_legacy%n_type_philic
+    ! ao%n_mono_wl = ao_legacy%n_mono_wl
+    ! ao%use_monochromatic = ao_legacy%use_monochromatic
+
+    if (config%do_sw) then
+      call config%gas_optics_sw%spectral_def%calc_mapping_from_wavenumber_bands(SolarReferenceTemperature, &
+           &  ao_legacy%wavenumber1_sw, ao_legacy%wavenumber2_sw, mapping_transp, &
+           &  use_bands=(.not. config%do_cloud_aerosol_per_sw_g_point))
+      if (allocated(mapping)) then
+        deallocate(mapping)
+      end if
+      allocate(mapping(config%n_bands_sw,ao_legacy%n_bands_sw))
+      mapping = transpose(mapping_transp)
+      ao%mass_ext_sw_phobic = matmul(mapping, ao_legacy%mass_ext_sw_phobic)
+      ao%ssa_sw_phobic = matmul(mapping, ao_legacy%mass_ext_sw_phobic*ao_legacy%ssa_sw_phobic) &
+           &           / ao%mass_ext_sw_phobic
+      ao%g_sw_phobic = matmul(mapping, ao_legacy%mass_ext_sw_phobic*ao_legacy%ssa_sw_phobic &
+           &                           *ao_legacy%g_sw_phobic) &
+           &         / (ao%mass_ext_sw_phobic*ao%ssa_sw_phobic)
+
+      if (ao%use_hydrophilic) then
+        do jtype = 1,ao%n_type_philic
+          ao%mass_ext_sw_philic(:,:,jtype) = matmul(mapping, ao_legacy%mass_ext_sw_philic(:,:,jtype))
+          ao%ssa_sw_philic(:,:,jtype) = matmul(mapping, ao_legacy%mass_ext_sw_philic(:,:,jtype) &
+               &                                        *ao_legacy%ssa_sw_philic(:,:,jtype)) &
+               &           / ao%mass_ext_sw_philic(:,:,jtype)
+          ao%g_sw_philic(:,:,jtype) = matmul(mapping, ao_legacy%mass_ext_sw_philic(:,:,jtype) &
+               &               *ao_legacy%ssa_sw_philic(:,:,jtype)*ao_legacy%g_sw_philic(:,:,jtype)) &
+               &         / (ao%mass_ext_sw_philic(:,:,jtype)*ao%ssa_sw_philic(:,:,jtype))
+        end do
+      end if
+    end if
+
+    if (config%do_lw) then
+      if (allocated(mapping_transp)) then
+        deallocate(mapping_transp)
+      end if
+      call config%gas_optics_lw%spectral_def%calc_mapping_from_wavenumber_bands(TerrestrialReferenceTemperature, &
+           &  ao_legacy%wavenumber1_lw, ao_legacy%wavenumber2_lw, mapping_transp, &
+           &  use_bands=(.not. config%do_cloud_aerosol_per_lw_g_point))
+      if (allocated(mapping)) then
+        deallocate(mapping)
+      end if
+      allocate(mapping(config%n_bands_lw,ao_legacy%n_bands_lw))
+      mapping = transpose(mapping_transp)
+      ao%mass_ext_lw_phobic = matmul(mapping, ao_legacy%mass_ext_lw_phobic)
+      ao%ssa_lw_phobic = matmul(mapping, ao_legacy%mass_ext_lw_phobic*ao_legacy%ssa_lw_phobic) &
+           &           / ao%mass_ext_lw_phobic
+      ao%g_lw_phobic = matmul(mapping, ao_legacy%mass_ext_lw_phobic*ao_legacy%ssa_lw_phobic &
+           &                           *ao_legacy%g_lw_phobic) &
+           &         / (ao%mass_ext_lw_phobic*ao%ssa_lw_phobic)
+
+      if (ao%use_hydrophilic) then
+        do jtype = 1,ao%n_type_philic
+          ao%mass_ext_lw_philic(:,:,jtype) = matmul(mapping, ao_legacy%mass_ext_lw_philic(:,:,jtype))
+          ao%ssa_lw_philic(:,:,jtype) = matmul(mapping, ao_legacy%mass_ext_lw_philic(:,:,jtype) &
+               &                                        *ao_legacy%ssa_lw_philic(:,:,jtype)) &
+               &           / ao%mass_ext_lw_philic(:,:,jtype)
+          ao%g_lw_philic(:,:,jtype) = matmul(mapping, ao_legacy%mass_ext_lw_philic(:,:,jtype) &
+               &               *ao_legacy%ssa_lw_philic(:,:,jtype)*ao_legacy%g_lw_philic(:,:,jtype)) &
+               &         / (ao%mass_ext_lw_philic(:,:,jtype)*ao%ssa_lw_philic(:,:,jtype))
+        end do
+      end if
+    end if
+
+    if (allocated(ao_legacy%wavelength_mono)) then
+      ao%wavelength_mono = ao_legacy%wavelength_mono
+      ao%mass_ext_mono_phobic = ao_legacy%mass_ext_mono_phobic
+      ao%ssa_mono_phobic = ao_legacy%ssa_mono_phobic
+      ao%g_mono_phobic = ao_legacy%g_mono_phobic
+      ao%lidar_ratio_mono_phobic = ao_legacy%lidar_ratio_mono_phobic
+      if (ao%use_hydrophilic) then
+        ao%mass_ext_mono_philic = ao_legacy%mass_ext_mono_philic
+        ao%ssa_mono_philic = ao_legacy%ssa_mono_philic
+        ao%g_mono_philic = ao_legacy%g_mono_philic
+        ao%lidar_ratio_mono_philic = ao_legacy%lidar_ratio_mono_philic
+      end if
+    end if
+
+    if (lhook) call dr_hook('radiation_aerosol_optics:setup_general_aerosol_optics_legacy',1,hook_handle)
+
+  end subroutine setup_general_aerosol_optics_legacy
 
 
@@ -132,5 +841,5 @@
 
     ! Loop indices for column, level, g point, band and aerosol type
-    integer :: jcol, jlev, jg, jtype
+    integer :: jcol, jlev, jg, jtype, jband
 
     ! Range of levels over which aerosols are present
@@ -139,4 +848,7 @@
     ! Indices to spectral band and relative humidity look-up table
     integer :: iband, irh
+
+    ! Short cut for ao%itype(jtype)
+    integer :: itype
 
     ! Pointer to the aerosol optics coefficients for brevity of access
@@ -180,8 +892,8 @@
 
       ! Set variables to zero that may not have been previously
-      g_sw = 0.0_jprb
+      g_sw(:,:,istartcol:iendcol) = 0.0_jprb
       if (config%do_lw_aerosol_scattering) then
-        ssa_lw = 0.0_jprb
-        g_lw   = 0.0_jprb
+        ssa_lw(:,:,istartcol:iendcol) = 0.0_jprb
+        g_lw(:,:,istartcol:iendcol)   = 0.0_jprb
       end if
 
@@ -210,4 +922,7 @@
 
           do jtype = 1,config%n_aerosol_types
+
+            itype = ao%itype(jtype)
+
             ! Add the optical depth, scattering optical depth and
             ! scattering optical depth-weighted asymmetry factor for
@@ -216,21 +931,23 @@
             ! 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))
+              do jband = 1,config%n_bands_sw
+                local_od_sw(jband) = factor * aerosol%mixing_ratio(jcol,jlev,jtype) &
+                     &  * ao%mass_ext_sw_phobic(jband,itype)
+                od_sw_aerosol(jband) = od_sw_aerosol(jband) + local_od_sw(jband)
+                scat_sw_aerosol(jband) = scat_sw_aerosol(jband) &
+                     &  + local_od_sw(jband) * ao%ssa_sw_phobic(jband,itype)
+                scat_g_sw_aerosol(jband) = scat_g_sw_aerosol(jband) &
+                     &  + local_od_sw(jband) * ao%ssa_sw_phobic(jband,itype) &
+                     &  * ao%g_sw_phobic(jband,itype)
+              end do
               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))
+                     &  * ao%mass_ext_lw_phobic(:,itype)
                 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))
+                     &  + local_od_lw * ao%ssa_lw_phobic(:,itype)
                 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))
+                     &  + local_od_lw * ao%ssa_lw_phobic(:,itype) &
+                     &  * ao%g_lw_phobic(:,itype)
               else
                 ! If aerosol longwave scattering is not included then we
@@ -239,27 +956,29 @@
                 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)))
+                     &  * ao%mass_ext_lw_phobic(:,itype) &
+                     &  * (1.0_jprb - ao%ssa_lw_phobic(:,itype))
               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))
+              do jband = 1,config%n_bands_sw
+                local_od_sw(jband) = factor * aerosol%mixing_ratio(jcol,jlev,jtype) &
+                     &  * ao%mass_ext_sw_philic(jband,irh,itype)
+                od_sw_aerosol(jband) = od_sw_aerosol(jband) + local_od_sw(jband)
+                scat_sw_aerosol(jband) = scat_sw_aerosol(jband) &
+                     &  + local_od_sw(jband) * ao%ssa_sw_philic(jband,irh,itype)
+                scat_g_sw_aerosol(jband) = scat_g_sw_aerosol(jband) &
+                     &  + local_od_sw(jband) * ao%ssa_sw_philic(jband,irh,itype) &
+                     &  * ao%g_sw_philic(jband,irh,itype)
+              end do
               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))
+                     &  * ao%mass_ext_lw_philic(:,irh,itype)
                 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))
+                     &  + local_od_lw * ao%ssa_lw_philic(:,irh,itype)
                 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))
+                     &  + local_od_lw * ao%ssa_lw_philic(:,irh,itype) &
+                     &  * ao%g_lw_philic(:,irh,itype)
               else
                 ! If aerosol longwave scattering is not included then we
@@ -268,6 +987,6 @@
                 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)))
+                     &  * ao%mass_ext_lw_philic(:,irh,itype) &
+                     &  * (1.0_jprb - ao%ssa_lw_philic(:,irh,itype))
               end if
             end if
@@ -289,8 +1008,8 @@
           ! 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)
+          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)
+            if (local_od > 0.0_jprb .and. od_sw_aerosol(iband) > 0.0_jprb) then
               local_scat = ssa_sw(jg,jlev,jcol) * od_sw(jg,jlev,jcol) &
                    &  + scat_sw_aerosol(iband)
@@ -298,9 +1017,11 @@
               ! simply weights the aerosol asymmetry by the scattering
               ! optical depth
-              g_sw(jg,jlev,jcol) = scat_g_sw_aerosol(iband) / local_scat
+              if (local_scat > 0.0_jprb) then
+                g_sw(jg,jlev,jcol) = scat_g_sw_aerosol(iband) / local_scat
+              end if
               ssa_sw(jg,jlev,jcol) = local_scat / local_od
               od_sw (jg,jlev,jcol) = local_od
-            end do
-          end if
+            end if
+          end do
 
           ! Combine aerosol longwave scattering properties with gas
@@ -314,5 +1035,6 @@
             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
+              local_od = od_lw(jg,jlev,jcol) + od_lw_aerosol(iband)
+              if (local_od > 0.0_jprb .and. 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
@@ -320,8 +1042,5 @@
                   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
@@ -384,12 +1103,12 @@
     ! a point in space for each spectral band of the shortwave and
     ! longwave spectrum
-    real(jprb), dimension(config%n_bands_sw) &
+    real(jprb), dimension(config%n_bands_sw,nlev) &
          & :: 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) &
+    real(jprb), dimension(config%n_bands_lw,nlev) :: od_lw_aerosol
+    real(jprb), dimension(config%n_bands_lw_if_scattering,nlev) &
          & :: scat_lw_aerosol, scat_g_lw_aerosol
 
     ! Loop indices for column, level, g point and band
-    integer :: jcol, jlev, jg
+    integer :: jcol, jlev, jg, jb
 
     ! Range of levels over which aerosols are present
@@ -416,35 +1135,41 @@
 
       ! Set variables to zero that may not have been previously
-      g_sw = 0.0_jprb
+      g_sw(:,:,istartcol:iendcol) = 0.0_jprb
 
       ! Loop over position
       do jcol = istartcol,iendcol
+! Added for DWD (2020)
+!NEC$ forced_collapse
         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 jb = 1,config%n_bands_sw
+            od_sw_aerosol(jb,jlev) = aerosol%od_sw(jb,jlev,jcol)
+            scat_sw_aerosol(jb,jlev) = aerosol%ssa_sw(jb,jlev,jcol) * od_sw_aerosol(jb,jlev)
+            scat_g_sw_aerosol(jb,jlev) = aerosol%g_sw(jb,jlev,jcol) * scat_sw_aerosol(jb,jlev)
+
+            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(jb,jlev), scat_sw_aerosol(jb,jlev), &
+                   &                         scat_g_sw_aerosol(jb,jlev))
+            end if
+          end do
+        end do
+        ! Combine aerosol shortwave scattering properties with gas
+        ! properties (noting that any gas scattering will have an
+        ! asymmetry factor of zero)
+        do jlev = istartlev,iendlev
+          if (od_sw_aerosol(1,jlev) > 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_od = od_sw(jg,jlev,jcol) + od_sw_aerosol(iband,jlev)
               local_scat = ssa_sw(jg,jlev,jcol) * od_sw(jg,jlev,jcol) &
-                   &  + scat_sw_aerosol(iband)
+                   &  + scat_sw_aerosol(iband,jlev)
               ! 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
+              g_sw(jg,jlev,jcol) = scat_g_sw_aerosol(iband,jlev) / local_scat
+              local_od = od_sw(jg,jlev,jcol) + od_sw_aerosol(iband,jlev)
               ssa_sw(jg,jlev,jcol) = local_scat / local_od
               od_sw (jg,jlev,jcol) = local_od
@@ -469,30 +1194,33 @@
 
       if (config%do_lw_aerosol_scattering) then
-        ssa_lw = 0.0_jprb
-        g_lw   = 0.0_jprb
+        ssa_lw(:,:,istartcol:iendcol) = 0.0_jprb
+        g_lw(:,:,istartcol:iendcol)   = 0.0_jprb
  
         ! Loop over position
         do jcol = istartcol,iendcol
+! Added for DWD (2020)
+!NEC$ forced_collapse
           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
+            do jb = 1,config%n_bands_lw
+              od_lw_aerosol(jb,jlev) = aerosol%od_lw(jb,jlev,jcol)
+              scat_lw_aerosol(jb,jlev) = aerosol%ssa_lw(jb,jlev,jcol) * od_lw_aerosol(jb,jlev)
+              scat_g_lw_aerosol(jb,jlev) = aerosol%g_lw(jb,jlev,jcol) * scat_lw_aerosol(jb,jlev)
             
-            call delta_eddington_extensive(od_lw_aerosol, scat_lw_aerosol, &
-                 &                         scat_g_lw_aerosol)
-            
+              call delta_eddington_extensive(od_lw_aerosol(jb,jlev), scat_lw_aerosol(jb,jlev), &
+                   &                         scat_g_lw_aerosol(jb,jlev))
+            end do
+          end do
+          do jlev = istartlev,iendlev
             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
+              if (od_lw_aerosol(iband,jlev) > 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
+                if (scat_lw_aerosol(iband,jlev) > 0.0_jprb) then
+                  g_lw(jg,jlev,jcol) = scat_g_lw_aerosol(iband,jlev) &
+                       &  / scat_lw_aerosol(iband,jlev)
                 end if
-                local_od = od_lw(jg,jlev,jcol) + od_lw_aerosol(iband)
-                ssa_lw(jg,jlev,jcol) = scat_lw_aerosol(iband) / local_od
+                local_od = od_lw(jg,jlev,jcol) + od_lw_aerosol(iband,jlev)
+                ssa_lw(jg,jlev,jcol) = scat_lw_aerosol(iband,jlev) / local_od
                 od_lw (jg,jlev,jcol) = local_od
               end if
@@ -505,13 +1233,19 @@
         ! Loop over position
         do jcol = istartcol,iendcol
+! Added for DWD (2020)
+!NEC$ forced_collapse
           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 jb = 1, config%n_bands_lw
+              od_lw_aerosol(jb,jlev) = aerosol%od_lw(jb,jlev,jcol) &
+                 &  * (1.0_jprb - aerosol%ssa_lw(jb,jlev,jcol))
+            end do
+          end do
+          do jlev = istartlev,iendlev
             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))
+                   &  + od_lw_aerosol(config%i_band_from_reordered_g_lw(jg),jlev)
             end do
           end do
@@ -530,11 +1264,12 @@
   ! 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)
+  ! mass-extinction coefficient, i.e. the extinction cross section per
+  ! unit mass, for aerosol of type "itype" at the specified wavelength
+  ! (m). For hydrophilic types, the value at the first relative
+  ! humidity bin is taken.
+  function dry_aerosol_mass_extinction(config, itype, wavelength)
 
     use parkind1,                      only : jprb
+    use radiation_io,                  only : nulerr, radiation_abort
     use radiation_config,              only : config_type
     use radiation_aerosol_optics_data, only : aerosol_optics_type, &
@@ -544,8 +1279,14 @@
     type(config_type), intent(in), target :: config
 
-    ! Aerosol type and shortwave band as indices to the array
-    integer, intent(in) :: itype, iband
+    ! Aerosol type
+    integer, intent(in) :: itype
+
+    ! Wavelength (m)
+    real(jprb), intent(in) :: wavelength
     
-    real(jprb) dry_aerosol_sw_mass_extinction
+    real(jprb) :: dry_aerosol_mass_extinction
+
+    ! Index to the monochromatic wavelength requested
+    integer :: imono
 
     ! Pointer to the aerosol optics coefficients for brevity of access
@@ -554,23 +1295,30 @@
     ao => config%aerosol_optics
 
+    imono = minloc(abs(wavelength - ao%wavelength_mono), 1)
+
+    if (abs(wavelength - ao%wavelength_mono(imono))/wavelength > 0.01_jprb) then
+      write(nulerr,'(a,e8.4,a)') '*** Error: requested wavelength ', &
+           &  wavelength, ' not within 1% of stored wavelengths'
+      call radiation_abort()
+     end if
+
     if (ao%iclass(itype) == IAerosolClassHydrophobic) then
-      dry_aerosol_sw_mass_extinction = ao%mass_ext_sw_phobic(iband,ao%itype(itype))
+      dry_aerosol_mass_extinction = ao%mass_ext_mono_phobic(imono,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))
+      dry_aerosol_mass_extinction = ao%mass_ext_mono_philic(imono,1,ao%itype(itype))
     else
-      dry_aerosol_sw_mass_extinction = 0.0_jprb
-    end if
-
-  end function dry_aerosol_sw_mass_extinction
+      dry_aerosol_mass_extinction = 0.0_jprb
+    end if
+
+  end function dry_aerosol_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)
+  ! Compute aerosol extinction coefficient at a particular wavelength
+  ! and a single height - this is useful for visibility diagnostics
+  subroutine aerosol_extinction(ncol,istartcol,iendcol, &
+       &  config, wavelength, mixing_ratio, relative_humidity, extinction)
 
     use parkind1,                      only : jprb
@@ -585,5 +1333,5 @@
     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)  :: wavelength ! Requested wavelength (m)
     real(jprb), intent(in)  :: mixing_ratio(ncol,config%n_aerosol_types)
     real(jprb), intent(in)  :: relative_humidity(ncol)
@@ -592,4 +1340,7 @@
     ! Local aerosol extinction
     real(jprb) :: ext
+
+    ! Index to the monochromatic wavelength requested
+    integer :: imono
 
     ! Pointer to the aerosol optics coefficients for brevity of access
@@ -604,5 +1355,5 @@
     real(jprb) :: hook_handle
 
-    if (lhook) call dr_hook('radiation_aerosol_optics:aerosol_sw_extinction',0,hook_handle)
+    if (lhook) call dr_hook('radiation_aerosol_optics:aerosol_extinction',0,hook_handle)
 
     do jtype = 1,config%n_aerosol_types
@@ -614,4 +1365,12 @@
 
     ao => config%aerosol_optics
+
+    imono = minloc(abs(wavelength - ao%wavelength_mono), 1)
+
+    if (abs(wavelength - ao%wavelength_mono(imono))/wavelength > 0.01_jprb) then
+      write(nulerr,'(a,e8.4,a)') '*** Error: requested wavelength ', &
+           &  wavelength, ' not within 1% of stored wavelengths'
+      call radiation_abort()
+     end if
 
     ! Loop over position
@@ -624,8 +1383,8 @@
         if (ao%iclass(jtype) == IAerosolClassHydrophobic) then
           ext = ext + mixing_ratio(jcol,jtype) &
-               &    * ao%mass_ext_sw_phobic(iband,ao%itype(jtype))
+               &    * ao%mass_ext_mono_phobic(imono,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))
+               &    * ao%mass_ext_mono_philic(imono,irh,ao%itype(jtype))
         end if
       end do
@@ -634,7 +1393,7 @@
     end do
 
-    if (lhook) call dr_hook('radiation_aerosol_optics:aerosol_sw_extinction',1,hook_handle)
-
-  end subroutine aerosol_sw_extinction
+    if (lhook) call dr_hook('radiation_aerosol_optics:aerosol_extinction',1,hook_handle)
+
+  end subroutine aerosol_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 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_aerosol_optics_data.F90	(revision 4489)
@@ -57,4 +57,10 @@
      integer, allocatable, dimension(:) :: itype
 
+     ! Wavenumber (cm-1) upper and lower bounds of each spectral
+     ! interval, which if used in the RRTMG gas optics scheme should
+     ! match its band bounds
+     real(jprb), allocatable, dimension(:) :: wavenumber1_sw, wavenumber2_sw
+     real(jprb), allocatable, dimension(:) :: wavenumber1_lw, wavenumber2_lw
+
      ! Scattering properties are provided separately in the shortwave
      ! and longwave for hydrophobic and hydrophilic aerosols.
@@ -64,19 +70,27 @@
           &  ssa_sw_phobic,      & ! Single scattering albedo
           &  g_sw_phobic,        & ! Asymmetry factor
+!          &  ssa_g_sw_phobic,    & ! ssa*g
           &  mass_ext_lw_phobic, & ! Mass-extinction coefficient (m2 kg-1)
+!          &  mass_abs_lw_phobic, & ! Mass-absorption coefficient (m2 kg-1)
           &  ssa_lw_phobic,      & ! Single scattering albedo
           &  g_lw_phobic           ! Asymmetry factor
 
-     ! Hydrophilic aerosols are dimensioned (nband, nrh, n_type_philic):
+     ! 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
+ !         &  ssa_g_sw_philic,    & ! ssa*g
           &  mass_ext_lw_philic, & ! Mass-extinction coefficient (m2 kg-1)
+ !         &  mass_abs_lw_philic, & ! Mass-absorption 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)
+     ! Wavelengths at which monochromatic properties are stored,
+     ! dimensioned (n_mono_wl), units metres
+     real(jprb), allocatable :: wavelength_mono(:)
+
+     ! Scattering properties at selected monochromatic wavelengths
+     ! (n_mono_wl,n_type_phobic)
      real(jprb), allocatable, dimension(:,:) :: &
           &  mass_ext_mono_phobic, & ! Mass-extinction coefficient (m2 kg-1)
@@ -84,4 +98,5 @@
           &  g_mono_phobic,        & ! Asymmetry factor
           &  lidar_ratio_mono_phobic ! Lidar Ratio
+     ! ...hydrophilic aerosols dimensioned (n_mono_wl,nrh,n_type_philic):
      real(jprb), allocatable, dimension(:,:,:) :: &
           &  mass_ext_mono_philic, & ! Mass-extinction coefficient (m2 kg-1)
@@ -104,8 +119,9 @@
      ! The number of hydrophobic and hydrophilic types read from the
      ! aerosol optics file
-     integer :: n_type_phobic, n_type_philic
+     integer :: n_type_phobic = 0
+     integer :: n_type_philic = 0
 
      ! Number of relative humidity bins
-     integer :: nrh
+     integer :: nrh = 0
 
      ! Number of longwave and shortwave bands of the data in the file,
@@ -121,4 +137,7 @@
    contains
      procedure :: setup => setup_aerosol_optics
+     procedure :: save  => save_aerosol_optics
+     procedure :: allocate
+     procedure :: initialize_types
      procedure :: set_hydrophobic_type
      procedure :: set_hydrophilic_type
@@ -135,5 +154,5 @@
   !---------------------------------------------------------------------
   ! Setup aerosol optics coefficients by reading them from a file
-  subroutine setup_aerosol_optics(this, file_name, ntype, iverbose)
+  subroutine setup_aerosol_optics(this, file_name, iverbose)
 
     use yomhook,              only : lhook, dr_hook
@@ -143,10 +162,12 @@
     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
+
+    real(jprb), allocatable :: wavelength_tmp(:)
     integer            :: iverb
+
     real(jprb)         :: hook_handle
 
@@ -168,4 +189,10 @@
       this%use_hydrophilic = .false.
     end if
+
+    ! Read the wavenumber bounds
+    call file%get('wavenumber1_sw', this%wavenumber1_sw)
+    call file%get('wavenumber2_sw', this%wavenumber2_sw)
+    call file%get('wavenumber1_lw', this%wavenumber1_lw)
+    call file%get('wavenumber2_lw', this%wavenumber2_lw)
 
     ! Read the raw scattering data
@@ -180,4 +207,8 @@
          &                         this%description_phobic_str)
 
+    ! Precompute ssa*g for the shortwave and mass-absorption for the
+    ! longwave - TBD FIX
+    !allocate(this%ssa_g_sw_phobic(...
+
     if (this%use_hydrophilic) then
       call file%get('mass_ext_sw_hydrophilic', this%mass_ext_sw_philic)
@@ -194,8 +225,33 @@
     end if
 
-    ! Read the raw scattering data at selected wavelengths if
-    ! available in the input file
+    ! Read the monochromatic scattering data at selected wavelengths
+    ! if available in the input file
     if (file%exists('mass_ext_mono_hydrophobic')) then
       this%use_monochromatic = .true.
+
+      if (allocated(this%wavelength_mono)) then
+        ! User has provided required monochromatic wavelengths, which
+        ! must match those in the file (in the more recent "general"
+        ! aerosol optics, interpolation provides optical properties at
+        ! the requested wavelengths)
+        call file%get('wavelength_mono', wavelength_tmp)
+        if (size(wavelength_tmp) /= size(this%wavelength_mono)) then
+          write(nulerr,'(a,i0,a,i0,a)') '*** Error: ', size(this%wavelength_mono), &
+               &  ' monochromatic wavelengths requested but ', &
+               &  size(wavelength_tmp), ' in file'
+          call radiation_abort('Radiation configuration error')
+        end if
+        if (any(abs(this%wavelength_mono-wavelength_tmp) &
+               &  / this%wavelength_mono > 0.01_jprb)) then
+          write(nulerr,'(a,a)') '*** Error: requested monochromatic wavelengths', &
+               &  'must all be within 1% of values in file'
+          call radiation_abort('Radiation configuration error')
+        end if
+      else
+        ! User has not provided required wavelengths, so we save the
+        ! monochromatic wavelengths in the file
+        call file%get('wavelength_mono', this%wavelength_mono)
+      end if
+
       call file%get('mass_ext_mono_hydrophobic', this%mass_ext_mono_phobic)
       call file%get('ssa_mono_hydrophobic',      this%ssa_mono_phobic)
@@ -233,14 +289,14 @@
         write(nulerr,'(a,a)') '*** Error: mass extinction for hydrophilic and hydrophobic ', &
              &                'aerosol have different numbers of longwave bands'
-        call radiation_abort()
+        call radiation_abort('Radiation configuration error')
       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()
+        call radiation_abort('Radiation configuration error')
       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()
+        call radiation_abort('Radiation configuration error')
       end if
 
@@ -250,4 +306,16 @@
     end if
 
+    if (lhook) call dr_hook('radiation_aerosol_optics_data:setup',1,hook_handle)
+
+  end subroutine setup_aerosol_optics
+
+
+  !---------------------------------------------------------------------
+  ! Initialize the arrays describing the user's aerosol types
+  subroutine initialize_types(this, ntype)
+
+    class(aerosol_optics_type), intent(inout) :: this
+    integer,                    intent(in)    :: ntype
+    
     ! Allocate memory for mapping arrays
     this%ntype = ntype
@@ -258,7 +326,174 @@
     this%itype  = 0
 
-    if (lhook) call dr_hook('radiation_aerosol_optics_data:setup',1,hook_handle)
-
-  end subroutine setup_aerosol_optics
+  end subroutine initialize_types
+
+  !---------------------------------------------------------------------
+  ! Allocate arrays for aerosol optics data type
+  subroutine allocate(this, n_type_phobic, n_type_philic, nrh, &
+       &              n_bands_lw, n_bands_sw, n_mono_wl)
+
+    use yomhook,     only : lhook, dr_hook
+
+    class(aerosol_optics_type), intent(inout) :: this
+    integer, intent(in) :: n_type_phobic, n_type_philic, nrh
+    integer, intent(in) :: n_bands_lw, n_bands_sw, n_mono_wl
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_aerosol_optics_data:allocate',0,hook_handle)
+
+    this%n_type_phobic = n_type_phobic
+    this%n_type_philic = n_type_philic
+    this%nrh           = nrh
+    this%n_bands_lw    = n_bands_lw
+    this%n_bands_sw    = n_bands_sw
+    this%n_mono_wl     = n_mono_wl
+
+    if (n_type_philic > 0) then
+      this%use_hydrophilic = .true.
+    else
+      this%use_hydrophilic = .false.
+    end if
+
+    if (n_bands_sw > 0) then
+      allocate(this%mass_ext_sw_phobic(n_bands_sw, n_type_phobic))
+      allocate(this%ssa_sw_phobic(n_bands_sw, n_type_phobic))
+      allocate(this%g_sw_phobic(n_bands_sw, n_type_phobic))
+    end if
+    if (n_bands_lw > 0) then
+      allocate(this%mass_ext_lw_phobic(n_bands_lw, n_type_phobic))
+      allocate(this%ssa_lw_phobic(n_bands_lw, n_type_phobic))
+      allocate(this%g_lw_phobic(n_bands_lw, n_type_phobic))
+    end if
+    if (n_mono_wl > 0) then
+      allocate(this%mass_ext_mono_phobic(n_mono_wl, n_type_phobic))
+      allocate(this%ssa_mono_phobic(n_mono_wl, n_type_phobic))
+      allocate(this%g_mono_phobic(n_mono_wl, n_type_phobic))
+      allocate(this%lidar_ratio_mono_phobic(n_mono_wl, n_type_phobic))
+    end if
+
+    if (n_type_philic > 0 .and. nrh > 0) then
+      if (n_bands_sw > 0) then
+        allocate(this%mass_ext_sw_philic(n_bands_sw, nrh, n_type_philic))
+        allocate(this%ssa_sw_philic(n_bands_sw, nrh, n_type_philic))
+        allocate(this%g_sw_philic(n_bands_sw, nrh, n_type_philic))
+      end if
+      if (n_bands_lw > 0) then
+        allocate(this%mass_ext_lw_philic(n_bands_lw, nrh, n_type_philic))
+        allocate(this%ssa_lw_philic(n_bands_lw, nrh, n_type_philic))
+        allocate(this%g_lw_philic(n_bands_lw, nrh, n_type_philic))
+      end if
+      if (n_mono_wl > 0) then
+        allocate(this%mass_ext_mono_philic(n_mono_wl, nrh, n_type_philic))
+        allocate(this%ssa_mono_philic(n_mono_wl, nrh, n_type_philic))
+        allocate(this%g_mono_philic(n_mono_wl, nrh, n_type_philic))
+        allocate(this%lidar_ratio_mono_philic(n_mono_wl, nrh, n_type_philic))
+      end if
+    end if
+
+    if (lhook) call dr_hook('radiation_aerosol_optics_data:allocate',1,hook_handle)
+
+  end subroutine allocate
+
+
+  !---------------------------------------------------------------------
+  subroutine save_aerosol_optics(this, file_name, iverbose)
+
+    use yomhook,     only : lhook, dr_hook
+    use easy_netcdf, only : netcdf_file
+
+    class(aerosol_optics_type), intent(inout) :: this
+    character(len=*),           intent(in)    :: file_name
+    integer,          optional, intent(in)    :: iverbose
+
+    ! Object for output NetCDF file
+    type(netcdf_file) :: out_file
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_aerosol_optics_data:save',0,hook_handle)
+
+    ! Create the file
+    call out_file%create(trim(file_name), iverbose=iverbose)
+
+    ! Define dimensions
+    call out_file%define_dimension("band_lw", this%n_bands_lw)
+    call out_file%define_dimension("band_sw", this%n_bands_sw)
+    call out_file%define_dimension("hydrophilic", this%n_type_philic)
+    call out_file%define_dimension("hydrophobic", this%n_type_phobic)
+    call out_file%define_dimension("relative_humidity", this%nrh)
+    !if (this%use_monochromatic) then
+    !  call out_file%define_dimension("wavelength_mono", this%n_mono_wl)
+    !end if
+
+    ! Put global attributes
+    call out_file%put_global_attributes( &
+         &   title_str="Aerosol optical properties in the spectral intervals of the gas-optics scheme for ecRad", &
+         &   source_str="ecRad offline radiation model")
+    call out_file%put_global_attribute( &
+         &  "description_hydrophobic", this%description_phobic_str)
+    call out_file%put_global_attribute( &
+         &  "description_hydrophilic", this%description_philic_str)
+
+    ! Define variables
+    call out_file%define_variable("mass_ext_sw_hydrophobic", units_str="m2 kg-1", &
+         &  long_name="Shortwave mass-extinction coefficient of hydrophobic aerosols", &
+         &  dim2_name="hydrophobic", dim1_name="band_sw")
+    call out_file%define_variable("ssa_sw_hydrophobic", units_str="1", &
+         &  long_name="Shortwave single scattering albedo of hydrophobic aerosols", &
+         &  dim2_name="hydrophobic", dim1_name="band_sw")
+    call out_file%define_variable("asymmetry_sw_hydrophobic", units_str="1", &
+         &  long_name="Shortwave asymmetry factor of hydrophobic aerosols", &
+         &  dim2_name="hydrophobic", dim1_name="band_sw")
+
+    call out_file%define_variable("mass_ext_lw_hydrophobic", units_str="m2 kg-1", &
+         &  long_name="Longwave mass-extinction coefficient of hydrophobic aerosols", &
+         &  dim2_name="hydrophobic", dim1_name="band_lw")
+    call out_file%define_variable("ssa_lw_hydrophobic", units_str="1", &
+         &  long_name="Longwave single scattering albedo of hydrophobic aerosols", &
+         &  dim2_name="hydrophobic", dim1_name="band_lw")
+    call out_file%define_variable("asymmetry_lw_hydrophobic", units_str="1", &
+         &  long_name="Longwave asymmetry factor of hydrophobic aerosols", &
+         &  dim2_name="hydrophobic", dim1_name="band_lw")
+
+    call out_file%define_variable("mass_ext_sw_hydrophilic", units_str="m2 kg-1", &
+         &  long_name="Shortwave mass-extinction coefficient of hydrophilic aerosols", &
+         &  dim3_name="hydrophilic", dim2_name="relative_humidity", dim1_name="band_sw")
+    call out_file%define_variable("ssa_sw_hydrophilic", units_str="1", &
+         &  long_name="Shortwave single scattering albedo of hydrophilic aerosols", &
+         &  dim3_name="hydrophilic", dim2_name="relative_humidity", dim1_name="band_sw")
+    call out_file%define_variable("asymmetry_sw_hydrophilic", units_str="1", &
+         &  long_name="Shortwave asymmetry factor of hydrophilic aerosols", &
+         &  dim3_name="hydrophilic", dim2_name="relative_humidity", dim1_name="band_sw")
+
+    call out_file%define_variable("mass_ext_lw_hydrophilic", units_str="m2 kg-1", &
+         &  long_name="Longwave mass-extinction coefficient of hydrophilic aerosols", &
+         &  dim3_name="hydrophilic", dim2_name="relative_humidity", dim1_name="band_lw")
+    call out_file%define_variable("ssa_lw_hydrophilic", units_str="1", &
+         &  long_name="Longwave single scattering albedo of hydrophilic aerosols", &
+         &  dim3_name="hydrophilic", dim2_name="relative_humidity", dim1_name="band_lw")
+    call out_file%define_variable("asymmetry_lw_hydrophilic", units_str="1", &
+         &  long_name="Longwave asymmetry factor of hydrophilic aerosols", &
+         &  dim3_name="hydrophilic", dim2_name="relative_humidity", dim1_name="band_lw")
+
+    ! Write variables
+    call out_file%put("mass_ext_sw_hydrophobic", this%mass_ext_sw_phobic)
+    call out_file%put("ssa_sw_hydrophobic", this%ssa_sw_phobic)
+    call out_file%put("asymmetry_sw_hydrophobic", this%g_sw_phobic)
+    call out_file%put("mass_ext_lw_hydrophobic", this%mass_ext_lw_phobic)
+    call out_file%put("ssa_lw_hydrophobic", this%ssa_lw_phobic)
+    call out_file%put("asymmetry_lw_hydrophobic", this%g_lw_phobic)
+    call out_file%put("mass_ext_sw_hydrophilic", this%mass_ext_sw_philic)
+    call out_file%put("ssa_sw_hydrophilic", this%ssa_sw_philic)
+    call out_file%put("asymmetry_sw_hydrophilic", this%g_sw_philic)
+    call out_file%put("mass_ext_lw_hydrophilic", this%mass_ext_lw_philic)
+    call out_file%put("ssa_lw_hydrophilic", this%ssa_lw_philic)
+    call out_file%put("asymmetry_lw_hydrophilic", this%g_lw_philic)
+
+    call out_file%close()
+
+    if (lhook) call dr_hook('radiation_aerosol_optics_data:save',1,hook_handle)
+
+  end subroutine save_aerosol_optics
 
 
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_aerosol_optics_description.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_aerosol_optics_description.F90	(revision 4489)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_aerosol_optics_description.F90	(revision 4489)
@@ -0,0 +1,332 @@
+! radiation_aerosol_optics_description.F90 - Type to store aerosol optics metadata
+!
+! (C) Copyright 2022- 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_aerosol_optics_description
+
+  use parkind1,      only : jprb
+
+  implicit none
+  public
+
+  !---------------------------------------------------------------------
+  ! This type holds the metadata from an aerosol optical property
+  ! file, enabling the user to request the index to the aerosol type
+  ! with particular properties.  Note that string information is held
+  ! in the form of 2D arrays of single characters, so comparison to
+  ! character strings requires the to_string helper function at the
+  ! end of this file.
+  type aerosol_optics_description_type
+
+    ! Two-character code describing the aerosol family, dimensioned
+    ! (2,naer), e.g.
+    !   SS: Sea salt
+    !   OM: Organic matter
+    !   SU: Sulfate
+    !   OB: Secondary organic biogenic
+    !   OA: Secondary organic anthropogenic
+    !   AM: Fine-mode ammonium sulfate
+    !   NI: Nitrate
+    !   DD: Desert dust
+    !   BC: Black carbon
+    character(len=1), allocatable :: code_phobic(:,:)
+    character(len=1), allocatable :: code_philic(:,:)
+
+    ! Size bin, typically 1-2 or 1-3 in order fine to coarse, or zero
+    ! if no division by size is used, dimensioned (naer)
+    integer, allocatable :: bin_phobic(:)
+    integer, allocatable :: bin_philic(:)
+
+    ! Character string characterizing the optical model, e.g. OPAC,
+    ! GACP, GLOMAP, Dubovik2002 etc.
+    character(len=1), allocatable :: optical_model_phobic(:,:)
+    character(len=1), allocatable :: optical_model_philic(:,:)
+
+    ! The user can call preferred_optical_model to specify that a
+    ! certain optical model for a certain aerosol family is to be
+    ! preferred when get_index is called
+    logical, allocatable :: is_preferred_phobic(:)
+    logical, allocatable :: is_preferred_philic(:)
+
+  contains
+    procedure :: read
+    procedure :: preferred_optical_model
+    procedure :: get_index
+
+  end type aerosol_optics_description_type
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Read optical property file file_name into an
+  ! aerosol_optics_description_type object
+  subroutine read(this, file_name, iverbose)
+
+    use yomhook,              only : lhook, dr_hook
+    use easy_netcdf,          only : netcdf_file
+
+    class(aerosol_optics_description_type), intent(inout) :: this
+    character(len=*), intent(in)              :: file_name
+    integer, intent(in), optional             :: iverbose
+    
+    ! The NetCDF file containing the aerosol optics data
+    type(netcdf_file)  :: file
+
+    real(jprb)         :: hook_handle
+
+    if (lhook) call dr_hook('radiation_aerosol_optics_description:load',0,hook_handle)
+
+    ! Open the aerosol scattering file and configure the way it is
+    ! read
+    call file%open(trim(file_name), iverbose=iverbose)
+
+    ! Read metadata variables
+    call file%get('code_hydrophilic', this%code_philic)
+    call file%get('code_hydrophobic', this%code_phobic)
+    call file%get('bin_hydrophilic',  this%bin_philic)
+    call file%get('bin_hydrophobic',  this%bin_phobic)
+    call file%get('optical_model_hydrophilic', this%optical_model_philic)
+    call file%get('optical_model_hydrophobic', this%optical_model_phobic)
+
+    ! Allocate logical arrays of the appropriate size and set to FALSE
+    allocate(this%is_preferred_philic(size(this%bin_philic)))
+    allocate(this%is_preferred_phobic(size(this%bin_phobic)))
+    this%is_preferred_philic = .false.
+    this%is_preferred_phobic = .false.
+
+    call file%close()
+
+    if (lhook) call dr_hook('radiation_aerosol_optics_description:load',1,hook_handle)
+
+  end subroutine read
+
+  !---------------------------------------------------------------------
+  ! Specify the preferred optical model for a particular aerosol
+  ! family, e.g. "call
+  ! aer_desc%preferred_optical_model('DD','Woodward2001')" would mean
+  ! that subsequent calls to get_index in which the optical model is
+  ! not specified would return the Woodward model rather than the
+  ! first matching model in the file.  The check is only done on the
+  ! first len(optical_model_str) characters, so "Woodward" and
+  ! "Woodward2001" would both match the Woodward2001 model.
+  subroutine preferred_optical_model(this, code_str, optical_model_str)
+
+    use yomhook,              only : lhook, dr_hook
+
+    class(aerosol_optics_description_type), intent(inout) :: this
+    character(len=2), intent(in) :: code_str
+    character(len=*), intent(in) :: optical_model_str
+
+    ! Aerosol loop counter
+    integer :: ja
+
+    real(jprb)         :: hook_handle
+
+    if (lhook) call dr_hook('radiation_aerosol_optics_description:preferred_optical_model',0,hook_handle)
+
+    ! Loop over hydrophilic types
+    do ja = 1,size(this%bin_philic)
+      ! Check if we have a match
+      if (to_string(this%code_philic(:,ja)) == code_str &
+           &  .and. to_string(this%optical_model_philic(1:len(optical_model_str),ja)) &
+           &          == optical_model_str) then
+        this%is_preferred_philic(ja) = .true.
+      end if
+    end do
+    ! Repeat for the hydrophobic types
+    do ja = 1,size(this%bin_phobic)
+      if (to_string(this%code_phobic(:,ja)) == code_str &
+           &  .and. to_string(this%optical_model_phobic(1:len(optical_model_str),ja)) &
+           &          == optical_model_str) then
+        this%is_preferred_phobic(ja) = .true.
+      end if
+    end do
+
+    if (lhook) call dr_hook('radiation_aerosol_optics_description:preferred_optical_model',1,hook_handle)
+
+  end subroutine preferred_optical_model
+
+  !---------------------------------------------------------------------
+  ! Return the index to the aerosol optical properties corresponding
+  ! to the aerosol family in code_str (e.g. SS, DD etc), whether or
+  ! not the requested aerosol is hydrophilic in the logical
+  ! lhydrophilic, and optionally the size bin ibin and optical model
+  ! in optical_model_str. The return value may be used to populate the
+  ! radiation_config%i_aerosol_map vector, where a positive number is
+  ! a hydrophobic index, a negative number is a hydrophilic index and
+  ! zero indicates that the aerosol type was not found in the file.
+  ! This is a valid entry in i_aerosol_map meaning the aerosol is
+  ! ignored, but the calling routine to get_index might wish to throw
+  ! a warning or error. This routine works by assigning a score based
+  ! on the closeness of the match.
+  function get_index(this, code_str, lhydrophilic, ibin, optical_model_str)
+    
+    use yomhook,              only : lhook, dr_hook
+    use easy_netcdf,          only : netcdf_file
+    use radiation_io,         only : nulout
+
+    class(aerosol_optics_description_type), intent(in) :: this
+    character(len=2), intent(in) :: code_str
+    logical, intent(in) :: lhydrophilic
+    integer, intent(in), optional :: ibin
+    character(len=*), intent(in), optional :: optical_model_str
+
+    ! Score of the currently selected aerosol index, and the score of
+    ! the current one under consideration
+    integer :: score, current_score
+
+    ! Loop index for aerosol type
+    integer :: ja
+
+    ! Return value
+    integer :: get_index
+
+    ! Issue a warning if there is more than one equal match
+    logical :: is_ambiguous
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_aerosol_optics_description:get_index',0,hook_handle)
+
+    ! Initial values
+    get_index = 0
+    score = 0
+    is_ambiguous = .false.
+
+    if (lhydrophilic) then
+      ! Loop over hydrophilic aerosol types
+      do ja = 1,size(this%bin_philic)
+        current_score = 0
+        if (to_string(this%code_philic(:,ja)) == code_str) then
+          ! Aerosol code matches
+          if (present(ibin) .and. this%bin_philic(ja) > 0) then
+            if (ibin > 0) then
+              if (ibin == this%bin_philic(ja)) then
+                ! Requested bin number matches
+                current_score = 4
+              else
+                ! Requested bin number does not match
+                current_score = -1
+              end if
+            else
+              ! Bin number is zero: no request
+              current_score = 2
+            end if
+          else
+            ! No bin number present
+            current_score = 2
+          end if
+          if (present(optical_model_str)) then
+            if (to_string(this%optical_model_philic(1:len(optical_model_str),ja)) &
+                 &  == optical_model_str) then
+              ! Requested optical model matches
+              if (current_score >= 0) then
+                current_score = current_score + 4
+              end if
+            else
+              ! Requested optical model does not match
+              current_score = -1
+            end if
+          else if (current_score >= 0) then
+            ! No requested optical model
+            current_score = current_score + 2
+          end if
+          if (current_score > 0 .and. this%is_preferred_philic(ja)) then
+            current_score = current_score + 1
+          end if
+          if (current_score > score) then
+            ! Better score than any existing aerosol type
+            get_index = -ja
+            score = current_score
+            is_ambiguous = .false.
+          else if (current_score > 0 .and. current_score == score) then
+            is_ambiguous = .true.
+          end if
+        end if
+      end do
+    else
+      ! Loop over hydrophobic aerosol types
+      do ja = 1,size(this%bin_phobic)
+        current_score = 0
+        if (to_string(this%code_phobic(:,ja)) == code_str) then
+          ! Aerosol code matches
+          if (present(ibin) .and. this%bin_phobic(ja) > 0) then
+            if (ibin > 0) then
+              if (ibin == this%bin_phobic(ja)) then
+                ! Requested bin number matches
+                current_score = 4
+              else
+                ! Requested bin number does not match
+                current_score = -1
+              end if
+            else
+              ! Bin number is zero: no request
+              current_score = 2
+            end if
+          else
+            ! No bin number requested or present
+            current_score = 2
+          end if
+          if (present(optical_model_str)) then
+            if (to_string(this%optical_model_phobic(1:len(optical_model_str),ja)) &
+                 &  == optical_model_str) then
+              ! Requested optical model matches
+              if (current_score >= 0) then
+                current_score = current_score + 4
+              end if
+            else
+              ! Requested optical model does not match
+              current_score = -1
+            end if
+          else if (current_score >= 0) then
+            ! No requested optical model
+            current_score = current_score + 2
+          end if
+          if (current_score > 0 .and. this%is_preferred_phobic(ja)) then
+            current_score = current_score + 1
+          end if
+          if (current_score > score) then
+            ! Better score than any existing aerosol type
+            get_index = ja
+            score = current_score
+            is_ambiguous = .false.
+          else if (current_score > 0 .and. current_score == score) then
+            is_ambiguous = .true.
+          end if          
+        end if
+      end do
+    end if
+
+    if (is_ambiguous) then
+      write(nulout,'(a,a2,a,l1,a)') 'Warning: get_index("', code_str, '",', lhydrophilic, &
+           &  ',...) does not unambiguously identify an aerosol optical property index'
+    end if
+
+    if (lhook) call dr_hook('radiation_aerosol_optics_description:get_index',1,hook_handle)
+
+  end function get_index
+
+  !---------------------------------------------------------------------
+  ! Utility function to convert an array of single characters to a
+  ! character string (yes Fortran's string handling is a bit rubbish)
+  pure function to_string(arr) result(str)
+    character, intent(in)  :: arr(:)
+    character(len=size(arr)) :: str
+    integer :: jc
+    do jc = 1,size(arr)
+      str(jc:jc) = arr(jc)
+    end do
+  end function to_string
+
+end module radiation_aerosol_optics_description
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_check.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_check.F90	(revision 4489)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_check.F90	(revision 4489)
@@ -0,0 +1,212 @@
+! radiation_check.F90 - Checking routines
+!
+! (C) Copyright 2020- 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
+! License: see the COPYING file for details
+!
+
+module radiation_check
+
+  use parkind1, only : jprb
+
+  implicit none
+  public
+
+contains
+
+  !---------------------------------------------------------------------
+  ! 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_check
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloud.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloud.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloud.F90	(revision 4489)
@@ -16,4 +16,5 @@
 !   2019-01-14  R. Hogan  Added inv_inhom_effective_size variable
 !   2019-01-14  R. Hogan  Added out_of_physical_bounds routine
+!   2019-06-14  R. Hogan  Added capability to store any number of cloud/precip types
 
 module radiation_cloud
@@ -32,18 +33,21 @@
   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(:,:) :: &
+    ! hydrometeor types can be stored, dimensioned (ncol,nlev,ntype)
+    integer                                   :: ntype = 0
+    real(jprb), allocatable, dimension(:,:,:) :: &
+         &  mixing_ratio, &  ! mass mixing ratio (kg/kg)
+         &  effective_radius ! (m)
+
+    ! For backwards compatibility, we also allow for the two
+    ! traditional cloud types, liquid cloud droplets and ice cloud
+    ! particles, dimensioned (ncol,nlev)
+    real(jprb), pointer, 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
+         &  re_liq, re_ice    ! effective radius (m)
+
+    ! For the moment, the different types of hydrometeor are assumed
+    ! to be mixed with each other, so there is just one cloud fraction
+    ! variable varying from 0 to 1
+    real(jprb), allocatable, dimension(:,:) :: fraction
 
     ! The fractional standard deviation of cloud optical depth in the
@@ -95,11 +99,16 @@
   ! 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)
+  subroutine allocate_cloud_arrays(this, ncol, nlev, ntype, 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
+    class(cloud_type), intent(inout), target :: this
+    integer, intent(in)              :: ncol   ! Number of columns
+    integer, intent(in)              :: nlev   ! Number of levels
+    ! Number of cloud/precip particle types.  If not present then the
+    ! older cloud behaviour is assumed: two types are present, (1)
+    ! liquid and (2) ice, and they can be accessed via q_liq, q_ice,
+    ! re_liq and re_ice.
+    integer, intent(in), optional    :: ntype
     logical, intent(in), optional    :: use_inhom_effective_size
 
@@ -108,8 +117,23 @@
     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))
+    if (present(ntype)) then
+      this%ntype = ntype
+    else
+      this%ntype = 2
+    end if
+    allocate(this%mixing_ratio(ncol,nlev,this%ntype))
+    allocate(this%effective_radius(ncol,nlev,this%ntype))
+    nullify(this%q_liq)
+    nullify(this%q_ice)
+    nullify(this%re_liq)
+    nullify(this%re_ice)
+    if (.not. present(ntype)) then
+      ! Older interface in which only liquid and ice are supported
+      this%q_liq  => this%mixing_ratio(:,:,1)
+      this%q_ice  => this%mixing_ratio(:,:,2)
+      this%re_liq => this%effective_radius(:,:,1)
+      this%re_ice => this%effective_radius(:,:,2)
+    end if
+
     allocate(this%fraction(ncol,nlev))
     allocate(this%overlap_param(ncol,nlev-1))
@@ -140,11 +164,14 @@
     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)
+    nullify(this%q_liq)
+    nullify(this%q_ice)
+    nullify(this%re_liq)
+    nullify(this%re_ice)
+
+    if (allocated(this%mixing_ratio))     deallocate(this%mixing_ratio)
+    if (allocated(this%effective_radius)) deallocate(this%effective_radius)
+    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)
@@ -185,5 +212,5 @@
     integer :: ncol, nlev
 
-    integer :: jlev
+    integer :: jcol, jlev
 
     real(jprb)        :: hook_handle
@@ -220,14 +247,18 @@
       ! 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 jcol = i1,i2
+        this%overlap_param(jcol,1) = exp(-(R_over_g/decorrelation_length) &
+             &                            * thermodynamics%temperature_hl(jcol,2) &
+             &                            *log(thermodynamics%pressure_hl(jcol,3) &
+             &                                /thermodynamics%pressure_hl(jcol,2)))
+      end do
 
       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)))
+        do jcol = i1,i2
+          this%overlap_param(jcol,jlev) = exp(-(0.5_jprb*R_over_g/decorrelation_length) &
+              &                            * thermodynamics%temperature_hl(jcol,jlev+1) &
+              &                            *log(thermodynamics%pressure_hl(jcol,jlev+2) &
+              &                                /thermodynamics%pressure_hl(jcol,jlev)))
+        end do
       end do
 
@@ -237,14 +268,18 @@
        ! 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)))
+        do jcol = i1,i2
+          this%overlap_param(jcol,jlev) = exp(-(0.5_jprb*R_over_g/decorrelation_length) &
+              &                            * thermodynamics%temperature_hl(jcol,jlev+1) &
+              &                            *log(thermodynamics%pressure_hl(jcol,jlev) &
+              &                                /thermodynamics%pressure_hl(jcol,jlev+2)))
+        end do
       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)))
-
+
+      do jcol = i1,i2
+        this%overlap_param(jcol,nlev-1) = exp(-(R_over_g/decorrelation_length) &
+            &                            * thermodynamics%temperature_hl(jcol,nlev) &
+            &                            *log(thermodynamics%pressure_hl(jcol,nlev-1) &
+            &                                /thermodynamics%pressure_hl(jcol,nlev)))
+      end do
     end if
 
@@ -580,8 +615,9 @@
     integer,           intent(in)    :: istartcol, iendcol
 
-    integer :: nlev
-    integer :: jcol, jlev
+    integer :: nlev, ntype
+    integer :: jcol, jlev, jh
 
     real(jprb) :: cloud_fraction_threshold, cloud_mixing_ratio_threshold
+    real(jprb) :: sum_mixing_ratio(istartcol:iendcol)
 
     real(jprb) :: hook_handle
@@ -589,11 +625,19 @@
     if (lhook) call dr_hook('radiation_cloud:crop_cloud_fraction',0,hook_handle)
 
-    nlev = size(this%fraction,2)
-
+    nlev  = size(this%fraction,2)
+    ntype = size(this%mixing_ratio,3)
+    
     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
+        sum_mixing_ratio(jcol) = 0.0_jprb
+      end do
+      do jh = 1, ntype
+        do jcol = istartcol,iendcol
+          sum_mixing_ratio(jcol) = sum_mixing_ratio(jcol) + this%mixing_ratio(jcol,jlev,jh)
+        end do
+      end do
+      do jcol = istartcol,iendcol
+        if (this%fraction(jcol,jlev)        < cloud_fraction_threshold &
+             &  .or. sum_mixing_ratio(jcol) < cloud_mixing_ratio_threshold) then
           this%fraction(jcol,jlev) = 0.0_jprb
         end if
@@ -612,5 +656,5 @@
 
     use yomhook,          only : lhook, dr_hook
-    use radiation_config, only : out_of_bounds_2d
+    use radiation_check, only : out_of_bounds_2d, out_of_bounds_3d
 
     class(cloud_type), intent(inout) :: this
@@ -631,11 +675,7 @@
     end if
 
-    is_bad =    out_of_bounds_2d(this%q_liq, 'q_liq', 0.0_jprb, 1.0_jprb, &
+    is_bad =    out_of_bounds_3d(this%mixing_ratio, 'cloud%mixing_ratio', 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, &
+         & .or. out_of_bounds_3d(this%effective_radius, 'cloud%effective_radius', 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, &
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloud_cover.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloud_cover.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloud_cover.F90	(revision 4489)
@@ -253,5 +253,9 @@
            &  + (1.0_jprb - overlap_alpha) &
            &  * (frac(jlev)+frac(jlev+1)-frac(jlev)*frac(jlev+1))
-
+! Added for DWD (2020)
+#ifdef __SX__
+    end do
+    do jlev = 1,nlev-1
+#endif
       if (frac(jlev) >= MaxCloudFrac) then
         ! Cloud cover has reached one
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloud_generator.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloud_generator.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloud_generator.F90	(revision 4489)
@@ -18,4 +18,5 @@
 ! Modifications
 !   2018-02-22  R. Hogan  Call masked version of PDF sampler for speed
+!   2020-03-31  R. Hogan  More vectorizable version of Exp-Ran
 
 module radiation_cloud_generator
@@ -39,5 +40,5 @@
        &  fractional_std, pdf_sampler, &
        &  od_scaling, total_cloud_cover, &
-       &  is_beta_overlap)
+       &  use_beta_overlap, use_vectorizable_generator)
 
     use parkind1, only           : jprb
@@ -86,5 +87,9 @@
     ! overlap parameter of Shonk et al. (2010), and needs to be
     ! converted to alpha.
-    logical, intent(in), optional :: is_beta_overlap
+    logical, intent(in), optional :: use_beta_overlap
+
+    ! Do we use the more vectorizable cloud generator, at the expense
+    ! of more random numbers being needed?
+    logical, intent(in), optional :: use_vectorizable_generator
 
     ! Outputs
@@ -126,4 +131,6 @@
     real(jprb), dimension(nlev-1) :: pair_cloud_cover, overhang
 
+    logical :: use_vec_gen
+
     real(jprb) :: hook_handle
 
@@ -132,5 +139,5 @@
     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)
+           &   cum_cloud_cover, pair_cloud_cover, use_beta_overlap)
     else if (i_overlap_scheme == IOverlapMaximumRandom) then
       call cum_cloud_cover_max_ran(nlev, frac, &
@@ -138,5 +145,5 @@
     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)
+           &   cum_cloud_cover, pair_cloud_cover, use_beta_overlap)
     else
       write(nulerr,'(a)') '*** Error: cloud overlap scheme not recognised'
@@ -183,38 +190,64 @@
       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
+      if (present(use_vectorizable_generator)) then
+        use_vec_gen = use_vectorizable_generator
+      else
+        use_vec_gen = .false.
+      end if
+
+      if (.not. use_vec_gen) then
+        ! Original generator that minimizes the number of random
+        ! numbers used, but is not vectorizable
+
+        ! 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
-        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)
+
+      else
+        ! Alternative generator (only for Exp-Ran overlap so far) that
+        ! should be vectorizable but generates more random numbers,
+        ! some of which are not used
+
+        if (i_overlap_scheme == IOverlapExponential) then
+          write(nulerr,'(a)') '*** Error: vectorizable cloud generator is not available with Exp-Exp overlap'
+          call radiation_abort()
         end if
-        
-      end do
+
+        call generate_columns_exp_ran(ng, nlev, iseed, pdf_sampler, &
+             &  total_cloud_cover, frac_threshold, frac, pair_cloud_cover, &
+             &  cum_cloud_cover, overhang, fractional_std, overlap_param_inhom, &
+             &  ibegin, iend, od_scaling)
+
+      end if
 
     end if
-
 
     if (lhook) call dr_hook('radiation_cloud_generator:cloud_generator',1,hook_handle)
@@ -474,6 +507,8 @@
         
     ! 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
+    ! optical depth scalings
+
+    ! Masked version assuming values outside the range itrigger:iend
+    ! are already zero:
     call pdf_sampler%masked_sample(n_layers_to_scale, &
          &  fractional_std(itrigger:iend), &
@@ -481,5 +516,223 @@
          &  is_cloudy(itrigger:iend))
         
+    ! ! IFS version:
+    ! !$omp simd 
+    ! do jlev=itrigger,iend
+    !    if (.not. is_cloudy(jlev)) then
+    !       od_scaling(ig,jlev) = 0.0_jprb
+    !    else
+    !       call sample_from_pdf_simd(&
+    !            pdf_sampler,fractional_std(jlev),&
+    !            rand_inhom1(jlev-itrigger+1), &
+    !            od_scaling(ig,jlev))
+    !    end if
+    ! end do
+
   end subroutine generate_column_exp_exp
 
+
+  !---------------------------------------------------------------------
+  ! Extract the value of a lognormal distribution with fractional
+  ! standard deviation "fsd" corresponding to the cumulative
+  ! distribution function value "cdf", and return it in x. Since this
+  ! is an elemental subroutine, fsd, cdf and x may be arrays. SIMD version.
+  subroutine sample_from_pdf_simd(this, fsd, cdf, x)
+    use parkind1,              only : jprb
+    use radiation_pdf_sampler, only : pdf_sampler_type
+    implicit none
+#if defined(__GFORTRAN__) || defined(__PGI) || defined(__NEC__)
+#else
+    !$omp declare simd(sample_from_pdf_simd) uniform(this) &
+    !$omp linear(ref(fsd)) linear(ref(cdf))
+#endif
+    type(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) :: x
+
+    ! 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))
+
+    x =      (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_simd
+
+
+  !---------------------------------------------------------------------
+  ! Generate columns of optical depth scalings using
+  ! exponential-random overlap (which includes maximum-random overlap
+  ! as a limiting case).  This version is intended to work better on
+  ! hardware with long vector lengths.  As with all calculations in
+  ! this file, we zoom into the fraction of the column with cloud at
+  ! any height, so that all spectral intervals see a cloud somewhere.
+  ! In the McICA solver, this is combined appropriately with the
+  ! clear-sky calculation.
+  subroutine generate_columns_exp_ran(ng, nlev, iseed, pdf_sampler, &
+       &  total_cloud_cover, frac_threshold, frac, pair_cloud_cover, &
+       &  cum_cloud_cover, overhang, fractional_std, overlap_param_inhom, &
+       &  ibegin, iend, od_scaling)
+
+    use parkind1,              only : jprb
+    use radiation_pdf_sampler, only : pdf_sampler_type
+    use radiation_random_numbers, only : rng_type, IRngMinstdVector, IRngNative
+
+    implicit none
+
+    ! Number of g points / columns
+    integer, intent(in) :: ng
+
+    ! Number of levels
+    integer, intent(in) :: nlev
+
+    integer, intent(in) :: iseed ! seed for random number generator
+
+    ! Stream for producing random numbers
+    !type(randomnumberstream) :: random_stream
+    type(rng_type) :: random_number_generator
+
+    ! Object for sampling from a lognormal or gamma distribution
+    type(pdf_sampler_type), intent(in) :: pdf_sampler
+
+    ! Total cloud cover using cloud fraction and overlap parameter
+    real(jprb), intent(in) :: total_cloud_cover
+
+    real(jprb), intent(in) :: frac_threshold
+
+    ! 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 and base of lowest
+    integer, intent(inout) :: ibegin, iend
+
+    ! Optical depth scaling to output
+    real(jprb), intent(inout), dimension(ng,nlev) :: od_scaling
+
+    ! Loop indices
+    integer :: jlev, jg
+
+    real(jprb) :: rand_cloud(ng,ibegin:iend)
+    real(jprb) :: rand_inhom(ng,ibegin-1:iend), rand_inhom2(ng,ibegin:iend)
+
+    ! Is the cloud fraction above the minimum threshold at each level
+    logical :: is_any_cloud(ibegin:iend)
+
+    ! Scaled random number for finding cloud
+    real(jprb) :: trigger(ng)
+
+    logical :: is_cloud(ng)    ! Is there cloud at this level and spectral interval?
+    logical :: prev_cloud(ng)  ! Was there cloud at level above?
+    logical :: first_cloud(ng) ! At level of first cloud counting down from top?
+    logical :: found_cloud(ng) ! Cloud found in this column counting down from top?
+
+    is_any_cloud = (frac(ibegin:iend) >= frac_threshold)
+
+    ! Initialize random number generator for this column, and state
+    ! that random numbers will be requested in blocks of length the
+    ! number of spectral intervals ng.
+    call random_number_generator%initialize(IRngMinstdVector, iseed=iseed, &
+         &                                  nmaxstreams=ng)
+
+    ! Random numbers to use to locate cloud top
+    call random_number_generator%uniform_distribution(trigger)
+
+    ! Random numbers to work out whether to transition vertically from
+    ! clear to cloudy, cloudy to clear, clear to clear or cloudy to
+    ! cloudy
+    call random_number_generator%uniform_distribution(rand_cloud, is_any_cloud)
+
+    ! Random numbers to generate sub-grid cloud structure
+    call random_number_generator%uniform_distribution(rand_inhom)
+    call random_number_generator%uniform_distribution(rand_inhom2, is_any_cloud)
+
+    trigger = trigger * total_cloud_cover
+
+    ! Initialize logicals for clear-sky above first cloudy layer
+    found_cloud = .false.
+    is_cloud    = .false.
+    first_cloud = .false.
+
+    ! Loop down through layers starting at the first cloudy layer
+    do jlev = ibegin,iend
+
+      if (is_any_cloud(jlev)) then
+
+! Added for DWD (2020)
+!NEC$ shortloop
+        do jg = 1,ng
+          ! The intention is that all these operations are vectorizable,
+          ! since all are vector operations on vectors of length ng...
+
+          ! Copy the cloud mask between levels
+          prev_cloud(jg) = is_cloud(jg)
+
+          ! For each spectral interval, has the first cloud appeared at this level?
+          first_cloud(jg) = (trigger(jg) <= cum_cloud_cover(jlev) .and. .not. found_cloud(jg))
+
+          ! ...if so, add to found_cloud
+          found_cloud(jg) = found_cloud(jg) .or. first_cloud(jg)
+
+          ! There is cloud at this level either if a first cloud has
+          ! appeared, or using separate probability calculations
+          ! depending on whether there is a cloud above (given by
+          ! prev_cloud)
+          is_cloud(jg) = first_cloud(jg) &
+               &  .or. found_cloud(jg) .and. merge(rand_cloud(jg,jlev)*frac(jlev-1) &
+               &               < frac(jlev)+frac(jlev-1)-pair_cloud_cover(jlev-1), &
+               &             rand_cloud(jg,jlev)*(cum_cloud_cover(jlev-1) - frac(jlev-1)) &
+               &               < pair_cloud_cover(jlev-1) - overhang(jlev-1) - frac(jlev-1), &
+               &             prev_cloud(jg))
+          ! The random number determining cloud structure decorrelates
+          ! with the one above it according to the overlap parameter,
+          ! but always decorrelates if there is clear-sky above.  If
+          ! there is clear-sky in the present level, the random number
+          ! is set to zero to ensure that the optical depth scaling is
+          ! also zero.
+          rand_inhom(jg,jlev) = merge(merge(rand_inhom(jg,jlev-1), rand_inhom(jg,jlev), &
+               &                           rand_inhom2(jg,jlev) < overlap_param_inhom(jlev-1) &
+               &                           .and. prev_cloud(jg)), &
+               &                     0.0_jprb, is_cloud(jg))
+        end do
+      else
+        ! No cloud at this level
+        is_cloud = .false.
+      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 ibegin:iend are already zero
+    call pdf_sampler%masked_block_sample(iend-ibegin+1, ng, &
+         &  fractional_std(ibegin:iend), &
+         &  rand_inhom(:,ibegin:iend), od_scaling(:,ibegin:iend), &
+         &  is_any_cloud)
+
+  end subroutine generate_columns_exp_ran
+
 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 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloud_optics.F90	(revision 4489)
@@ -19,4 +19,5 @@
 
   implicit none
+
   public
 
@@ -271,5 +272,5 @@
     type(cloud_optics_type), pointer :: ho
 
-    integer    :: jcol, jlev
+    integer    :: jcol, jlev, jb
 
     real(jprb) :: hook_handle
@@ -345,8 +346,10 @@
             end if
 
+            ! Delta-Eddington scaling in the shortwave only
             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
+            !call delta_eddington_scat_od(od_lw_liq, scat_od_lw_liq, g_lw_liq)
+
           else
             ! Liquid not present: set properties to zero
@@ -437,12 +440,12 @@
             end if
 
+            ! Delta-Eddington scaling in both longwave and shortwave
+            ! (assume that particles are larger than wavelength even
+            ! in longwave)
             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
@@ -458,27 +461,39 @@
           ! 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)
+! Added for DWD (2020)
+!NEC$ shortloop
+            do jb = 1, config%n_bands_lw
+              od_lw_cloud(jb,jlev,jcol) = od_lw_liq(jb) + od_lw_ice(jb)
+              if (scat_od_lw_liq(jb)+scat_od_lw_ice(jb) > 0.0_jprb) then
+                g_lw_cloud(jb,jlev,jcol) = (g_lw_liq(jb) * scat_od_lw_liq(jb) &
+                   &  + g_lw_ice(jb) * scat_od_lw_ice(jb)) &
+                   &  / (scat_od_lw_liq(jb)+scat_od_lw_ice(jb))
+              else
+                g_lw_cloud(jb,jlev,jcol) = 0.0_jprb
+              end if
+              ssa_lw_cloud(jb,jlev,jcol) = (scat_od_lw_liq(jb) + scat_od_lw_ice(jb)) &
+                 &                    / (od_lw_liq(jb) + od_lw_ice(jb))
+            end do
           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
+! Added for DWD (2020)
+!NEC$ shortloop
+            do jb = 1, config%n_bands_lw
+              od_lw_cloud(jb,jlev,jcol) = od_lw_liq(jb) - scat_od_lw_liq(jb) &
+                    &                   + od_lw_ice(jb) - scat_od_lw_ice(jb)
+            end do
           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)
+! Added for DWD (2020)
+!NEC$ shortloop
+          do jb = 1, config%n_bands_sw
+            od_sw_cloud(jb,jlev,jcol) = od_sw_liq(jb) + od_sw_ice(jb)
+            g_sw_cloud(jb,jlev,jcol) = (g_sw_liq(jb) * scat_od_sw_liq(jb) &
+               &  + g_sw_ice(jb) * scat_od_sw_ice(jb)) &
+               &  / (scat_od_sw_liq(jb) + scat_od_sw_ice(jb))
+            ssa_sw_cloud(jb,jlev,jcol) &
+               &  = (scat_od_sw_liq(jb) + scat_od_sw_ice(jb)) / (od_sw_liq(jb) + od_sw_ice(jb))
+          end do
         end if ! Cloud present
       end do ! Loop over column
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_config.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_config.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_config.F90	(revision 4489)
@@ -26,4 +26,6 @@
 !   2019-02-03  R. Hogan  Added ability to fix out-of-physical-bounds inputs
 !   2019-02-10  R. Hogan  Renamed "encroachment" to "entrapment"
+!   2020-05-18  R. Hogan  Moved out_of_bounds_* to radiation_check.F90
+!   2021-07-04  R. Hogan  Numerous changes for ecCKD and general cloud/aerosol optics
 !
 ! Note: The aim is for ecRad in the IFS to be as similar as possible
@@ -37,8 +39,10 @@
 
   use radiation_cloud_optics_data,   only : cloud_optics_type
+  use radiation_general_cloud_optics_data,   only : general_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
+  use radiation_ecckd,               only : ckd_model_type
 
   implicit none
@@ -70,5 +74,4 @@
        & IEntrapmentExplicitNonFractal, & ! As above but ignore fractal nature of clouds
        & IEntrapmentMaximum ! Complete horizontal homogenization within regions (old SPARTACUS assumption)
-
   end enum
   
@@ -94,8 +97,9 @@
   ! Gas models
   enum, bind(c) 
-     enumerator IGasModelMonochromatic, IGasModelIFSRRTMG
+     enumerator IGasModelMonochromatic, IGasModelIFSRRTMG, IGasModelECCKD
   end enum
-  character(len=*), parameter :: GasModelName(0:1) = (/ 'Monochromatic', &
-       &                                                'RRTMG-IFS    ' /)
+  character(len=*), parameter :: GasModelName(0:2) = (/ 'Monochromatic', &
+       &                                                'RRTMG-IFS    ', &
+       &                                                'ECCKD        '/)
 
   ! Hydrometeor scattering models
@@ -130,4 +134,7 @@
   integer, parameter :: NMaxAerosolTypes = 256
 
+  ! Maximum number of different cloud types that can be provided
+  integer, parameter :: NMaxCloudTypes = 12
+
   ! Maximum number of shortwave albedo and longwave emissivity
   ! intervals
@@ -155,4 +162,16 @@
     character(len=511) :: directory_name = '.'
 
+    ! If this is true then support arbitrary hydrometeor types (not
+    ! just ice and liquid) and arbitrary spectral discretization (not
+    ! just RRTMG). It is required that this is true if the ecCKD gas
+    ! optics model is selected. General cloud optics has only been
+    ! available from ecRad version 1.5.
+    logical :: use_general_cloud_optics = .true.
+
+    ! If this is true then support aerosol properties at an arbitrary
+    ! spectral discretization (not just RRTMG). It is required that
+    ! this is true if the ecCKD gas optics model is selected.
+    logical :: use_general_aerosol_optics = .true.
+
     ! Cloud is deemed to be present in a layer if cloud fraction
     ! exceeds this value
@@ -168,4 +187,13 @@
     ! (2000)?
     logical :: use_beta_overlap = .false.
+
+    ! Use a more vectorizable McICA cloud generator, at the expense of
+    ! more random numbers being generated?  This is the default on NEC
+    ! SX.
+#ifdef __SX__
+    logical :: use_vectorizable_generator = .true.
+#else
+    logical :: use_vectorizable_generator = .false.
+#endif
 
     ! Shape of sub-grid cloud water PDF
@@ -236,8 +264,6 @@
     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
+    ! Codes describing the gas model
     integer :: i_gas_model = IGasModelIFSRRTMG
-    !     integer :: i_cloud_model
 
     ! Optics if i_gas_model==IGasModelMonochromatic.
@@ -270,12 +296,14 @@
     ! 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.
+    logical :: do_nearest_spectral_sw_albedo = .false.
+    logical :: do_nearest_spectral_lw_emiss  = .false.
 
     ! 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.
+    ! the first interval starts at zero and the last ends at
+    ! infinity. These must be set with define_sw_albedo_intervals and
+    ! define_lw_emiss_intervals.
     real(jprb) :: sw_albedo_wavelength_bound(NMaxAlbedoIntervals-1) = -1.0_jprb
-    real(jprb) :: lw_emiss_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
@@ -296,4 +324,17 @@
     logical :: do_3d_effects = .true.
     
+    character(len=511) :: cloud_type_name(NMaxCloudTypes) = ["","","","","","","","","","","",""]
+! &
+!         &   = ["mie_droplet                   ", &
+!         &      "baum-general-habit-mixture_ice"]
+
+    ! Spectral averaging method to use with generalized cloud optics;
+    ! see Edwards & Slingo (1996) for definition.  Experimentation
+    ! with ecRad suggests that "thick" averaging is more accurate for
+    ! both liquid and ice clouds.
+    logical :: use_thick_cloud_spectral_averaging(NMaxCloudTypes) &
+         &  = [.true.,.true.,.true.,.true.,.true.,.true., &
+         &     .true.,.true.,.true.,.true.,.true.,.true.]
+
     ! To what extent do we include "entrapment" effects in the
     ! SPARTACUS solver? This essentially means that in a situation
@@ -420,7 +461,9 @@
     ! 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) :: ice_optics_override_file_name     = ''
+    character(len=511) :: liq_optics_override_file_name     = ''
     character(len=511) :: aerosol_optics_override_file_name = ''
+    character(len=511) :: gas_optics_sw_override_file_name  = ''
+    character(len=511) :: gas_optics_lw_override_file_name  = ''
 
     ! Optionally override the look-up table file for the cloud-water
@@ -428,17 +471,26 @@
     character(len=511) :: cloud_pdf_override_file_name = ''
 
+    ! Do we compute cloud, aerosol and surface optical properties per
+    ! g point?  Not available with RRTMG gas optics model.
+    logical :: do_cloud_aerosol_per_sw_g_point = .true.
+    logical :: do_cloud_aerosol_per_lw_g_point = .true.
+
+    ! Do we weight the mapping from surface emissivity/albedo to
+    ! g-point/band weighting by a reference Planck function (more
+    ! accurate) or weighting each wavenumber equally (less accurate
+    ! but consistent with IFS Cycle 48r1 and earlier)?
+    logical :: do_weighted_surface_mapping = .true.
+
+    ! COMPUTED PARAMETERS
+
+    ! Users of this library should not edit these parameters directly;
+    ! they are set by the "consolidate" routine
+
     ! 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
+    ! Fraction of each g point in each wavenumber interval,
+    ! dimensioned (n_wav_frac_[l|s]w, n_g_[l|s]w)
+    real(jprb), allocatable, dimension(:,:) :: g_frac_sw, g_frac_lw
 
     ! If the nearest surface albedo/emissivity interval is to be used
@@ -490,6 +542,18 @@
     integer :: n_canopy_bands_lw = 1
 
+    ! Data structures containing gas optics description in the case of
+    ! ecCKD
+    type(ckd_model_type)         :: gas_optics_sw, gas_optics_lw
+
     ! Data structure containing cloud scattering data
     type(cloud_optics_type)      :: cloud_optics
+
+    ! Number of general cloud types, default liquid and ice
+    integer :: n_cloud_types = 2
+
+    ! List of data structures (one per cloud type) containing cloud
+    ! scattering data
+    type(general_cloud_optics_type), allocatable :: cloud_optics_sw(:)
+    type(general_cloud_optics_type), allocatable :: cloud_optics_lw(:)
 
     ! Data structure containing aerosol scattering data
@@ -502,5 +566,7 @@
     character(len=511) :: ice_optics_file_name, &
          &                liq_optics_file_name, &
-         &                aerosol_optics_file_name
+         &                aerosol_optics_file_name, &
+         &                gas_optics_sw_file_name, &
+         &                gas_optics_lw_file_name
     
     ! McICA PDF look-up table file name
@@ -515,4 +581,8 @@
     ! g points or the number of bands
     integer :: n_spec_sw = 0, n_spec_lw = 0
+
+    ! Number of wavenumber intervals used to describe the mapping from
+    ! g-points to wavenumber space
+    integer :: n_wav_frac_sw = 0, n_wav_frac_lw = 0
 
     ! Dimensions to store variables that are only needed if longwave
@@ -539,5 +609,7 @@
      procedure :: define_sw_albedo_intervals
      procedure :: define_lw_emiss_intervals
-     procedure :: consolidate_intervals
+     procedure :: set_aerosol_wavelength_mono
+     procedure :: consolidate_sw_albedo_intervals
+     procedure :: consolidate_lw_emiss_intervals
 
   end type config_type
@@ -574,4 +646,5 @@
     logical :: do_sw, do_lw, do_clear, do_sw_direct
     logical :: do_3d_effects, use_expm_everywhere, use_aerosols
+    logical :: use_general_cloud_optics, use_general_aerosol_optics
     logical :: do_lw_side_emissivity
     logical :: do_3d_lw_multilayer_effects, do_fu_lw_ice_optics_bug
@@ -579,9 +652,11 @@
     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 :: use_beta_overlap, do_lw_derivatives, use_vectorizable_generator
     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
+    logical :: do_cloud_aerosol_per_sw_g_point, do_cloud_aerosol_per_lw_g_point
+    logical :: do_weighted_surface_mapping    
     integer :: n_regions, iverbose, iverbosesetup, n_aerosol_types
     real(jprb):: mono_lw_wavelength, mono_lw_total_od, mono_sw_total_od
@@ -596,11 +671,16 @@
     character(511) :: liq_optics_override_file_name, ice_optics_override_file_name
     character(511) :: cloud_pdf_override_file_name
+    character(511) :: gas_optics_sw_override_file_name, gas_optics_lw_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
+    character(len=511) :: cloud_type_name(NMaxCloudTypes) = ["","","","","","","","","","","",""]
+    logical :: use_thick_cloud_spectral_averaging(NMaxCloudTypes) &
+         &  = [.false.,.false.,.false.,.false.,.false.,.false., &
+         &     .false.,.false.,.false.,.false.,.false.,.false.]
     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.
+    logical :: do_nearest_spectral_sw_albedo
+    logical :: do_nearest_spectral_lw_emiss
     real(jprb) :: sw_albedo_wavelength_bound(NMaxAlbedoIntervals-1)
     real(jprb) :: lw_emiss_wavelength_bound( NMaxAlbedoIntervals-1)
@@ -609,6 +689,4 @@
 
     integer :: iunit ! Unit number of namelist file
-
-    logical :: lldeb_conf = .false.
 
     namelist /radiation/ do_sw, do_lw, do_sw_direct, &
@@ -622,4 +700,5 @@
          &  ice_optics_override_file_name, liq_optics_override_file_name, &
          &  aerosol_optics_override_file_name, cloud_pdf_override_file_name, &
+         &  gas_optics_sw_override_file_name, gas_optics_lw_override_file_name, &
          &  liquid_model_name, ice_model_name, max_3d_transfer_rate, &
          &  min_cloud_effective_size, overhang_factor, encroachment_scaling, &
@@ -627,6 +706,7 @@
          &  do_canopy_fluxes_sw, do_canopy_fluxes_lw, &
          &  do_canopy_gases_sw, do_canopy_gases_lw, &
+         &  use_general_cloud_optics, use_general_aerosol_optics, &
          &  do_sw_delta_scaling_with_gases, overlap_scheme_name, &
-         &  sw_solver_name, lw_solver_name, use_beta_overlap, &
+         &  sw_solver_name, lw_solver_name, use_beta_overlap, use_vectorizable_generator, &
          &  use_expm_everywhere, iverbose, iverbosesetup, &
          &  cloud_inhom_decorr_scaling, cloud_fraction_threshold, &
@@ -637,9 +717,11 @@
          &  mono_lw_single_scattering_albedo, mono_sw_single_scattering_albedo, &
          &  mono_lw_asymmetry_factor, mono_sw_asymmetry_factor, &
-         &  cloud_pdf_shape_name, &
+         &  cloud_pdf_shape_name, cloud_type_name, use_thick_cloud_spectral_averaging, &
          &  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
-
+         &  i_sw_albedo_index, i_lw_emiss_index, &
+         &  do_cloud_aerosol_per_lw_g_point, &
+         &  do_cloud_aerosol_per_sw_g_point, do_weighted_surface_mapping
+         
     real(jprb) :: hook_handle
 
@@ -670,4 +752,6 @@
     ice_optics_override_file_name = this%ice_optics_override_file_name
     aerosol_optics_override_file_name = this%aerosol_optics_override_file_name
+    gas_optics_sw_override_file_name = this%gas_optics_sw_override_file_name
+    gas_optics_lw_override_file_name = this%gas_optics_lw_override_file_name
     use_expm_everywhere = this%use_expm_everywhere
     use_aerosols = this%use_aerosols
@@ -679,7 +763,10 @@
     iverbose = this%iverbose
     iverbosesetup = this%iverbosesetup
+    use_general_cloud_optics = this%use_general_cloud_optics
+    use_general_aerosol_optics = this%use_general_aerosol_optics
     cloud_fraction_threshold = this%cloud_fraction_threshold
     cloud_mixing_ratio_threshold = this%cloud_mixing_ratio_threshold
     use_beta_overlap = this%use_beta_overlap
+    use_vectorizable_generator = this%use_vectorizable_generator
     cloud_inhom_decorr_scaling = this%cloud_inhom_decorr_scaling
     clear_to_thick_fraction = this%clear_to_thick_fraction
@@ -689,4 +776,7 @@
     max_3d_transfer_rate = this%max_3d_transfer_rate
     min_cloud_effective_size = this%min_cloud_effective_size
+    cloud_type_name = this%cloud_type_name
+    use_thick_cloud_spectral_averaging = this%use_thick_cloud_spectral_averaging
+
     overhang_factor = this%overhang_factor
     encroachment_scaling = -1.0_jprb
@@ -715,4 +805,7 @@
     i_sw_albedo_index             = this%i_sw_albedo_index
     i_lw_emiss_index              = this%i_lw_emiss_index
+    do_cloud_aerosol_per_lw_g_point = this%do_cloud_aerosol_per_lw_g_point
+    do_cloud_aerosol_per_sw_g_point = this%do_cloud_aerosol_per_sw_g_point
+    do_weighted_surface_mapping   = this%do_weighted_surface_mapping
 
     if (present(file_name) .and. present(unit)) then
@@ -746,5 +839,13 @@
       end if
     else
+
+      ! This version exits correctly, but provides less information
+      ! about how the namelist was incorrect
       read(unit=iunit, iostat=iosread, nml=radiation)
+
+      ! Depending on compiler this version provides more information
+      ! about the error in the namelist
+      !read(unit=iunit, nml=radiation)
+
       if (iosread /= 0) then
         ! An error occurred reading the file
@@ -812,4 +913,5 @@
     this%mono_sw_asymmetry_factor = mono_sw_asymmetry_factor
     this%use_beta_overlap = use_beta_overlap
+    this%use_vectorizable_generator = use_vectorizable_generator
     this%cloud_inhom_decorr_scaling = cloud_inhom_decorr_scaling
     this%clear_to_thick_fraction = clear_to_thick_fraction
@@ -819,4 +921,6 @@
     this%max_3d_transfer_rate = max_3d_transfer_rate
     this%min_cloud_effective_size = max(1.0e-6_jprb, min_cloud_effective_size)
+    this%cloud_type_name = cloud_type_name
+    this%use_thick_cloud_spectral_averaging = use_thick_cloud_spectral_averaging
     if (encroachment_scaling >= 0.0_jprb) then
       this%overhang_factor = encroachment_scaling
@@ -832,4 +936,8 @@
     this%ice_optics_override_file_name = ice_optics_override_file_name
     this%aerosol_optics_override_file_name = aerosol_optics_override_file_name
+    this%gas_optics_sw_override_file_name = gas_optics_sw_override_file_name
+    this%gas_optics_lw_override_file_name = gas_optics_lw_override_file_name
+    this%use_general_cloud_optics      = use_general_cloud_optics
+    this%use_general_aerosol_optics    = use_general_aerosol_optics
     this%cloud_fraction_threshold = cloud_fraction_threshold
     this%cloud_mixing_ratio_threshold = cloud_mixing_ratio_threshold
@@ -845,72 +953,8 @@
     this%i_sw_albedo_index             = i_sw_albedo_index
     this%i_lw_emiss_index              = i_lw_emiss_index
-
-! AI mars 2022
-if (lldeb_conf) then
-print*,'**************PARAMETRES DE CONFIGURATION OFFLINE*******************'
-print*,'config%iverbosesetup   = ', iverbosesetup
-print*,'config%do_lw   = ', do_lw
-print*,'config%do_sw   = ', do_sw
-print*,'config%do_clear   = ', do_clear
-print*,'config%do_sw_direct   = ', do_sw_direct
-print*,'config%do_3d_effects   = ', do_3d_effects
-print*,'config%do_3d_lw_multilayer_effects   = ', do_3d_lw_multilayer_effects
-print*,'config%do_lw_side_emissivity   = ', do_lw_side_emissivity
-print*,'config%use_expm_everywhere   = ', use_expm_everywhere
-print*,'config%use_aerosols   = ', use_aerosols
-print*,'config%do_lw_cloud_scattering   = ', do_lw_cloud_scattering
-print*,'config%do_lw_aerosol_scattering   = ', do_lw_aerosol_scattering
-print*,'config%nregions   = ', n_regions
-print*,'config%do_surface_sw_spectral_flux   = ', do_surface_sw_spectral_flux
-print*,'config%do_sw_delta_scaling_with_gases   = ', &
-do_sw_delta_scaling_with_gases
-print*,'config%do_fu_lw_ice_optics_bug   = ', do_fu_lw_ice_optics_bug
-print*,'config%do_canopy_fluxes_sw   = ', do_canopy_fluxes_sw
-print*,'config%do_canopy_fluxes_lw   = ', do_canopy_fluxes_lw
-print*,'config%use_canopy_full_spectrum_sw   = ', use_canopy_full_spectrum_sw
-print*,'config%use_canopy_full_spectrum_lw   = ', use_canopy_full_spectrum_lw
-print*,'config%do_canopy_gases_sw   = ', do_canopy_gases_sw
-print*,'config%do_canopy_gases_lw   = ', do_canopy_gases_lw
-print*,'config%mono_lw_wavelength   = ', mono_lw_wavelength
-print*,'config%mono_lw_total_od   = ', mono_lw_total_od
-print*,'config%mono_sw_total_od   = ', mono_sw_total_od
-print*,'config%mono_lw_single_scattering_albedo   = ', &
-mono_lw_single_scattering_albedo
-print*,'config%mono_sw_single_scattering_albedo   = ', &
-mono_sw_single_scattering_albedo
-print*,'config%mono_lw_asymmetry_factor   = ', mono_lw_asymmetry_factor
-print*,'config%mono_sw_asymmetry_factor   = ', mono_sw_asymmetry_factor
-print*,'config%use_beta_overlap   = ', use_beta_overlap
-print*,'config%cloud_inhom_decorr_scaling   = ', cloud_inhom_decorr_scaling
-print*,'config%clear_to_thick_fraction   = ', clear_to_thick_fraction
-print*,'config%overhead_sun_factor   = ', overhead_sun_factor
-print*,'config%max_gas_od_3d   = ', max_gas_od_3d
-print*,'config%max_cloud_od   = ', max_cloud_od
-print*,'config%max_3d_transfer_rate   = ', max_3d_transfer_rate
-print*,'config%min_cloud_effective_size   = ', &
-max(1.0e-6_jprb,min_cloud_effective_size)
-print*,'config%overhang_factor   = ', encroachment_scaling
-
-print*,'config%directory_name  = ',directory_name
-print*,'config%cloud_pdf_override_file_name  = ',cloud_pdf_override_file_name
-print*,'config%liq_optics_override_file_name  = ',liq_optics_override_file_name
-print*,'config%ice_optics_override_file_name  = ',ice_optics_override_file_name
-print*,'config%aerosol_optics_override_file_name  = ', &
-aerosol_optics_override_file_name
-print*,'config%cloud_fraction_threshold  = ',cloud_fraction_threshold
-print*,'config%cloud_mixing_ratio_threshold  = ',cloud_mixing_ratio_threshold
-print*,'config%n_aerosol_types  = ',n_aerosol_types
-print*,'config%do_save_radiative_properties  = ',do_save_radiative_properties
-print*,'config%do_lw_derivatives  = ',do_lw_derivatives
-print*,'config%do_save_spectral_flux  = ',do_save_spectral_flux
-print*,'config%do_save_gpoint_flux  = ',do_save_gpoint_flux
-print*,'config%do_nearest_spectral_sw_albedo  = ',do_nearest_spectral_sw_albedo
-print*,'config%do_nearest_spectral_lw_emiss   = ',do_nearest_spectral_lw_emiss
-print*,'config%sw_albedo_wavelength_bound     = ',sw_albedo_wavelength_bound
-print*,'config%lw_emiss_wavelength_bound      = ',lw_emiss_wavelength_bound
-print*,'config%i_sw_albedo_index              = ',i_sw_albedo_index
-print*,'config%i_lw_emiss_index               = ',i_lw_emiss_index
-print*,'************************************************************************'
-endif
+    this%do_cloud_aerosol_per_lw_g_point = do_cloud_aerosol_per_lw_g_point
+    this%do_cloud_aerosol_per_sw_g_point = do_cloud_aerosol_per_sw_g_point
+    this%do_weighted_surface_mapping   = do_weighted_surface_mapping
+
     if (do_save_gpoint_flux) then
       ! Saving the fluxes every g-point overrides saving as averaged
@@ -919,5 +963,4 @@
       ! save anything
       this%do_save_spectral_flux = .true.
-      print*,'config%do_save_spectral_flux = .true.'
     end if
 
@@ -925,22 +968,19 @@
     call get_enum_code(liquid_model_name, LiquidModelName, &
          &            'liquid_model_name', this%i_liq_model)
-    print*,'config%i_liq_model =', this%i_liq_model
 
     ! Determine ice optics model
     call get_enum_code(ice_model_name, IceModelName, &
          &            'ice_model_name', this%i_ice_model)
-    print*,'config%i_ice_model =', this%i_ice_model
+
     ! Determine gas optics model
     call get_enum_code(gas_model_name, GasModelName, &
          &            'gas_model_name', this%i_gas_model)
-    print*,'config%%i_gas_model = ', this%i_gas_model
 
     ! Determine solvers
     call get_enum_code(sw_solver_name, SolverName, &
          &            'sw_solver_name', this%i_solver_sw)
-    print*,'config%i_solver_sw = ', this%i_solver_sw
     call get_enum_code(lw_solver_name, SolverName, &
          &            'lw_solver_name', this%i_solver_lw)
-    print*,'config%i_solver_lw = ', this%i_solver_lw
+
     if (len_trim(sw_encroachment_name) > 1) then
       call get_enum_code(sw_encroachment_name, EncroachmentName, &
@@ -950,5 +990,4 @@
       call get_enum_code(sw_entrapment_name, EntrapmentName, &
            &             'sw_entrapment_name', this%i_3d_sw_entrapment)
-      print*,'config%i_3d_sw_entrapment = ', this%i_3d_sw_entrapment
     end if
 
@@ -956,14 +995,13 @@
     call get_enum_code(overlap_scheme_name, OverlapName, &
          &             'overlap_scheme_name', this%i_overlap_scheme)
-    print*,'config%i_overlap_scheme = ', 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)
-    print*,'config%i_cloud_pdf_shape = ', 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)
-      print*,'config%i_aerosol_type_map = ', this%i_aerosol_type_map
     end if
 
@@ -975,5 +1013,18 @@
       this%do_clouds = .false.
     end if
-    print*,'config%do_clouds = ', this%do_clouds
+
+    if (this%i_gas_model == IGasModelIFSRRTMG &
+         & .and. (this%use_general_cloud_optics &
+         &        .or. this%use_general_aerosol_optics)) then
+      if (this%do_sw .and. this%do_cloud_aerosol_per_sw_g_point) then
+        write(nulout,'(a)') 'Warning: RRTMG SW only supports cloud/aerosol/surface optical properties per band, not per g-point'
+        this%do_cloud_aerosol_per_sw_g_point = .false.
+      end if
+      if (this%do_lw .and. this%do_cloud_aerosol_per_lw_g_point) then
+        write(nulout,'(a)') 'Warning: RRTMG LW only supports cloud/aerosol/surface optical properties per band, not per g-point'
+        this%do_cloud_aerosol_per_lw_g_point = .false.
+      end if
+    end if
+
 
     ! Normal subroutine exit
@@ -993,4 +1044,5 @@
   subroutine consolidate_config(this)
 
+    use parkind1,     only : jprd
     use yomhook,      only : lhook, dr_hook
     use radiation_io, only : nulout, nulerr, radiation_abort
@@ -1026,4 +1078,53 @@
       write(nulerr,'(a)') '*** Error: SPARTACUS/Tripleclouds solvers can only do Exponential-Random overlap'
       call radiation_abort('Radiation configuration error')
+    end if
+
+    if (jprb < jprd .and. this%iverbosesetup >= 1 &
+         &  .and. (this%i_solver_sw == ISolverSPARTACUS &
+         &    .or. this%i_solver_lw == ISolverSPARTACUS)) then
+      write(nulout,'(a)') 'Warning: the SPARTACUS solver may be unstable in single precision'
+    end if
+
+    ! If ecCKD gas optics model is being used set relevant file names
+    if (this%i_gas_model == IGasModelECCKD) then
+
+      ! This gas optics model requires the general cloud and
+      ! aerosol optics settings
+      if (.not. this%use_general_cloud_optics) then
+        write(nulerr,'(a)') '*** Error: ecCKD gas optics model requires general cloud optics'
+        call radiation_abort('Radiation configuration error')
+      end if
+      if (.not. this%use_general_aerosol_optics) then
+        write(nulerr,'(a)') '*** Error: ecCKD gas optics model requires general aerosol optics'
+        call radiation_abort('Radiation configuration error')
+      end if
+
+      if (len_trim(this%gas_optics_sw_override_file_name) > 0) then
+        if (this%gas_optics_sw_override_file_name(1:1) == '/') then
+          this%gas_optics_sw_file_name = trim(this%gas_optics_sw_override_file_name)
+        else
+          this%gas_optics_sw_file_name = trim(this%directory_name) &
+               &  // '/' // trim(this%gas_optics_sw_override_file_name)
+        end if
+      else
+        ! In the IFS, the gas optics files should be specified in
+        ! ifs/module/radiation_setup.F90, not here
+        this%gas_optics_sw_file_name = trim(this%directory_name) &
+             &  // "/ecckd-1.0_sw_climate_rgb-32b_ckd-definition.nc"
+      end if
+
+      if (len_trim(this%gas_optics_lw_override_file_name) > 0) then
+        if (this%gas_optics_lw_override_file_name(1:1) == '/') then
+          this%gas_optics_lw_file_name = trim(this%gas_optics_lw_override_file_name)
+        else
+          this%gas_optics_lw_file_name = trim(this%directory_name) &
+               &  // '/' // trim(this%gas_optics_lw_override_file_name)
+        end if
+      else
+        ! In the IFS, the gas optics files should be specified in
+        ! ifs/module/radiation_setup.F90, not here
+        this%gas_optics_lw_file_name = trim(this%directory_name) &
+             &  // "/ecckd-1.0_lw_climate_fsck-32b_ckd-definition.nc"
+      end if
 
     end if
@@ -1040,6 +1141,11 @@
       ! 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"
+      if (this%use_general_aerosol_optics) then
+         this%aerosol_optics_file_name &
+             &   = trim(this%directory_name) // "/aerosol_ifs_48R1.nc"       
+      else
+        this%aerosol_optics_file_name &
+             &   = trim(this%directory_name) // "/aerosol_ifs_rrtm_46R1_with_NI_AM.nc"
+      end if
     end if
 
@@ -1229,5 +1335,21 @@
            &          this%i_gas_model)
       call print_logical('  Aerosols are', 'use_aerosols', this%use_aerosols)
-      call print_logical('  Clouds are', 'do_clouds', this%do_clouds)
+      if (this%use_aerosols) then
+        call print_logical('  General aerosol optics', &
+             &             'use_general_aerosol_optics', this%use_general_aerosol_optics)
+      end if
+      if (this%do_clouds) then
+        write(nulout,'(a)') '  Clouds are ON'
+      else
+        write(nulout,'(a)') '  Clouds are OFF'
+      end if
+      if (this%do_sw) then
+        call print_logical('  Do cloud/aerosol/surface SW properties per g-point', &
+             &  'do_cloud_aerosol_per_sw_g_point', this%do_cloud_aerosol_per_sw_g_point)
+      end if
+      if (this%do_lw) then
+        call print_logical('  Do cloud/aerosol/surface LW properties per g-point', &
+             &  'do_cloud_aerosol_per_lw_g_point', this%do_cloud_aerosol_per_lw_g_point)
+      end if
 
       !---------------------------------------------------------------------
@@ -1253,4 +1375,7 @@
              &   'do_nearest_spectral_lw_emiss', this%do_nearest_spectral_lw_emiss)
       end if
+      call print_logical('  Planck-weighted surface albedo/emiss mapping', &
+           &   'do_weighted_surface_mapping', this%do_weighted_surface_mapping)
+
       !---------------------------------------------------------------------
       if (this%do_clouds) then
@@ -1260,11 +1385,15 @@
         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)
+        call print_logical('  General cloud optics', &
+             &             'use_general_cloud_optics', this%use_general_cloud_optics)
+        if (.not. this%use_general_cloud_optics) then
+          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
         end if
         call print_enum('  Cloud overlap scheme is', OverlapName, &
@@ -1360,4 +1489,9 @@
                &   'overhang_factor', this%overhang_factor)
         end if
+
+      else if (this%i_solver_sw == ISolverMcICA &
+           &  .or. this%i_solver_lw == ISolverMcICA) then
+        call print_logical('  Use vectorizable McICA cloud generator', &
+             &   'use_vectorizable_generator', this%use_vectorizable_generator)
       end if
             
@@ -1383,4 +1517,5 @@
     use parkind1, only : jprb
     use radiation_io, only : nulout, nulerr, radiation_abort
+    use radiation_spectral_definition, only : SolarReferenceTemperature
 
     class(config_type), intent(in) :: this
@@ -1396,12 +1531,16 @@
     character(len=*), optional, intent(in) :: weighting_name
 
+    real(jprb), allocatable   :: mapping(:,:)
+
     ! Internally we deal with wavenumber
     real(jprb) :: wavenumber1, wavenumber2 ! cm-1
 
+    real(jprb) :: wavenumber1_band, wavenumber2_band ! 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()      
+      call radiation_abort('Radiation configuration error')
     end if
 
@@ -1410,14 +1549,16 @@
     wavenumber2 = 0.01_jprb / wavelength1
 
+    call this%gas_optics_sw%spectral_def%calc_mapping_from_bands(SolarReferenceTemperature, &
+         &  [wavelength1, wavelength2], [1, 2, 3], mapping, &
+         &  use_bands=(.not. this%do_cloud_aerosol_per_sw_g_point), use_fluxes=.true.)
+
+    ! "mapping" now contains a 3*nband matrix, where mapping(2,:)
+    ! contains the weights of interest.  We now find the non-zero weights
     nweights = 0
-
-    do jband = 1,this%n_bands_sw
-      if (wavenumber1 < this%wavenumber2_sw(jband) &
-           &  .and. wavenumber2 > this%wavenumber1_sw(jband)) then
+    do jband = 1,size(mapping,2)
+      if (mapping(2,jband) > 0.0_jprb) 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))
+        iband(nweights) = jband;
+        weight(nweights) = mapping(2,jband)
       end if
     end do
@@ -1426,14 +1567,22 @@
       write(nulerr,'(a,e8.4,a,e8.4,a)') '*** Error: wavelength range ', &
            &  wavelength1, ' to ', wavelength2, ' m is outside shortwave band'
-      call radiation_abort()
+      call radiation_abort('Radiation configuration error')
     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
+      if (this%do_cloud_aerosol_per_sw_g_point) then
+        do jband = 1, nweights
+          write(nulout, '(a,i0,a,f8.4)') '  Shortwave g point ', iband(jband), ': ', weight(jband)
+        end do
+      else
+        do jband = 1, nweights
+          wavenumber1_band = this%gas_optics_sw%spectral_def%wavenumber1_band(iband(jband))
+          wavenumber2_band = this%gas_optics_sw%spectral_def%wavenumber2_band(iband(jband))
+          write(nulout, '(a,i0,a,f6.0,a,f6.0,a,f8.4)') '  Shortwave band ', &
+               &  iband(jband), ' (', wavenumber1_band, ' to ', &
+               &  wavenumber2_band, ' cm-1): ', weight(jband)
+        end do
+      end if
     end if
 
@@ -1452,4 +1601,5 @@
 
     use radiation_io, only : nulerr, radiation_abort
+    use radiation_spectral_definition, only : SolarReferenceTemperature
 
     class(config_type),   intent(inout) :: this
@@ -1467,5 +1617,5 @@
       write(nulerr,'(a,i0,a,i0)') '*** Error: ', ninterval, &
            &  ' albedo intervals exceeds maximum of ', NMaxAlbedoIntervals
-      call radiation_abort();
+      call radiation_abort('Radiation configuration error')
     end if
 
@@ -1480,10 +1630,10 @@
     this%i_sw_albedo_index(ninterval+1:)           = 0
 
+    ! If this routine is called before setup_radiation then the
+    ! spectral intervals are not yet known
+    ! consolidate_sw_albedo_intervals is called later.  Otherwise it
+    ! is called immediately and overwrites any existing mapping.
     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)
+      call this%consolidate_sw_albedo_intervals
     end if
 
@@ -1497,4 +1647,5 @@
 
     use radiation_io, only : nulerr, radiation_abort
+    use radiation_spectral_definition, only : TerrestrialReferenceTemperature
 
     class(config_type),   intent(inout) :: this
@@ -1512,5 +1663,5 @@
       write(nulerr,'(a,i0,a,i0)') '*** Error: ', ninterval, &
            &  ' emissivity intervals exceeds maximum of ', NMaxAlbedoIntervals
-      call radiation_abort();
+      call radiation_abort('Radiation configuration error')
     end if
 
@@ -1526,9 +1677,5 @@
 
     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)
+      call this%consolidate_lw_emiss_intervals
     end if
 
@@ -1537,62 +1684,45 @@
 
   !---------------------------------------------------------------------
-  ! 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
+  ! Set the wavelengths (m) at which monochromatic aerosol properties
+  ! are required. This routine must be called before consolidation of
+  ! settings.
+  subroutine set_aerosol_wavelength_mono(this, wavelength_mono)
+
+    use radiation_io, only : nulerr, radiation_abort
+    
+    class(config_type), intent(inout) :: this
+    real(jprb),         intent(in)    :: wavelength_mono(:)
+
+    if (this%is_consolidated) then
+      write(nulerr,'(a)') '*** Errror: set_aerosol_wavelength_mono must be called before setup_radiation'
+      call radiation_abort('Radiation configuration error')
+    end if
+   
+    if (allocated(this%aerosol_optics%wavelength_mono)) then
+      deallocate(this%aerosol_optics%wavelength_mono)
+    end if
+    allocate(this%aerosol_optics%wavelength_mono(size(wavelength_mono)))
+    this%aerosol_optics%wavelength_mono = wavelength_mono
+
+  end subroutine set_aerosol_wavelength_mono
+
+
+  !---------------------------------------------------------------------
+  ! Consolidate the surface shortwave albedo intervals with the
+  ! band/g-point intervals
+  subroutine consolidate_sw_albedo_intervals(this)
+
+    use radiation_io, only : nulout
+    use radiation_spectral_definition, only : SolarReferenceTemperature
 
     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)
+
+    integer :: ninterval, jint, jband
 
     ! Count the number of albedo/emissivity intervals
     ninterval = 0
-    do iinterval = 1,NMaxAlbedoIntervals
-      if (i_intervals(iinterval) > 0) then
-        ninterval = iinterval
+    do jint = 1,NMaxAlbedoIntervals
+      if (this%i_sw_albedo_index(jint) > 0) then
+        ninterval = jint
       else
         exit
@@ -1600,120 +1730,92 @@
     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.
+    if (ninterval < 1) then
+      ! The user has not specified shortwave albedo bands - assume
+      ! only one
       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
+      this%i_sw_albedo_index(1) = 1
+      this%i_sw_albedo_index(2:) = 0
       if (this%use_canopy_full_spectrum_sw) then
         this%n_canopy_bands_sw = this%n_g_sw
       else 
-        this%n_canopy_bands_sw = nvalue
+        this%n_canopy_bands_sw = 1
+      end if
+    else
+      if (this%use_canopy_full_spectrum_sw) then
+        this%n_canopy_bands_sw = this%n_g_sw
+      else 
+        this%n_canopy_bands_sw = maxval(this%i_sw_albedo_index(1:ninterval))
+      end if
+    end if
+    
+    if (this%do_weighted_surface_mapping) then
+      call this%gas_optics_sw%spectral_def%calc_mapping_from_bands(SolarReferenceTemperature, &
+           &  this%sw_albedo_wavelength_bound(1:ninterval-1), this%i_sw_albedo_index(1:ninterval), &
+           &  this%sw_albedo_weights, use_bands=(.not. this%do_cloud_aerosol_per_sw_g_point))
+    else
+      ! Weight each wavenumber equally as in IFS Cycles 48 and earlier
+      call this%gas_optics_sw%spectral_def%calc_mapping_from_bands(-1.0_jprb, &
+           &  this%sw_albedo_wavelength_bound(1:ninterval-1), this%i_sw_albedo_index(1:ninterval), &
+           &  this%sw_albedo_weights, use_bands=(.not. this%do_cloud_aerosol_per_sw_g_point))
+    end if
+
+    ! Legacy method uses input band with largest weight
+    if (this%do_nearest_spectral_sw_albedo) then
+      allocate(this%i_albedo_from_band_sw(this%n_bands_sw))
+      this%i_albedo_from_band_sw = maxloc(this%sw_albedo_weights, dim=1)
+    end if
+
+    if (this%iverbosesetup >= 2) then
+      write(nulout, '(a)') 'Surface shortwave albedo'
+      if (.not. this%do_nearest_spectral_sw_albedo) then
+        call this%gas_optics_sw%spectral_def%print_mapping_from_bands(this%sw_albedo_weights, &
+             &       use_bands=(.not. this%do_cloud_aerosol_per_sw_g_point))
+      else if (ninterval <= 1) then
+        write(nulout, '(a)') 'All shortwave bands will use the same albedo'
+      else
+        write(nulout, '(a,i0,a)',advance='no') 'Mapping from ', size(this%i_albedo_from_band_sw), &
+             &  ' shortwave intervals to albedo intervals:'
+        do jband = 1,size(this%i_albedo_from_band_sw)
+          write(nulout,'(a,i0)',advance='no') ' ', this%i_albedo_from_band_sw(jband)
+        end do
+        write(nulout, '()')
+      end if
+    end if
+    
+  end subroutine consolidate_sw_albedo_intervals
+
+
+  !---------------------------------------------------------------------
+  ! Consolidate the surface longwave emissivity intervals with the
+  ! band/g-point intervals
+  subroutine consolidate_lw_emiss_intervals(this)
+
+    use radiation_io, only : nulout
+    use radiation_spectral_definition, only : TerrestrialReferenceTemperature
+
+    class(config_type),   intent(inout) :: this
+
+    integer :: ninterval, jint, jband
+
+    ! Count the number of albedo/emissivity intervals
+    ninterval = 0
+    do jint = 1,NMaxAlbedoIntervals
+      if (this%i_lw_emiss_index(jint) > 0) then
+        ninterval = jint
+      else
+        exit
+      end if
+    end do
+
+    if (ninterval < 1) then
+      ! The user has not specified longwave emissivity bands - assume
+      ! only one
+      ninterval = 1
+      this%i_lw_emiss_index(1) = 1
+      this%i_lw_emiss_index(2:) = 0
+      if (this%use_canopy_full_spectrum_sw) then
+        this%n_canopy_bands_lw = this%n_g_lw
+      else 
+        this%n_canopy_bands_lw = 1
       end if
     else
@@ -1721,41 +1823,37 @@
         this%n_canopy_bands_lw = this%n_g_lw
       else 
-        this%n_canopy_bands_lw = nvalue
-      end if
+        this%n_canopy_bands_lw = maxval(this%i_lw_emiss_index(1:ninterval))
+      end if
+    end if
+
+    if (this%do_weighted_surface_mapping) then
+      call this%gas_optics_lw%spectral_def%calc_mapping_from_bands(TerrestrialReferenceTemperature, &
+           &  this%lw_emiss_wavelength_bound(1:ninterval-1), this%i_lw_emiss_index(1:ninterval), &
+           &  this%lw_emiss_weights, use_bands=(.not. this%do_cloud_aerosol_per_lw_g_point))
+    else
+      ! Weight each wavenumber equally as in IFS Cycles 48 and earlier
+      call this%gas_optics_lw%spectral_def%calc_mapping_from_bands(-1.0_jprb, &
+           &  this%lw_emiss_wavelength_bound(1:ninterval-1), this%i_lw_emiss_index(1:ninterval), &
+           &  this%lw_emiss_weights, use_bands=(.not. this%do_cloud_aerosol_per_lw_g_point))
+    end if
+
+    ! Legacy method uses input band with largest weight
+    if (this%do_nearest_spectral_lw_emiss) then
+      allocate(this%i_emiss_from_band_lw(this%n_bands_lw))
+      this%i_emiss_from_band_lw = maxloc(this%lw_emiss_weights, dim=1)
     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
+      write(nulout, '(a)') 'Surface longwave emissivity'
+      if (.not. this%do_nearest_spectral_lw_emiss) then
+        call this%gas_optics_lw%spectral_def%print_mapping_from_bands(this%lw_emiss_weights, &
+             &                          use_bands=(.not. this%do_cloud_aerosol_per_lw_g_point))
       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
+        write(nulout, '(a)') 'All longwave bands will use the same emissivty'
       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)
+        write(nulout, '(a,i0,a)',advance='no') 'Mapping from ', size(this%i_emiss_from_band_lw), &
+             &  ' longwave intervals to emissivity intervals:'
+        do jband = 1,size(this%i_emiss_from_band_lw)
+          write(nulout,'(a,i0)',advance='no') ' ', this%i_emiss_from_band_lw(jband)
         end do
         write(nulout, '()')
@@ -1763,5 +1861,5 @@
     end if
 
-  end subroutine consolidate_intervals
+  end subroutine consolidate_lw_emiss_intervals
 
 
@@ -1866,191 +1964,3 @@
   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_delta_eddington.h
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_delta_eddington.h	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_delta_eddington.h	(revision 4489)
@@ -1,3 +1,3 @@
-! radiation_delta_eddington.h - Delta-Eddington scaling
+! radiation_delta_eddington.h - Delta-Eddington scaling -*- f90 -*-
 !
 ! (C) Copyright 2015- ECMWF.
@@ -92,2 +92,24 @@
 end subroutine delta_eddington_scat_od
 
+
+!---------------------------------------------------------------------
+! Revert delta-Eddington-scaled quantities in-place, back to their
+! original state
+elemental subroutine revert_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
+  
+  g   = g / (1.0_jprb - g)
+  f   = g*g
+  ssa = ssa / (1.0_jprb - f + f*ssa);
+  od  = od / (1.0_jprb - ssa*f)
+  
+end subroutine revert_delta_eddington
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_ecckd.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_ecckd.F90	(revision 4489)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_ecckd.F90	(revision 4489)
@@ -0,0 +1,507 @@
+! radiation_ecckd.F90 - ecCKD generalized gas optics model
+!
+! (C) Copyright 2020- 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
+! License: see the COPYING file for details
+!
+
+module radiation_ecckd
+
+  use parkind1, only : jprb
+  use radiation_gas_constants
+  use radiation_ecckd_gas
+  use radiation_spectral_definition, only : spectral_definition_type
+
+  implicit none
+
+  public
+
+  !---------------------------------------------------------------------
+  ! This derived type contains all the data needed to describe a
+  ! correlated k-distribution gas optics model created using the ecCKD
+  ! tool
+  type ckd_model_type
+
+    ! Gas information
+
+    ! Number of gases
+    integer :: ngas = 0
+    ! Array of individual-gas data objects
+    type(ckd_gas_type), allocatable :: single_gas(:)
+    ! Mapping from the "gas codes" in the radiation_gas_constants
+    ! module to an index to the single_gas array, where zero means gas
+    ! not present (or part of a composite gas)
+    integer :: i_gas_mapping(0:NMaxGases)
+
+    ! Coordinates of main look-up table for absorption coeffts
+
+    ! Number of pressure and temperature points
+    integer :: npress = 0
+    integer :: ntemp  = 0
+    ! Natural logarithm of first (lowest) pressure (Pa) and increment
+    real(jprb) :: log_pressure1, d_log_pressure
+    ! First temperature profile (K), dimensioned (npress)
+    real(jprb), allocatable :: temperature1(:)
+    ! Temperature increment (K)
+    real(jprb) :: d_temperature
+
+    ! Look-up table for Planck function
+
+    ! Number of entries
+    integer :: nplanck = 0
+    ! Temperature of first element of look-up table and increment (K)
+    real(jprb), allocatable :: temperature1_planck
+    real(jprb), allocatable :: d_temperature_planck
+    ! Planck function (black body flux into a horizontal plane) in W
+    ! m-2, dimensioned (ng,nplanck)
+    real(jprb), allocatable :: planck_function(:,:)
+
+    ! Normalized solar irradiance in each g point dimensioned (ng)
+    real(jprb), allocatable :: norm_solar_irradiance(:)
+
+    ! Rayleigh molar scattering coefficient in m2 mol-1 in each g
+    ! point
+    real(jprb), allocatable :: rayleigh_molar_scat(:)
+
+    ! ! Spectral mapping of g points
+
+    ! ! Number of wavenumber intervals
+    ! integer :: nwav = 0
+
+    ! Number of k terms / g points
+    integer :: ng   = 0
+
+    ! Spectral definition describing bands and g points
+    type(spectral_definition_type) :: spectral_def
+
+    ! Shortwave: true, longwave: false
+    logical :: is_sw
+
+  contains
+
+    procedure :: read => read_ckd_model
+    procedure :: calc_optical_depth => calc_optical_depth_ckd_model
+    procedure :: print => print_ckd_model
+    procedure :: calc_planck_function
+    procedure :: calc_incoming_sw
+!    procedure :: deallocate => deallocate_ckd_model
+
+  end type ckd_model_type
+
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Read a complete ecCKD gas optics model from a NetCDF file
+  ! "filename"
+  subroutine read_ckd_model(this, filename, iverbose)
+
+    use easy_netcdf,  only : netcdf_file
+    !use radiation_io, only : nulerr, radiation_abort
+    use yomhook,      only : lhook, dr_hook
+
+    class(ckd_model_type), intent(inout) :: this
+    character(len=*),      intent(in)    :: filename
+    integer, optional,     intent(in)    :: iverbose
+
+    type(netcdf_file) :: file
+
+    real(jprb), allocatable :: pressure_lut(:)
+    real(jprb), allocatable :: temperature_full(:,:)
+    real(jprb), allocatable :: temperature_planck(:)
+
+    character(len=512) :: constituent_id
+
+    integer :: iverbose_local
+
+    ! Loop counters
+    integer :: jgas, jjgas
+
+    integer :: istart, inext, nchar, i_gas_code
+
+    real(jprb)         :: hook_handle
+
+    if (lhook) call dr_hook('radiation_ecckd:read_ckd_model',0,hook_handle)
+
+    if (present(iverbose)) then
+      iverbose_local = iverbose
+    else
+      iverbose_local = 3
+    end if
+
+    call file%open(trim(filename), iverbose=iverbose_local)
+
+    ! Read temperature and pressure coordinate variables
+    call file%get('pressure', pressure_lut)
+    this%log_pressure1 = log(pressure_lut(1))
+    this%npress = size(pressure_lut)
+    this%d_log_pressure = log(pressure_lut(2)) - this%log_pressure1
+    call file%get('temperature', temperature_full)
+    allocate(this%temperature1(this%npress));
+    this%temperature1 = temperature_full(:,1)
+    this%d_temperature = temperature_full(1,2)-temperature_full(1,1)
+    this%ntemp = size(temperature_full,2)
+    deallocate(temperature_full)
+    
+    ! Read Planck function, or solar irradiance and Rayleigh
+    ! scattering coefficient
+    if (file%exists('solar_irradiance')) then
+      this%is_sw = .true.
+      call file%get('solar_irradiance', this%norm_solar_irradiance)
+      this%norm_solar_irradiance = this%norm_solar_irradiance &
+           &  / sum(this%norm_solar_irradiance)
+      call file%get('rayleigh_molar_scattering_coeff', &
+           &  this%rayleigh_molar_scat)
+    else
+      this%is_sw = .false.
+      call file%get('temperature_planck', temperature_planck)
+      this%nplanck = size(temperature_planck)
+      this%temperature1_planck = temperature_planck(1)
+      this%d_temperature_planck = temperature_planck(2) - temperature_planck(1)
+      deallocate(temperature_planck)
+      call file%get('planck_function', this%planck_function)
+    end if
+
+    ! Read the spectral definition information into a separate
+    ! derived type
+    call this%spectral_def%read(file);
+    this%ng = this%spectral_def%ng
+
+    ! Read gases
+    call file%get('n_gases', this%ngas)
+    allocate(this%single_gas(this%ngas))
+    call file%get_global_attribute('constituent_id', constituent_id)
+    nchar = len(trim(constituent_id))
+    istart = 1
+    this%i_gas_mapping = 0
+    do jgas = 1, this%ngas
+      if (jgas < this%ngas) then
+        inext = istart + scan(constituent_id(istart:nchar), ' ')
+      else
+        inext = nchar+2
+      end if
+      ! Find gas code
+      i_gas_code = 0
+      do jjgas = 1, NMaxGases
+        if (constituent_id(istart:inext-2) == trim(GasLowerCaseName(jjgas))) then
+          i_gas_code = jjgas
+          exit
+        end if
+      end do
+      ! if (i_gas_code == 0) then
+      !   write(nulerr,'(a,a,a)') '*** Error: Gas "', constituent_id(istart:inext-2), &
+      !        & '" not understood'
+      !   call radiation_abort('Radiation configuration error')
+      ! end if
+      this%i_gas_mapping(i_gas_code) = jgas;
+      call this%single_gas(jgas)%read(file, constituent_id(istart:inext-2), i_gas_code)
+      istart = inext
+    end do
+    
+    if (lhook) call dr_hook('radiation_ecckd:read_ckd_model',1,hook_handle)
+
+  end subroutine read_ckd_model
+
+  !---------------------------------------------------------------------
+  ! Print a description of the correlated k-distribution model to the
+  ! "nulout" unit
+  subroutine print_ckd_model(this)
+
+    use radiation_io, only : nulout
+    use radiation_gas_constants
+
+    class(ckd_model_type), intent(in)  :: this
+
+    integer :: jgas
+    
+    if (this%is_sw) then
+      write(nulout,'(a)',advance='no') 'ecCKD shortwave gas optics model: '
+    else
+      write(nulout,'(a)',advance='no') 'ecCKD longwave gas optics model: '
+    end if
+
+    write(nulout,'(i0,a,i0,a,i0,a,i0,a)') &
+         &  nint(this%spectral_def%wavenumber1(1)), '-', &
+         &  nint(this%spectral_def%wavenumber2(size(this%spectral_def%wavenumber2))), &
+         &  ' cm-1, ', this%ng, ' g-points in ', this%spectral_def%nband, ' bands'
+    write(nulout,'(a,i0,a,i0,a,i0,a)') '  Look-up table sizes: ', this%npress, ' pressures, ', &
+         &  this%ntemp, ' temperatures, ', this%nplanck, ' planck-function entries'
+    write(nulout, '(a)') '  Gases:'
+    do jgas = 1,this%ngas
+      if (this%single_gas(jgas)%i_gas_code > 0) then
+        write(nulout, '(a,a,a)', advance='no') '    ', &
+             &  trim(GasName(this%single_gas(jgas)%i_gas_code)), ': '
+      else
+        write(nulout, '(a)', advance='no') '    Composite of well-mixed background gases: '
+      end if
+      select case (this%single_gas(jgas)%i_conc_dependence)
+        case (IConcDependenceNone)
+          write(nulout, '(a)') 'no concentration dependence'
+        case (IConcDependenceLinear)
+          write(nulout, '(a)') 'linear concentration dependence'
+        case (IConcDependenceRelativeLinear)
+          write(nulout, '(a,e14.6)') 'linear concentration dependence relative to a mole fraction of ', &
+               &  this%single_gas(jgas)%reference_mole_frac
+        case (IConcDependenceLUT)
+          write(nulout, '(a,i0,a,e14.6,a,e13.6)') 'look-up table with ', this%single_gas(jgas)%n_mole_frac, &
+               &  ' log-spaced mole fractions in range ', exp(this%single_gas(jgas)%log_mole_frac1), &
+               &  ' to ', exp(this%single_gas(jgas)%log_mole_frac1 &
+               &           + this%single_gas(jgas)%n_mole_frac*this%single_gas(jgas)%d_log_mole_frac)
+      end select
+    end do
+
+  end subroutine print_ckd_model
+
+
+  !---------------------------------------------------------------------
+  ! Compute layerwise optical depth for each g point for ncol columns
+  ! at nlev layers
+  subroutine calc_optical_depth_ckd_model(this, ncol, nlev, istartcol, iendcol, nmaxgas, &
+       &  pressure_hl, temperature_fl, mole_fraction_fl, &
+       &  optical_depth_fl, rayleigh_od_fl)
+
+    use yomhook,             only : lhook, dr_hook
+    use radiation_constants, only : AccelDueToGravity
+
+    ! Input variables
+
+    class(ckd_model_type), intent(in), target  :: this
+    ! Number of columns, levels and input gases
+    integer,               intent(in)  :: ncol, nlev, nmaxgas, istartcol, iendcol
+    ! Pressure at half levels (Pa), dimensioned (ncol,nlev+1)
+    real(jprb),            intent(in)  :: pressure_hl(ncol,nlev+1)
+    ! Temperature at full levels (K), dimensioned (ncol,nlev)
+    real(jprb),            intent(in)  :: temperature_fl(istartcol:iendcol,nlev)
+    ! Gas mole fractions at full levels (mol mol-1), dimensioned (ncol,nlev,nmaxgas)
+    real(jprb),            intent(in)  :: mole_fraction_fl(ncol,nlev,nmaxgas)
+    
+    ! Output variables
+
+    ! Layer absorption optical depth for each g point
+    real(jprb),            intent(out) :: optical_depth_fl(this%ng,nlev,istartcol:iendcol)
+    ! In the shortwave only, the Rayleigh scattering optical depth
+    real(jprb),  optional, intent(out) :: rayleigh_od_fl(this%ng,nlev,istartcol:iendcol)
+
+    ! Local variables
+
+    real(jprb), pointer :: molar_abs(:,:,:), molar_abs_conc(:,:,:,:)
+
+    ! Natural logarithm of pressure at full levels
+    real(jprb) :: log_pressure_fl(nlev)
+
+    ! Optical depth of single gas at one point in space versus
+    ! spectral interval
+    !real(jprb) :: od_single_gas(this%ng)
+
+    real(jprb) :: multiplier(nlev), simple_multiplier(nlev), global_multiplier, temperature1
+
+    ! Indices and weights in temperature, pressure and concentration interpolation
+    real(jprb) :: pindex1, tindex1, cindex1
+    real(jprb) :: pw1(nlev), pw2(nlev), tw1(nlev), tw2(nlev), cw1(nlev), cw2(nlev)
+    integer    :: ip1(nlev), it1(nlev), ic1(nlev)
+
+    ! Natural logarithm of mole fraction at one point
+    real(jprb) :: log_conc
+
+    ! Minimum mole fraction in look-up-table
+    real(jprb) :: mole_frac1
+
+    integer :: jcol, jlev, jgas, igascode
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_ecckd:calc_optical_depth',0,hook_handle)
+
+    global_multiplier = 1.0_jprb / (AccelDueToGravity * 0.001_jprb * AirMolarMass)
+
+    do jcol = istartcol,iendcol
+
+      log_pressure_fl = log(0.5_jprb * (pressure_hl(jcol,1:nlev)+pressure_hl(jcol,2:nlev+1)))
+
+      do jlev = 1,nlev
+        ! Find interpolation points in pressure
+        pindex1 = (log_pressure_fl(jlev)-this%log_pressure1) &
+             &    / this%d_log_pressure
+        pindex1 = 1.0_jprb + max(0.0_jprb, min(pindex1, this%npress-1.0001_jprb))
+        ip1(jlev) = int(pindex1)
+        pw2(jlev) = pindex1 - ip1(jlev)
+        pw1(jlev) = 1.0_jprb - pw2(jlev)
+
+        ! Find interpolation points in temperature
+        temperature1 = pw1(jlev)*this%temperature1(ip1(jlev)) &
+             &       + pw2(jlev)*this%temperature1(ip1(jlev)+1)
+        tindex1 = (temperature_fl(jcol,jlev) - temperature1) &
+             &    / this%d_temperature
+        tindex1 = 1.0_jprb + max(0.0_jprb, min(tindex1, this%ntemp-1.0001_jprb))
+        it1(jlev) = int(tindex1)
+        tw2(jlev) = tindex1 - it1(jlev)
+        tw1(jlev) = 1.0_jprb - tw2(jlev)
+
+        ! Concentration multiplier
+        simple_multiplier(jlev) = global_multiplier &
+             &  * (pressure_hl(jcol,jlev+1) - pressure_hl(jcol,jlev))
+      end do
+
+      optical_depth_fl(:,:,jcol) = 0.0_jprb
+      
+      do jgas = 1,this%ngas
+
+        associate (single_gas => this%single_gas(jgas))
+          igascode = this%single_gas(jgas)%i_gas_code
+          
+          select case (single_gas%i_conc_dependence)
+            
+          case (IConcDependenceLinear)
+            molar_abs => this%single_gas(jgas)%molar_abs
+            multiplier = simple_multiplier * mole_fraction_fl(jcol,:,igascode)
+
+            do jlev = 1,nlev
+              optical_depth_fl(:,jlev,jcol) = optical_depth_fl(:,jlev,jcol) &
+                   &        + (multiplier(jlev)*tw1(jlev)) * (pw1(jlev) * molar_abs(:,ip1(jlev),it1(jlev)) &
+                   &                +pw2(jlev) * molar_abs(:,ip1(jlev)+1,it1(jlev))) &
+                   &        + (multiplier(jlev)*tw2(jlev)) * (pw1(jlev) * molar_abs(:,ip1(jlev),it1(jlev)+1) &
+                   &                +pw2(jlev) * molar_abs(:,ip1(jlev)+1,it1(jlev)+1))
+            end do
+
+          case (IConcDependenceRelativeLinear)
+            molar_abs => this%single_gas(jgas)%molar_abs
+            multiplier = simple_multiplier  * (mole_fraction_fl(jcol,:,igascode) &
+                 &                            - single_gas%reference_mole_frac)
+            do jlev = 1,nlev
+              optical_depth_fl(:,jlev,jcol) = optical_depth_fl(:,jlev,jcol) &
+                   &        + (multiplier(jlev)*tw1(jlev)) * (pw1(jlev) * molar_abs(:,ip1(jlev),it1(jlev)) &
+                   &                +pw2(jlev) * molar_abs(:,ip1(jlev)+1,it1(jlev))) &
+                   &        + (multiplier(jlev)*tw2(jlev)) * (pw1(jlev) * molar_abs(:,ip1(jlev),it1(jlev)+1) &
+                   &                +pw2(jlev) * molar_abs(:,ip1(jlev)+1,it1(jlev)+1))
+            end do
+
+          case (IConcDependenceNone)
+            ! Composite gases
+            molar_abs => this%single_gas(jgas)%molar_abs
+            do jlev = 1,nlev
+              optical_depth_fl(:,jlev,jcol) = optical_depth_fl(:,jlev,jcol) &
+                   &  + (simple_multiplier(jlev)*tw1(jlev)) * (pw1(jlev) * molar_abs(:,ip1(jlev),it1(jlev)) &
+                   &                              +pw2(jlev) * molar_abs(:,ip1(jlev)+1,it1(jlev))) &
+                   &  + (simple_multiplier(jlev)*tw2(jlev)) * (pw1(jlev) * molar_abs(:,ip1(jlev),it1(jlev)+1) &
+                   &                              +pw2(jlev) * molar_abs(:,ip1(jlev)+1,it1(jlev)+1))
+            end do
+
+          case (IConcDependenceLUT)
+            ! Logarithmic interpolation in concentration space
+            molar_abs_conc => this%single_gas(jgas)%molar_abs_conc
+            mole_frac1 = exp(single_gas%log_mole_frac1)
+            do jlev = 1,nlev
+              ! Take care of mole_fraction == 0
+              log_conc = log(max(mole_fraction_fl(jcol,jlev,igascode), mole_frac1))
+              cindex1  = (log_conc - single_gas%log_mole_frac1) / single_gas%d_log_mole_frac
+              cindex1  = 1.0_jprb + max(0.0_jprb, min(cindex1, single_gas%n_mole_frac-1.0001_jprb))
+              ic1(jlev) = int(cindex1)
+              cw2(jlev) = cindex1 - ic1(jlev)
+              cw1(jlev) = 1.0_jprb - cw2(jlev)
+            end do
+              ! od_single_gas = cw1 * (tw1 * (pw1 * molar_abs_conc(:,ip1,it1,ic1) &
+              !      &                       +pw2 * molar_abs_conc(:,ip1+1,it1,ic1)) &
+              !      &                +tw2 * (pw1 * molar_abs_conc(:,ip1,it1+1,ic1) &
+              !      &                       +pw2 * molar_abs_conc(:,ip1+1,it1+1,ic1))) &
+              !      &         +cw2 * (tw1 * (pw1 * molar_abs_conc(:,ip1,it1,ic1+1) &
+              !      &                       +pw2 * molar_abs_conc(:,ip1+1,it1,ic1+1)) &
+              !      &                +tw2 * (pw1 * molar_abs_conc(:,ip1,it1+1,ic1+1) &
+              !      &                       +pw2 * molar_abs_conc(:,ip1+1,it1+1,ic1+1)))
+            do jlev = 1,nlev
+              optical_depth_fl(:,jlev,jcol) = optical_depth_fl(:,jlev,jcol) &
+                   &  + (simple_multiplier(jlev) * mole_fraction_fl(jcol,jlev,igascode)) * ( &
+                   &      (cw1(jlev) * tw1(jlev) * pw1(jlev)) * molar_abs_conc(:,ip1(jlev),it1(jlev),ic1(jlev)) &
+                   &     +(cw1(jlev) * tw1(jlev) * pw2(jlev)) * molar_abs_conc(:,ip1(jlev)+1,it1(jlev),ic1(jlev)) &
+                   &     +(cw1(jlev) * tw2(jlev) * pw1(jlev)) * molar_abs_conc(:,ip1(jlev),it1(jlev)+1,ic1(jlev)) &
+                   &     +(cw1(jlev) * tw2(jlev) * pw2(jlev)) * molar_abs_conc(:,ip1(jlev)+1,it1(jlev)+1,ic1(jlev)) &
+                   &     +(cw2(jlev) * tw1(jlev) * pw1(jlev)) * molar_abs_conc(:,ip1(jlev),it1(jlev),ic1(jlev)+1) &
+                   &     +(cw2(jlev) * tw1(jlev) * pw2(jlev)) * molar_abs_conc(:,ip1(jlev)+1,it1(jlev),ic1(jlev)+1) &
+                   &     +(cw2(jlev) * tw2(jlev) * pw1(jlev)) * molar_abs_conc(:,ip1(jlev),it1(jlev)+1,ic1(jlev)+1) &
+                   &     +(cw2(jlev) * tw2(jlev) * pw2(jlev)) * molar_abs_conc(:,ip1(jlev)+1,it1(jlev)+1,ic1(jlev)+1))
+            end do
+          end select
+            
+        end associate
+
+      end do
+
+      ! Ensure the optical depth is not negative
+      optical_depth_fl(:,:,jcol) = max(0.0_jprb, optical_depth_fl(:,:,jcol))
+
+      ! Rayleigh scattering
+      if (this%is_sw .and. present(rayleigh_od_fl)) then
+        do jlev = 1,nlev
+          rayleigh_od_fl(:,jlev,jcol) = global_multiplier &
+               &  * (pressure_hl(jcol,jlev+1) - pressure_hl(jcol,jlev)) * this%rayleigh_molar_scat
+        end do
+      end if
+
+    end do
+
+    if (lhook) call dr_hook('radiation_ecckd:calc_optical_depth',1,hook_handle)
+
+  end subroutine calc_optical_depth_ckd_model
+
+  !---------------------------------------------------------------------
+  ! Calculate the Planck function integrated across each of the g
+  ! points of this correlated k-distribution model, for a given
+  ! temperature, where Planck function is defined as the flux emitted
+  ! by a black body (rather than radiance)
+  subroutine calc_planck_function(this, nt, temperature, planck)
+
+    class(ckd_model_type), intent(in)  :: this
+    integer,    intent(in)  :: nt
+    real(jprb), intent(in)  :: temperature(:) ! K
+    real(jprb), intent(out) :: planck(this%ng,nt) ! W m-2
+
+    real(jprb) :: tindex1, tw1, tw2
+    integer    :: it1, jt
+
+    do jt = 1,nt
+      tindex1 = (temperature(jt) - this%temperature1_planck) &
+           &   * (1.0_jprb / this%d_temperature_planck)
+      if (tindex1 >= 0) then
+        ! Normal interpolation, and extrapolation for high temperatures
+        tindex1 = 1.0_jprb + tindex1
+        it1 = min(int(tindex1), this%nplanck-1)
+        tw2 = tindex1 - it1
+        tw1 = 1.0_jprb - tw2
+        planck(:,jt) = tw1 * this%planck_function(:,it1) &
+             &       + tw2 * this%planck_function(:,it1+1)
+      else
+        ! Interpolate linearly to zero
+        planck(:,jt) = this%planck_function(:,1) &
+             &       * (temperature(jt)/this%temperature1_planck)
+      end if
+    end do
+
+  end subroutine calc_planck_function
+  
+
+  !---------------------------------------------------------------------
+  ! Return the spectral solar irradiance integrated over each g point
+  ! of a solar correlated k-distribution model, given the
+  ! total_solar_irradiance
+  subroutine calc_incoming_sw(this, total_solar_irradiance, &
+       &                      spectral_solar_irradiance)
+
+    class(ckd_model_type), intent(in)    :: this
+    real(jprb),            intent(in)    :: total_solar_irradiance ! W m-2
+    real(jprb),            intent(inout) :: spectral_solar_irradiance(:,:) ! W m-2
+ 
+    spectral_solar_irradiance &
+         &  = spread(total_solar_irradiance * this%norm_solar_irradiance, &
+         &           2, size(spectral_solar_irradiance,2))
+
+  end subroutine calc_incoming_sw
+
+end module radiation_ecckd
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_ecckd_gas.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_ecckd_gas.F90	(revision 4489)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_ecckd_gas.F90	(revision 4489)
@@ -0,0 +1,118 @@
+! radiation_ecckd_gas.F90 - type representing a single ecCKD gas
+!
+! (C) Copyright 2020- 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
+! License: see the COPYING file for details
+!
+
+module radiation_ecckd_gas
+
+  use parkind1, only : jprb
+  use radiation_gas_constants
+
+  implicit none
+
+  public
+
+  ! Concentration dependence of individual gases
+  enum, bind(c)
+    enumerator :: IConcDependenceNone = 0, &
+         &        IConcDependenceLinear, &
+         &        IConcDependenceLUT, &
+         &        IConcDependenceRelativeLinear
+  end enum
+
+  !---------------------------------------------------------------------
+  ! This derived type describes a correlated k-distribution
+  ! representation of an individual gas (including composite gases)
+  type ckd_gas_type
+
+    ! Code identifying the gas, from the codes in the
+    ! radiation_gas_constants module
+    integer :: i_gas_code = -1
+
+    ! One of the IConcDependence* enumerators
+    integer :: i_conc_dependence
+
+    ! Molar absorption coefficient in m2 mol-1. If
+    ! i_conc_dependence==IConcDependenceNone then it is the absorption
+    ! cross section per mole of dry air.  If
+    ! conc_dependence==IConcDependenceLinear|IConcDependenceRelativeLinear,
+    ! it is the absorption cross section per mole of the gas in
+    ! question. It is dimensioned (g_point,pressure,temperature).
+    real(jprb), allocatable :: molar_abs(:,:,:)
+    
+    ! If i_conc_dependence==IConcDependenceLUT then we have an
+    ! additional dimension for concentration. It is dimensioned
+    ! (g_point,pressure,temperature,conc)
+    real(jprb), allocatable :: molar_abs_conc(:,:,:,:)
+
+    ! If i_conc_dependence==IConcDependenceRelativeLinear then the
+    ! following reference concentration is subtracted from the actual
+    ! concentration before the result is multiplied by the mass
+    ! absorption coefficient
+    real(jprb) :: reference_mole_frac = 0.0_jprb
+
+    ! Mole fraction coordinate variable if
+    ! i_conc_dependence==IConcDependenceLUT
+    real(jprb) :: log_mole_frac1 = 0.0_jprb, d_log_mole_frac = 1.0_jprb
+    integer    :: n_mole_frac = 0
+
+  contains
+
+    procedure :: read => read_ckd_gas
+!    procedure :: deallocate => deallocate_ckd_gas
+
+  end type ckd_gas_type
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Read information about the representation of a single gas from a
+  ! NetCDF file, identifying it with code i_gas_code
+  subroutine read_ckd_gas(this, file, gas_name, i_gas_code)
+
+    use easy_netcdf, only : netcdf_file
+
+    class(ckd_gas_type), intent(inout) :: this
+    type(netcdf_file),   intent(inout) :: file
+    character(len=*),    intent(in)    :: gas_name
+    integer,             intent(in)    :: i_gas_code
+    
+    ! Local storage for mole fraction coordinate variable
+    real(jprb), allocatable :: mole_fraction(:)
+
+    this%i_gas_code = i_gas_code
+
+    call file%get(gas_name // "_conc_dependence_code", this%i_conc_dependence)
+    if (this%i_conc_dependence == IConcDependenceLut) then
+      call file%get(gas_name // "_molar_absorption_coeff", &
+           &        this%molar_abs_conc)
+      call file%get(gas_name // "_mole_fraction", mole_fraction)
+      this%log_mole_frac1  = log(mole_fraction(1))
+      this%n_mole_frac     = size(mole_fraction)
+      this%d_log_mole_frac = (log(mole_fraction(size(mole_fraction))) &
+           &                  - this%log_mole_frac1) / (this%n_mole_frac-1)
+      deallocate(mole_fraction)
+    else
+      call file%get(gas_name // "_molar_absorption_coeff", &
+           &        this%molar_abs)
+    end if
+
+    if (this%i_conc_dependence == IConcDependenceRelativeLinear) then
+      call file%get(gas_name // "_reference_mole_fraction", &
+           &        this%reference_mole_frac)
+    end if
+
+  end subroutine read_ckd_gas
+
+end module radiation_ecckd_gas
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_ecckd_interface.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_ecckd_interface.F90	(revision 4489)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_ecckd_interface.F90	(revision 4489)
@@ -0,0 +1,278 @@
+! radiation_ecckd_interface.F90 - Interface to ecCKD gas optics model
+!
+! (C) Copyright 2020- 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
+! License: see the COPYING file for details
+!
+
+module radiation_ecckd_interface
+
+  implicit none
+
+  public  :: setup_gas_optics, set_gas_units, gas_optics !, planck_function
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Setup the ecCKD generalized gas optics model
+  subroutine setup_gas_optics(config)
+
+    use parkind1, only : jprb
+    use radiation_config
+
+    type(config_type), intent(inout), target :: config
+
+    integer :: jj
+    
+    if (config%do_sw) then
+
+      ! Read shortwave ecCKD gas optics NetCDF file
+      call config%gas_optics_sw%read(trim(config%gas_optics_sw_file_name), &
+           &                         config%iverbosesetup)
+
+      ! Copy over relevant properties
+      config%n_g_sw     = config%gas_optics_sw%ng
+
+      if (config%do_cloud_aerosol_per_sw_g_point) then
+        ! Bands and g points are the same
+        config%n_bands_sw = config%n_g_sw
+      else
+        ! Bands are groups of g points and span a continuous region of
+        ! wavenumber space
+        config%n_bands_sw = config%gas_optics_sw%spectral_def%nband
+      end if
+
+      allocate(config%i_band_from_g_sw          (config%n_g_sw))
+      allocate(config%i_band_from_reordered_g_sw(config%n_g_sw))
+      allocate(config%i_g_from_reordered_g_sw   (config%n_g_sw))
+        
+      if (config%do_cloud_aerosol_per_sw_g_point) then
+        config%i_band_from_g_sw           = [ (jj, jj = 1,config%n_g_sw) ]
+        config%i_band_from_reordered_g_sw = [ (jj, jj = 1,config%n_g_sw) ]
+      else
+        config%i_band_from_g_sw &
+             &  = config%gas_optics_sw%spectral_def%i_band_number
+        config%i_band_from_reordered_g_sw &
+             &  = config%gas_optics_sw%spectral_def%i_band_number
+      end if
+      config%i_g_from_reordered_g_sw      = [ (jj, jj = 1,config%n_g_sw) ]
+
+      if (config%iverbosesetup >= 2) then
+        call config%gas_optics_sw%print()
+      end if
+
+    end if
+
+    if (config%do_lw) then
+
+      ! Read longwave ecCKD gas optics NetCDF file
+      call config%gas_optics_lw%read(trim(config%gas_optics_lw_file_name), &
+           &                         config%iverbosesetup)
+
+      ! Copy over relevant properties
+      config%n_g_lw     = config%gas_optics_lw%ng
+
+      if (config%do_cloud_aerosol_per_lw_g_point) then
+        ! Bands and g points are the same
+        config%n_bands_lw = config%n_g_lw
+      else
+        ! Bands are groups of g points and span a continuous region of
+        ! wavenumber space
+        config%n_bands_lw = config%gas_optics_lw%spectral_def%nband
+      end if
+
+      allocate(config%i_band_from_g_lw          (config%n_g_lw))
+      allocate(config%i_band_from_reordered_g_lw(config%n_g_lw))
+      allocate(config%i_g_from_reordered_g_lw   (config%n_g_lw))
+
+      if (config%do_cloud_aerosol_per_lw_g_point) then
+        config%i_band_from_g_lw           = [ (jj, jj = 1,config%n_g_lw) ]
+        config%i_band_from_reordered_g_lw = [ (jj, jj = 1,config%n_g_lw) ]
+      else
+        config%i_band_from_g_lw &
+             &  = config%gas_optics_lw%spectral_def%i_band_number
+        config%i_band_from_reordered_g_lw &
+             &  = config%gas_optics_lw%spectral_def%i_band_number
+      end if
+      config%i_g_from_reordered_g_lw      = [ (jj, jj = 1,config%n_g_lw) ]
+
+      if (config%iverbosesetup >= 2) then
+        call config%gas_optics_lw%print()
+      end if
+
+    end if
+
+    ! 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
+
+  end subroutine setup_gas_optics
+
+
+  !---------------------------------------------------------------------
+  ! Scale gas mixing ratios according to required units
+  subroutine set_gas_units(gas)
+
+    use radiation_gas,           only : gas_type, IVolumeMixingRatio
+    type(gas_type),    intent(inout) :: gas
+
+    call gas%set_units(IVolumeMixingRatio)
+
+  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
+    use radiation_config,         only : config_type
+    use radiation_thermodynamics, only : thermodynamics_type
+    use radiation_single_level,   only : single_level_type
+    use radiation_gas_constants,  only : NMaxGases
+    use radiation_gas
+
+    integer,                  intent(in) :: ncol               ! number of columns
+    integer,                  intent(in) :: nlev               ! number of levels
+    integer,                  intent(in) :: istartcol, iendcol ! range of cols 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
+
+    ! Temperature at full levels (K)
+    real(jprb) :: temperature_fl(istartcol:iendcol,nlev)
+
+    integer :: jcol
+
+    !temperature_fl(istartcol:iendcol,:) &
+    !     &  = 0.5_jprb * (thermodynamics%temperature_hl(istartcol:iendcol,1:nlev) &
+    !     &               +thermodynamics%temperature_hl(istartcol:iendcol,2:nlev+1))
+ 
+    temperature_fl(istartcol:iendcol,:) &
+         &  = (thermodynamics%temperature_hl(istartcol:iendcol,1:nlev) &
+         &     *thermodynamics%pressure_hl(istartcol:iendcol,1:nlev) &
+         &    +thermodynamics%temperature_hl(istartcol:iendcol,2:nlev+1) &
+         &     *thermodynamics%pressure_hl(istartcol:iendcol,2:nlev+1)) &
+         &  / (thermodynamics%pressure_hl(istartcol:iendcol,1:nlev) &
+         &    +thermodynamics%pressure_hl(istartcol:iendcol,2:nlev+1))
+ 
+    if (config%do_sw) then
+
+      call config%gas_optics_sw%calc_optical_depth(ncol,nlev,istartcol,iendcol, &
+           &  NMaxGases, thermodynamics%pressure_hl, &
+           &  temperature_fl, &
+           &  gas%mixing_ratio, &
+!           &  reshape(gas%mixing_ratio(istartcol:iendcol,:,:), &
+!           &          [nlev,iendcol-istartcol+1,NMaxGases],order=[2,1,3]), &
+           &  od_sw, rayleigh_od_fl=ssa_sw)
+      ! At this point od_sw = absorption optical depth and ssa_sw =
+      ! rayleigh optical depth: convert to total optical depth and
+      ! single-scattering albedo
+      od_sw = od_sw + ssa_sw
+      ssa_sw = ssa_sw / od_sw
+
+      if (present(incoming_sw)) then
+        call config%gas_optics_sw%calc_incoming_sw(single_level%solar_irradiance, incoming_sw)
+      end if
+
+    end if
+
+    if (config%do_lw) then
+
+      call config%gas_optics_lw%calc_optical_depth(ncol,nlev,istartcol,iendcol, &
+           &  NMaxGases, thermodynamics%pressure_hl, &
+           &  temperature_fl, &
+           &  gas%mixing_ratio, &
+!           &  reshape(gas%mixing_ratio(istartcol:iendcol,:,:), &
+!           &          [nlev,iendcol-istartcol+1,NMaxGases],order=[2,1,3]), &
+           &  od_lw)
+
+      ! Calculate the Planck function for each g point
+      do jcol = istartcol,iendcol
+        call config%gas_optics_lw%calc_planck_function(nlev+1, &
+             &  thermodynamics%temperature_hl(jcol,:), planck_hl(:,:,jcol))
+      end do
+      call config%gas_optics_lw%calc_planck_function(iendcol+1-istartcol, &
+           &  single_level%skin_temperature(istartcol:iendcol), &
+           &  lw_emission(:,:))
+      lw_emission = lw_emission * (1.0_jprb - lw_albedo)
+
+    end if
+
+  end subroutine gas_optics
+
+  ! !---------------------------------------------------------------------
+  ! ! Externally facing function for computing the Planck function
+  ! ! without reference to any gas profile; typically this would be used
+  ! ! for computing the emission by a surface.
+  ! subroutine planck_function(config, temperature, planck_surf)
+
+  !   use parkind1,                 only : jprb
+  !   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
+
+  ! end subroutine planck_function
+
+end module radiation_ecckd_interface
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_flux.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_flux.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_flux.F90	(revision 4489)
@@ -100,4 +100,11 @@
   end type flux_type
 
+! Added for DWD (2020)
+#ifdef __SX__
+      logical, parameter :: use_indexed_sum_vec = .true.
+#else
+      logical, parameter :: use_indexed_sum_vec = .false.
+#endif
+
 contains
 
@@ -132,5 +139,5 @@
         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'
+               & // 'so cannot allocate spectral flux arrays'
           call radiation_abort()
         end if
@@ -321,4 +328,11 @@
     end if
 
+    if (allocated(this%lw_dn_surf_g))               deallocate(this%lw_dn_surf_g)
+    if (allocated(this%lw_dn_surf_clear_g))         deallocate(this%lw_dn_surf_clear_g)
+    if (allocated(this%sw_dn_diffuse_surf_g))       deallocate(this%sw_dn_diffuse_surf_g)
+    if (allocated(this%sw_dn_direct_surf_g))        deallocate(this%sw_dn_direct_surf_g)
+    if (allocated(this%sw_dn_diffuse_surf_clear_g)) deallocate(this%sw_dn_diffuse_surf_clear_g)
+    if (allocated(this%sw_dn_direct_surf_clear_g))  deallocate(this%sw_dn_direct_surf_clear_g)
+
     if (lhook) call dr_hook('radiation_flux:deallocate',1,hook_handle)
 
@@ -349,28 +363,56 @@
     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 (use_indexed_sum_vec) then
+        call indexed_sum_vec(this%sw_dn_direct_surf_g, &
+             &               config%i_band_from_reordered_g_sw, &
+             &               this%sw_dn_direct_surf_band, istartcol, iendcol)
+        call indexed_sum_vec(this%sw_dn_diffuse_surf_g, &
+             &               config%i_band_from_reordered_g_sw, &
+             &               this%sw_dn_surf_band, istartcol, iendcol)
+        do jcol = istartcol,iendcol
+          this%sw_dn_surf_band(:,jcol) &
+               &  = this%sw_dn_surf_band(:,jcol) &
+               &  + this%sw_dn_direct_surf_band(:,jcol)
+        end do
+      else
+        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
+      end if
 
       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
+        if (use_indexed_sum_vec) then
+          call indexed_sum_vec(this%sw_dn_direct_surf_clear_g, &
+               &               config%i_band_from_reordered_g_sw, &
+               &               this%sw_dn_direct_surf_clear_band, istartcol, iendcol)
+          call indexed_sum_vec(this%sw_dn_diffuse_surf_clear_g, &
+               &               config%i_band_from_reordered_g_sw, &
+               &               this%sw_dn_surf_clear_band, istartcol, iendcol)
+          do jcol = istartcol,iendcol
+            this%sw_dn_surf_clear_band(:,jcol) &
+                 &  = this%sw_dn_surf_clear_band(:,jcol) &
+                 &  + this%sw_dn_direct_surf_clear_band(:,jcol)
+          end do
+        else
+          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
 
@@ -383,12 +425,21 @@
         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
+        if (use_indexed_sum_vec) then
+          call indexed_sum_vec(this%sw_dn_direct_surf_g, &
+               &               config%i_albedo_from_band_sw(config%i_band_from_reordered_g_sw), &
+               &               this%sw_dn_direct_surf_canopy, istartcol, iendcol)
+          call indexed_sum_vec(this%sw_dn_diffuse_surf_g, &
+               &               config%i_albedo_from_band_sw(config%i_band_from_reordered_g_sw), &
+               &               this%sw_dn_diffuse_surf_canopy, istartcol, iendcol)
+        else
+          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
+        end if
       else
         ! More accurate calculations using weights, but requires
@@ -425,17 +476,29 @@
         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
+        if (use_indexed_sum_vec) then
+          call indexed_sum_vec(this%lw_dn_surf_g, &
+               &               config%i_emiss_from_band_lw(config%i_band_from_reordered_g_lw), &
+               &               this%lw_dn_surf_canopy, istartcol, iendcol)
+        else
+          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
+        end if
       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
+        if (use_indexed_sum_vec) then
+          call indexed_sum_vec(this%lw_dn_surf_g, &
+               &               config%i_band_from_reordered_g_lw, &
+               &               lw_dn_surf_band, istartcol, iendcol)
+        else
+          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
+        end if
         nalbedoband = size(config%lw_emiss_weights,1)
         this%lw_dn_surf_canopy(:,istartcol:iendcol) = 0.0_jprb
@@ -465,5 +528,5 @@
 
     use yomhook,          only : lhook, dr_hook
-    use radiation_config, only : out_of_bounds_2d
+    use radiation_check,  only : out_of_bounds_2d
 
     class(flux_type), intent(inout) :: this
@@ -497,5 +560,5 @@
   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_check, only : out_of_bounds_2d
     use radiation_constants, only : AccelDueToGravity
 
@@ -581,4 +644,25 @@
   end subroutine indexed_sum
 
+  !---------------------------------------------------------------------
+  ! Vectorized version of "add_indexed_sum"
+  subroutine indexed_sum_vec(source, ind, dest, ist, iend)
+
+    real(jprb), intent(in)  :: source(:,:)
+    integer,    intent(in)  :: ind(:)
+    real(jprb), intent(out) :: dest(:,:)
+    integer,    intent(in)  :: ist, iend
+
+    integer :: ig, jg, jc
+
+    dest = 0.0
+
+    do jg = lbound(source,1), ubound(source,1)
+      ig = ind(jg)
+      do jc = ist, iend
+        dest(ig,jc) = dest(ig,jc) + source(jg,jc)
+      end do
+    end do
+
+  end subroutine indexed_sum_vec
 
   !---------------------------------------------------------------------
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_gas.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_gas.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_gas.F90	(revision 4489)
@@ -19,49 +19,8 @@
 
   use parkind1, only : jprb
+  use radiation_gas_constants
 
   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
@@ -121,4 +80,6 @@
 
   !---------------------------------------------------------------------
+  ! Allocate a derived type for holding gas mixing ratios given the
+  ! number of columns and levels
   subroutine allocate_gas(this, ncol, nlev)
 
@@ -191,5 +152,6 @@
     integer,    optional, intent(in)    :: istartcol
 
-    integer :: i1, i2
+    integer :: i1, i2, jc, jk
+
 
     real(jprb)                          :: hook_handle
@@ -245,6 +207,10 @@
     this%iunits(igas) = iunits
     this%is_well_mixed(igas) = .false.
-    this%mixing_ratio(i1:i2,:,igas) = mixing_ratio
-
+
+    do jk = 1,this%nlev
+      do jc = i1,i2
+        this%mixing_ratio(jc,jk,igas) = mixing_ratio(jc-i1+1,jk)
+      end do
+    end do
     if (present(scale_factor)) then
       this%scale_factor(igas) = scale_factor
@@ -276,5 +242,5 @@
     real(jprb)                          :: hook_handle
 
-    integer :: i1, i2
+    integer :: i1, i2, jc, jk
 
     if (lhook) call dr_hook('radiation_gas:put_well_mixed',0,hook_handle)
@@ -326,6 +292,10 @@
     this%iunits(igas)                  = iunits
     this%is_well_mixed(igas)           = .true.
-    this%mixing_ratio(i1:i2,:,igas)    = mixing_ratio
-
+
+    do jk = 1,this%nlev
+      do jc = i1,i2
+        this%mixing_ratio(jc,jk,igas) = mixing_ratio
+      end do
+    end do
     if (present(scale_factor)) then
       this%scale_factor(igas) = scale_factor
@@ -344,5 +314,4 @@
   ! 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)
 
@@ -411,8 +380,8 @@
         if (iunits == IMassMixingRatio &
              &   .and. this%iunits(igas) == IVolumeMixingRatio) then
-          sf = sf * IGasMolarMass(igas) / IAirMolarMass
+          sf = sf * GasMolarMass(igas) / AirMolarMass
         else if (iunits == IVolumeMixingRatio &
              &   .and. this%iunits(igas) == IMassMixingRatio) then
-          sf = sf * IAirMolarMass / IGasMolarMass(igas)
+          sf = sf * AirMolarMass / GasMolarMass(igas)
         end if
         sf = sf * this%scale_factor(igas)
@@ -538,8 +507,8 @@
       if (iunits == IMassMixingRatio &
            &   .and. this%iunits(igas) == IVolumeMixingRatio) then
-        sf = sf * IGasMolarMass(igas) / IAirMolarMass
+        sf = sf * GasMolarMass(igas) / AirMolarMass
       else if (iunits == IVolumeMixingRatio &
            &   .and. this%iunits(igas) == IMassMixingRatio) then
-        sf = sf * IAirMolarMass / IGasMolarMass(igas)
+        sf = sf * AirMolarMass / GasMolarMass(igas)
       end if
       sf = sf * this%scale_factor(igas)
@@ -591,5 +560,5 @@
 
     use yomhook,          only : lhook, dr_hook
-    use radiation_config, only : out_of_bounds_3d
+    use radiation_check,  only : out_of_bounds_3d
 
     class(gas_type),   intent(inout) :: this
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_gas_constants.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_gas_constants.F90	(revision 4489)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_gas_constants.F90	(revision 4489)
@@ -0,0 +1,67 @@
+! radiation_gas_constants.F90 - Molar mases and ID codes of the various gases
+!
+! (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
+! License: see the COPYING file for details
+!
+
+module radiation_gas_constants
+
+  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 :: AirMolarMass = 28.970_jprb
+  real(jprb), parameter, dimension(0:NMaxGases) :: GasMolarMass = (/ &
+       & 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   '/)
+
+end module radiation_gas_constants
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_general_cloud_optics.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_general_cloud_optics.F90	(revision 4489)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_general_cloud_optics.F90	(revision 4489)
@@ -0,0 +1,286 @@
+! radiation_general_cloud_optics.F90 - Computing generalized cloud optical properties
+!
+! (C) Copyright 2020- 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
+! License: see the COPYING file for details
+!
+
+module radiation_general_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_general_cloud_optics_data.F90
+  subroutine setup_general_cloud_optics(config)
+
+    use parkind1,         only : jprb
+    use yomhook,          only : lhook, dr_hook
+
+    use radiation_io,     only : nulout
+    use radiation_config, only : config_type, NMaxCloudTypes
+    use radiation_spectral_definition, only : SolarReferenceTemperature, &
+         &                                    TerrestrialReferenceTemperature
+
+    type(config_type), intent(inout) :: config
+
+    character(len=511) :: file_name
+
+    integer :: jtype ! loop index
+    integer :: strlen
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_general_cloud_optics:setup_general_cloud_optics',0,hook_handle)
+
+    ! Count number of cloud types
+    config%n_cloud_types = 0
+    do jtype = 1,NMaxCloudTypes
+      if (len_trim(config%cloud_type_name(jtype)) > 0) then
+        config%n_cloud_types = jtype
+      else
+        exit
+      end if
+    end do
+
+    ! If cloud_type_name has not been provided then assume liquid,ice
+    ! noting that the default spectral averaging (defined in
+    ! radiation_config.F90) is "thick"
+    if (config%n_cloud_types == 0) then
+      config%cloud_type_name(1) = "mie_droplet"
+      config%cloud_type_name(2) = "baum-general-habit-mixture_ice"
+      ! Optionally override spectral averaging method
+      !config%use_thick_cloud_spectral_averaging(1) = .false.
+      !config%use_thick_cloud_spectral_averaging(2) = .false.
+      config%n_cloud_types = 2
+    end if
+
+    ! Allocate structures
+    if (config%do_sw) then
+      allocate(config%cloud_optics_sw(config%n_cloud_types))
+    end if
+
+    if (config%do_lw) then
+      allocate(config%cloud_optics_lw(config%n_cloud_types))
+    end if
+
+    ! Load cloud optics data
+    do jtype = 1,config%n_cloud_types
+      if (config%cloud_type_name(jtype)(1:1) == '/') then
+        file_name = trim(config%cloud_type_name(jtype))
+      else
+        strlen = len_trim(config%cloud_type_name(jtype))
+        if (config%cloud_type_name(jtype)(strlen-2:strlen) == ".nc") then
+          file_name = trim(config%directory_name) &
+               &  // '/' // trim(config%cloud_type_name(jtype))
+        else
+          file_name = trim(config%directory_name) &
+               &  // '/' // trim(config%cloud_type_name(jtype)) &
+               &  // '_scattering.nc'
+        end if
+      end if
+
+      if (config%do_sw) then
+        if (config%iverbosesetup >= 2) then
+          write(nulout,'(a,i0,a)') 'Shortwave cloud type ', jtype, ':'
+        end if
+        call config%cloud_optics_sw(jtype)%setup(file_name, &
+             &  config%gas_optics_sw%spectral_def, &
+             &  use_bands=(.not. config%do_cloud_aerosol_per_sw_g_point), &
+             &  use_thick_averaging=config%use_thick_cloud_spectral_averaging(jtype), &
+             &  weighting_temperature=SolarReferenceTemperature, &
+             &  iverbose=config%iverbosesetup)
+      end if
+
+      if (config%do_lw) then
+        if (config%iverbosesetup >= 2) then
+          write(nulout,'(a,i0,a)') 'Longwave cloud type ', jtype, ':'
+        end if
+        call config%cloud_optics_lw(jtype)%setup(file_name, &
+             &  config%gas_optics_lw%spectral_def, &
+             &  use_bands=(.not. config%do_cloud_aerosol_per_lw_g_point), &
+             &  use_thick_averaging=config%use_thick_cloud_spectral_averaging(jtype), &
+             &  weighting_temperature=TerrestrialReferenceTemperature, &
+             &  iverbose=config%iverbosesetup)
+      end if
+
+    end do
+
+    if (lhook) call dr_hook('radiation_general_cloud_optics:setup_general_cloud_optics',1,hook_handle)
+
+  end subroutine setup_general_cloud_optics
+
+  !---------------------------------------------------------------------
+  ! Compute cloud optical properties
+  subroutine general_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
+    use radiation_config, only : config_type
+    use radiation_thermodynamics, only    : thermodynamics_type
+    use radiation_cloud, only             : cloud_type
+    use radiation_constants, only         : AccelDueToGravity
+    !use radiation_general_cloud_optics_data, only : general_cloud_optics_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(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
+
+    ! In-cloud water path of one cloud type (kg m-2)
+    real(jprb), dimension(istartcol:iendcol,nlev) :: water_path
+
+    integer :: jtype, jcol, jlev
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_general_cloud_optics:general_cloud_optics',0,hook_handle)
+
+    if (config%iverbose >= 2) then
+      write(nulout,'(a)') 'Computing cloud absorption/scattering properties'
+    end if
+
+    ! 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
+
+    ! Loop over cloud types
+    do jtype = 1,config%n_cloud_types
+      ! Compute in-cloud water path
+      if (config%is_homogeneous) then
+        water_path = cloud%mixing_ratio(istartcol:iendcol,:,jtype) &
+             &  *  (thermodynamics%pressure_hl(istartcol:iendcol, 2:nlev+1) &
+             &     -thermodynamics%pressure_hl(istartcol:iendcol, 1:nlev)) &
+             &  * (1.0_jprb / AccelDueToGravity)
+      else
+        water_path = cloud%mixing_ratio(istartcol:iendcol,:,jtype) &
+             &  *  (thermodynamics%pressure_hl(istartcol:iendcol, 2:nlev+1) &
+             &     -thermodynamics%pressure_hl(istartcol:iendcol, 1:nlev)) &
+             &  * (1.0_jprb / (AccelDueToGravity &
+             &                 * max(config%cloud_fraction_threshold, &
+             &                       cloud%fraction(istartcol:iendcol,:))))
+      end if
+
+      ! Add optical properties to the cumulative total for the
+      ! longwave and shortwave
+      if (config%do_lw) then
+        ! For the moment, we use ssa_lw_cloud and g_lw_cloud as
+        ! containers for scattering optical depth and scattering
+        ! coefficient x asymmetry factor, then scale after
+        if (config%do_lw_cloud_scattering) then
+          call config%cloud_optics_lw(jtype)%add_optical_properties(config%n_bands_lw, nlev, &
+               &  iendcol+1-istartcol, cloud%fraction(istartcol:iendcol,:), &
+               &  water_path, cloud%effective_radius(istartcol:iendcol,:,jtype), &
+               &  od_lw_cloud, ssa_lw_cloud, g_lw_cloud)
+        else
+          call config%cloud_optics_lw(jtype)%add_optical_properties(config%n_bands_lw, nlev, &
+               &  iendcol+1-istartcol, cloud%fraction(istartcol:iendcol,:), &
+               &  water_path, cloud%effective_radius(istartcol:iendcol,:,jtype), od_lw_cloud)
+        end if
+      end if
+      
+      if (config%do_sw) then
+        ! For the moment, we use ssa_sw_cloud and g_sw_cloud as
+        ! containers for scattering optical depth and scattering
+        ! coefficient x asymmetry factor, then scale after
+        call config%cloud_optics_sw(jtype)%add_optical_properties(config%n_bands_sw, nlev, &
+             &  iendcol+1-istartcol, cloud%fraction(istartcol:iendcol,:), &
+             &  water_path, cloud%effective_radius(istartcol:iendcol,:,jtype), &
+             &  od_sw_cloud, ssa_sw_cloud, g_sw_cloud)
+      end if
+    end do
+
+    ! Scale the combined longwave optical properties
+    if (config%do_lw_cloud_scattering) then
+      do jcol = istartcol, iendcol
+        do jlev = 1,nlev
+          if (cloud%fraction(jcol,jlev) > 0.0_jprb) then
+            ! Note that original cloud optics does not do
+            ! delta-Eddington scaling for liquid clouds in longwave
+            call delta_eddington_extensive(od_lw_cloud(:,jlev,jcol), &
+                 &  ssa_lw_cloud(:,jlev,jcol), g_lw_cloud(:,jlev,jcol))
+            
+            ! Scale to get asymmetry factor and single scattering albedo
+            g_lw_cloud(:,jlev,jcol) = g_lw_cloud(:,jlev,jcol) &
+                 &  / max(ssa_lw_cloud(:,jlev,jcol), 1.0e-15_jprb)
+            ssa_lw_cloud(:,jlev,jcol) = ssa_lw_cloud(:,jlev,jcol) &
+                 &  / max(od_lw_cloud(:,jlev,jcol),  1.0e-15_jprb)
+          end if
+        end do
+      end do
+    end if
+    
+    ! Scale the combined shortwave optical properties
+    if (config%do_sw) then
+      if (.not. config%do_sw_delta_scaling_with_gases) then
+        do jcol = istartcol, iendcol
+          do jlev = 1,nlev
+            if (cloud%fraction(jcol,jlev) > 0.0_jprb) then
+              call delta_eddington_extensive(od_sw_cloud(:,jlev,jcol), &
+                   &  ssa_sw_cloud(:,jlev,jcol), g_sw_cloud(:,jlev,jcol))
+            end if
+          end do
+        end do
+      end if
+
+      do jcol = istartcol, iendcol
+        do jlev = 1,nlev
+          if (cloud%fraction(jcol,jlev) > 0.0_jprb) then
+            ! Scale to get asymmetry factor and single scattering albedo
+            g_sw_cloud(:,jlev,jcol) = g_sw_cloud(:,jlev,jcol) &
+                 &  / max(ssa_sw_cloud(:,jlev,jcol), 1.0e-15_jprb)
+            ssa_sw_cloud(:,jlev,jcol) = ssa_sw_cloud(:,jlev,jcol) &
+                 &  / max(od_sw_cloud(:,jlev,jcol),  1.0e-15_jprb)
+          end if
+        end do
+      end do
+    end if
+
+    if (lhook) call dr_hook('radiation_general_cloud_optics:general_cloud_optics',1,hook_handle)
+
+  end subroutine general_cloud_optics
+
+end module radiation_general_cloud_optics
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_general_cloud_optics_data.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_general_cloud_optics_data.F90	(revision 4489)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_general_cloud_optics_data.F90	(revision 4489)
@@ -0,0 +1,346 @@
+! radiation_general_cloud_optics_data.F90 - Type to store generalized cloud optical properties
+!
+! (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
+! License: see the COPYING file for details
+!
+
+module radiation_general_cloud_optics_data
+
+  use parkind1, only : jprb
+
+  implicit none
+
+  public
+
+  !---------------------------------------------------------------------
+  ! This type holds the configuration information to compute optical
+  ! properties for a particular type of cloud or hydrometeor in one of
+  ! the shortwave or longwave
+  type general_cloud_optics_type
+    ! Band-specific (or g-point-specific) values as a look-up table
+    ! versus effective radius dimensioned (nband,n_effective_radius)
+    
+    ! Extinction coefficient per unit mass (m2 kg-1)
+    real(jprb), allocatable, dimension(:,:) :: &
+         &  mass_ext
+    
+    ! Single-scattering albedo and asymmetry factor (dimensionless)
+    real(jprb), allocatable, dimension(:,:) :: &
+         &  ssa, asymmetry
+
+    ! Number of effective radius coefficients, start value and
+    ! interval in look-up table
+    integer    :: n_effective_radius = 0
+    real(jprb) :: effective_radius_0, d_effective_radius
+
+    ! Name of cloud/precip type (e.g. "liquid", "ice", "rain", "snow")
+    ! and the name of the optics scheme.  These two are used to
+    ! generate the name of the data file from which the coefficients
+    ! are read.
+    character(len=511) :: type_name, scheme_name
+    
+    ! Do we use bands or g-points?
+    logical :: use_bands = .false.
+
+   contains
+     procedure :: setup => setup_general_cloud_optics
+     procedure :: add_optical_properties
+
+  end type general_cloud_optics_type
+
+contains
+
+  ! Provides elemental function "delta_eddington"
+#include "radiation_delta_eddington.h"
+
+  !---------------------------------------------------------------------
+  ! Setup cloud optics coefficients by reading them from a file
+  subroutine setup_general_cloud_optics(this, file_name, specdef, &
+       &                                use_bands, use_thick_averaging, &
+       &                                weighting_temperature, &
+       &                                iverbose)
+
+    use yomhook,                       only : lhook, dr_hook
+    use easy_netcdf,                   only : netcdf_file
+    use radiation_spectral_definition, only : spectral_definition_type
+    use radiation_io,                  only : nulout, nulerr, radiation_abort
+
+    class(general_cloud_optics_type), intent(inout)    :: this
+    character(len=*), intent(in)               :: file_name
+    type(spectral_definition_type), intent(in) :: specdef
+    logical, intent(in), optional              :: use_bands, use_thick_averaging
+    real(jprb), intent(in), optional           :: weighting_temperature ! K
+    integer, intent(in), optional              :: iverbose
+    
+    ! Spectral properties read from file, dimensioned (wavenumber,
+    ! n_effective_radius)
+    real(jprb), dimension(:,:), allocatable :: mass_ext, & ! m2 kg-1
+         &                                     ssa, asymmetry
+
+    ! Reflectance of an infinitely thick cloud, needed for thick
+    ! averaging
+    real(jprb), dimension(:,:), allocatable :: ref_inf
+
+    ! Coordinate variables from file
+    real(jprb), dimension(:), allocatable :: wavenumber       ! cm-1
+    real(jprb), dimension(:), allocatable :: effective_radius ! m
+
+    ! Matrix mapping optical properties in the file to values per
+    ! g-point or band, such that in the thin-averaging case,
+    ! this%mass_ext=matmul(mapping,file%mass_ext), so mapping is
+    ! dimensioned (ngpoint,nwav)
+    real(jprb), dimension(:,:), allocatable :: mapping
+
+    ! The NetCDF file containing the coefficients
+    type(netcdf_file)  :: file
+
+    real(jprb) :: diff_spread
+    integer    :: iverb
+    integer    :: nre  ! Number of effective radii
+    integer    :: nwav ! Number of wavenumbers describing cloud
+
+    logical    :: use_bands_local, use_thick_averaging_local
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_general_cloud_optics_data:setup',0,hook_handle)
+
+    ! Set local values of optional inputs
+    if (present(iverbose)) then
+      iverb = iverbose
+    else
+      iverb = 2
+    end if
+
+    if (present(use_bands)) then
+      use_bands_local = use_bands
+    else
+      use_bands_local = .false.
+    end if
+
+    if (present(use_thick_averaging)) then
+      use_thick_averaging_local = use_thick_averaging
+    else
+      use_thick_averaging_local = .false.
+    end if
+
+    ! Open the scattering file and configure the way it is read
+    call file%open(trim(file_name), iverbose=iverb)
+    !call file%transpose_matrices()
+
+    ! Read coordinate variables
+    call file%get('wavenumber', wavenumber)
+    call file%get('effective_radius', effective_radius)
+
+    ! Read the band-specific coefficients
+    call file%get('mass_extinction_coefficient', mass_ext)
+    call file%get('single_scattering_albedo', ssa)
+    call file%get('asymmetry_factor', asymmetry)
+
+    ! Close scattering file
+    call file%close()
+
+    ! Check effective radius is evenly spaced
+    nre = size(effective_radius)
+    ! Fractional range of differences, should be near zero for evenly
+    ! spaced data
+    diff_spread = (maxval(effective_radius(2:nre)-effective_radius(1:nre-1))  &
+         &        -minval(effective_radius(2:nre)-effective_radius(1:nre-1))) &
+         &      /  minval(abs(effective_radius(2:nre)-effective_radius(1:nre-1)))
+    if (diff_spread > 0.01_jprb) then
+      write(nulerr, '(a,a,a)') '*** Error: effective_radius in ', &
+           &  trim(file_name), ', is not evenly spaced to 1%'
+      call radiation_abort('Radiation configuration error')
+    end if
+
+    ! Set up effective radius coordinate variable
+    this%n_effective_radius = nre
+    this%effective_radius_0 = effective_radius(1)
+    this%d_effective_radius = effective_radius(2) - effective_radius(1)
+
+    ! Set up weighting
+    if (.not. present(weighting_temperature)) then
+      write(nulerr, '(a)') '*** Error: weighting_temperature not provided'
+      call radiation_abort('Radiation configuration error')
+    end if
+
+    nwav = size(wavenumber)
+
+    ! Define the mapping matrix
+    call specdef%calc_mapping(weighting_temperature, &
+         &                    wavenumber, mapping, use_bands=use_bands)
+
+    ! Thick averaging should be performed on delta-Eddington scaled
+    ! quantities (it makes no difference to thin averaging)
+    call delta_eddington(mass_ext, ssa, asymmetry)
+
+    ! Thin averaging
+    this%mass_ext  = matmul(mapping, mass_ext)
+    this%ssa       = matmul(mapping, mass_ext*ssa) / this%mass_ext
+    this%asymmetry = matmul(mapping, mass_ext*ssa*asymmetry) / (this%mass_ext*this%ssa)
+    
+    if (use_thick_averaging_local) then
+      ! Thick averaging as described by Edwards and Slingo (1996),
+      ! modifying only the single-scattering albedo
+      allocate(ref_inf(nwav, nre))
+
+      ! Eqs. 18 and 17 of Edwards & Slingo (1996)
+      ref_inf = sqrt((1.0_jprb - ssa) / (1.0_jprb - ssa*asymmetry))
+      ref_inf = (1.0_jprb - ref_inf) / (1.0_jprb + ref_inf)
+      ! Here the left-hand side is actually the averaged ref_inf
+      this%ssa = matmul(mapping, ref_inf)
+      ! Eq. 19 of Edwards and Slingo (1996)
+      this%ssa = 4.0_jprb * this%ssa / ((1.0_jprb + this%ssa)**2 &
+           &  - this%asymmetry * (1.0_jprb - this%ssa)**2)
+
+      deallocate(ref_inf)
+    end if
+
+    deallocate(mapping)
+
+    ! Revert back to unscaled quantities
+    call revert_delta_eddington(this%mass_ext, this%ssa, this%asymmetry)
+
+    if (iverb >= 2) then
+      write(nulout,'(a,a)') '  File: ', trim(file_name)
+      write(nulout,'(a,f7.1,a)') '  Weighting temperature: ', weighting_temperature, ' K'
+      if (use_thick_averaging_local) then
+        write(nulout,'(a)') '  SSA averaging: optically thick limit'
+      else
+        write(nulout,'(a)') '  SSA averaging: optically thin limit'
+      end if
+      if (use_bands_local) then
+        write(nulout,'(a,i0,a)') '  Spectral discretization: ', specdef%nband, ' bands'
+      else
+        write(nulout,'(a,i0,a)') '  Spectral discretization: ', specdef%ng, ' g-points'
+      end if
+      write(nulout,'(a,i0,a,f6.1,a,f6.1,a)') '  Effective radius look-up: ', nre, ' points in range ', &
+           &  effective_radius(1)*1.0e6_jprb, '-', effective_radius(nre)*1.0e6_jprb, ' um'
+      write(nulout,'(a,i0,a,i0,a)') '  Wavenumber range: ', int(specdef%min_wavenumber()), '-', &
+           &  int(specdef%max_wavenumber()), ' cm-1'
+    end if
+
+    if (lhook) call dr_hook('radiation_general_cloud_optics_data:setup',1,hook_handle)
+
+  end subroutine setup_general_cloud_optics
+
+
+  !---------------------------------------------------------------------
+  ! Add the optical properties of a particular cloud type to the
+  ! accumulated optical properties of all cloud types
+  subroutine add_optical_properties(this, ng, nlev, ncol, &
+       &                            cloud_fraction, &
+       &                            water_path, effective_radius, &
+       &                            od, scat_od, scat_asymmetry)
+
+    use yomhook, only : lhook, dr_hook
+
+    class(general_cloud_optics_type), intent(in) :: this
+
+    ! Number of g points, levels and columns
+    integer, intent(in) :: ng, nlev, ncol
+
+    ! Properties of present cloud type, dimensioned (ncol,nlev)
+    real(jprb), intent(in) :: cloud_fraction(:,:)
+    real(jprb), intent(in) :: water_path(:,:)       ! kg m-2
+    real(jprb), intent(in) :: effective_radius(:,:) ! m
+
+    ! Optical properties which are additive per cloud type,
+    ! dimensioned (ng,nlev,ncol)
+    real(jprb), intent(inout), dimension(ng,nlev,ncol) &
+         &  :: od             ! Optical depth of layer
+    real(jprb), intent(inout), dimension(ng,nlev,ncol), optional &
+         &  :: scat_od, &     ! Scattering optical depth of layer
+         &     scat_asymmetry ! Scattering optical depth x asymmetry factor
+
+    real(jprb) :: od_local(ng)
+
+    real(jprb) :: re_index, weight1, weight2
+    integer :: ire
+
+    integer :: jcol, jlev
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_general_cloud_optics_data:add_optical_properties',0,hook_handle)
+
+    if (present(scat_od)) then
+      do jcol = 1,ncol
+        do jlev = 1,nlev
+          if (cloud_fraction(jcol, jlev) > 0.0_jprb) then
+            re_index = max(1.0_jprb, min(1.0_jprb + (effective_radius(jcol,jlev)-this%effective_radius_0) &
+                 &              / this%d_effective_radius, this%n_effective_radius-0.0001_jprb))
+            ire = int(re_index)
+            weight2 = re_index - ire
+            weight1 = 1.0_jprb - weight2
+            od_local = water_path(jcol, jlev) * (weight1*this%mass_ext(:,ire) &
+                 &                              +weight2*this%mass_ext(:,ire+1))
+            od(:,jlev,jcol) = od(:,jlev,jcol) + od_local
+            od_local = od_local * (weight1*this%ssa(:,ire) &
+                 &                +weight2*this%ssa(:,ire+1))
+            scat_od(:,jlev,jcol) = scat_od(:,jlev,jcol) + od_local
+            scat_asymmetry(:,jlev,jcol) = scat_asymmetry(:,jlev,jcol) &
+                 & + od_local * (weight1*this%asymmetry(:,ire) &
+                 &              +weight2*this%asymmetry(:,ire+1))
+          end if
+        end do
+      end do
+    else
+      ! No scattering: return the absorption optical depth
+      do jcol = 1,ncol
+        do jlev = 1,nlev
+          if (water_path(jcol, jlev) > 0.0_jprb) then
+            re_index = max(1.0, min(1.0_jprb + (effective_radius(jcol,jlev)-this%effective_radius_0) &
+                 &              / this%d_effective_radius, this%n_effective_radius-0.0001_jprb))
+            ire = int(re_index)
+            weight2 = re_index - ire
+            weight1 = 1.0_jprb - weight2
+            od(:,jlev,jcol) = od(:,jlev,jcol) &
+                 &  + water_path(jcol, jlev) * (weight1*this%mass_ext(:,ire) &
+                 &                             +weight2*this%mass_ext(:,ire+1)) &
+                 &  * (1.0_jprb - (weight1*this%ssa(:,ire)+weight2*this%ssa(:,ire+1)))
+          end if
+        end do
+      end do
+    end if
+
+    if (lhook) call dr_hook('radiation_general_cloud_optics_data:add_optical_properties',1,hook_handle)
+
+  end subroutine add_optical_properties
+
+
+  !---------------------------------------------------------------------
+  ! Return the Planck function (in W m-2 (cm-1)-1) for a given
+  ! wavenumber (cm-1) and temperature (K), ensuring double precision
+  ! for internal calculation
+  elemental function calc_planck_function_wavenumber(wavenumber, temperature)
+
+    use parkind1,            only : jprb, jprd
+    use radiation_constants, only : SpeedOfLight, BoltzmannConstant, PlanckConstant
+
+    real(jprb), intent(in) :: wavenumber  ! cm-1
+    real(jprb), intent(in) :: temperature ! K
+    real(jprb) :: calc_planck_function_wavenumber
+
+    real(jprd) :: freq ! Hz
+    real(jprd) :: planck_fn_freq ! W m-2 Hz-1
+
+    freq = 100.0_jprd * real(SpeedOfLight,jprd) * real(wavenumber,jprd)
+    planck_fn_freq = 2.0_jprd * real(PlanckConstant,jprd) * freq**3 &
+         &  / (real(SpeedOfLight,jprd)**2 * (exp(real(PlanckConstant,jprd)*freq &
+         &     /(real(BoltzmannConstant,jprd)*real(temperature,jprd))) - 1.0_jprd))
+    calc_planck_function_wavenumber = real(planck_fn_freq * 100.0_jprd * real(SpeedOfLight,jprd), jprb)
+
+  end function calc_planck_function_wavenumber
+
+end module radiation_general_cloud_optics_data
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_ice_optics_fu.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_ice_optics_fu.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_ice_optics_fu.F90	(revision 4489)
@@ -61,4 +61,5 @@
     real (jprb) :: iwp_gm_2
 
+    integer :: jb
     !real(jprb)  :: hook_handle
 
@@ -70,10 +71,14 @@
     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))), &
+! Added for DWD (2020)
+!NEC$ shortloop
+    do jb = 1, nb
+      od(jb) = iwp_gm_2 * (coeff(jb,1) + coeff(jb,2) * inv_de_um)
+      scat_od(jb) = od(jb) * (1.0_jprb - (coeff(jb,3) + de_um*(coeff(jb,4) &
+         &  + de_um*(coeff(jb,5) + de_um*coeff(jb,6)))))
+      g(jb) = min(coeff(jb,7) + de_um*(coeff(jb,8) &
+         &  + de_um*(coeff(jb,9) + de_um*coeff(jb,10))), &
          &  MaxAsymmetryFactor)
+    end do
 
     !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_fu_sw',1,hook_handle)
@@ -106,4 +111,5 @@
     real (jprb) :: iwp_gm_2
 
+    integer :: jb
     !real(jprb)  :: hook_handle
 
@@ -116,11 +122,15 @@
     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))), &
+! Added for DWD (2020)
+!NEC$ shortloop
+    do jb = 1, nb
+      od(jb) = iwp_gm_2 * (coeff(jb,1) + inv_de_um*(coeff(jb,2) &
+         &  + inv_de_um*coeff(jb,3)))
+      scat_od(jb) = od(jb) - iwp_gm_2*inv_de_um*(coeff(jb,4) + de_um*(coeff(jb,5) &
+         &  + de_um*(coeff(jb,6) + de_um*coeff(jb,7))))
+      g(jb) = min(coeff(jb,8) + de_um*(coeff(jb,9) &
+         &  + de_um*(coeff(jb,10) + de_um*coeff(jb,11))), &
          &  MaxAsymmetryFactor)
+    end do
 
     !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_fu_lw',1,hook_handle)
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_ifs_rrtm.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_ifs_rrtm.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_ifs_rrtm.F90	(revision 4489)
@@ -68,5 +68,5 @@
     real(jprb) :: hook_handle
 
-#include "surdi.intfb.h"
+!#include "surdi.intfb.h"
 #include "surrtab.intfb.h"
 #include "surrtpk.intfb.h"
@@ -81,5 +81,5 @@
     ! up now.
     if (config%do_setup_ifsrrtm) then
-      call SURDI
+      !call SURDI
       call SURRTAB
       call SURRTPK
@@ -89,4 +89,8 @@
     end if
 
+    ! Cloud and aerosol properties can only be defined per band
+    config%do_cloud_aerosol_per_sw_g_point = .false.
+    config%do_cloud_aerosol_per_lw_g_point = .false.
+
     config%n_g_sw = jpgsw
     config%n_g_lw = jpglw
@@ -97,17 +101,15 @@
     ! 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 /)
-    print*,'allocate dans ifs_rrtm'
+    call config%gas_optics_sw%spectral_def%allocate_bands_only( &
+         &  [2600.0_jprb, 3250.0_jprb, 4000.0_jprb, 4650.0_jprb, 5150.0_jprb, 6150.0_jprb, 7700.0_jprb, &
+         &   8050.0_jprb, 12850.0_jprb, 16000.0_jprb, 22650.0_jprb, 29000.0_jprb, 38000.0_jprb, 820.0_jprb], &
+         &  [3250.0_jprb, 4000.0_jprb, 4650.0_jprb, 5150.0_jprb, 6150.0_jprb, 7700.0_jprb, 8050.0_jprb, &
+         &   12850.0_jprb, 16000.0_jprb, 22650.0_jprb, 29000.0_jprb, 38000.0_jprb, 50000.0_jprb, 2600.0_jprb])
+    call config%gas_optics_lw%spectral_def%allocate_bands_only( &
+         &  [10.0_jprb, 350.0_jprb, 500.0_jprb, 630.0_jprb, 700.0_jprb, 820.0_jprb, 980.0_jprb, 1080.0_jprb, &
+         &   1180.0_jprb, 1390.0_jprb, 1480.0_jprb, 1800.0_jprb, 2080.0_jprb, 2250.0_jprb, 2380.0_jprb, 2600.0_jprb], &
+         &  [350.0_jprb, 500.0_jprb, 630.0_jprb, 700.0_jprb, 820.0_jprb, 980.0_jprb, 1080.0_jprb, 1180.0_jprb, &
+         &   1390.0_jprb, 1480.0_jprb, 1800.0_jprb, 2080.0_jprb, 2250.0_jprb, 2380.0_jprb, 2600.0_jprb, 3250.0_jprb])
+
     allocate(config%i_band_from_g_sw          (config%n_g_sw))
     allocate(config%i_band_from_g_lw          (config%n_g_lw))
@@ -360,10 +362,14 @@
 !    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))
+    do jlev=1,nlev
+      do jcol= istartcol,iendcol
+        pressure_fl(jcol,jlev) &
+            &  = 0.5_jprb * (thermodynamics%pressure_hl(jcol,jlev+istartlev-1) &
+            &               +thermodynamics%pressure_hl(jcol,jlev+istartlev))
+        temperature_fl(jcol,jlev) &
+            &  = 0.5_jprb * (thermodynamics%temperature_hl(jcol,jlev+istartlev-1) &
+            &               +thermodynamics%temperature_hl(jcol,jlev+istartlev))
+      end do
+    end do
     
     ! Check we have gas mixing ratios in the right units
@@ -402,5 +408,5 @@
          &  ZRAT_N2OCO2, ZRAT_N2OCO2_1, ZRAT_O3CO2, ZRAT_O3CO2_1)   
 
-    ZTAUAERL = 0.0_jprb
+    ZTAUAERL(istartcol:iendcol,:,:) = 0.0_jprb
 
     CALL RRTM_GAS_OPTICAL_DEPTH &
@@ -434,5 +440,5 @@
         lw_emission = lw_emission * (1.0_jprb - lw_albedo)
       else
-      ! Longwave emission has already been computed
+        ! Longwave emission has already been computed
         if (config%use_canopy_full_spectrum_lw) then
           lw_emission = transpose(single_level%lw_emission(istartcol:iendcol,:))
@@ -509,7 +515,10 @@
     ! 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)
+      do jg = 1,JPGPT_SW
+        do jcol = istartcol,iendcol 
+          ZINCSOL(jcol,jg) = ZINCSOL(jcol,jg) * &
+            &   single_level%spectral_solar_scaling(config%i_band_from_reordered_g_sw(jg))
+        end do
+      end do
     end if
 
@@ -518,8 +527,11 @@
     ! 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
+! Added for DWD (2020)
+!NEC$ nounroll
           incoming_sw_scale(jcol) = single_level%solar_irradiance / sum(ZINCSOL(jcol,:))
+        else
+          incoming_sw_scale(jcol) = 1.0_jprb
         end if
       end do
@@ -546,7 +558,7 @@
     else
       ! G points have not been reordered
-      do jg = 1,config%n_g_sw
+      do jcol = istartcol,iendcol
         do jlev = 1,nlev
-          do jcol = istartcol,iendcol
+          do jg = 1,config%n_g_sw
             ! Check for negative optical depth
             od_sw (jg,nlev+1-jlev,jcol) = max(config%min_gas_od_sw, ZOD_SW(jcol,jlev,jg))
@@ -555,6 +567,7 @@
         end do
         if (present(incoming_sw)) then
-          incoming_sw(jg,:) &
-               &  = incoming_sw_scale(:) * ZINCSOL(:,jg)
+          do jg = 1,config%n_g_sw
+            incoming_sw(jg,jcol) = incoming_sw_scale(jcol) * ZINCSOL(jcol,jg)
+          end do
         end if
       end do
@@ -604,5 +617,5 @@
     real(jprb) :: temperature
 
-    real(jprb) :: factor
+    real(jprb) :: factor, planck_tmp(istartcol:iendcol,config%n_g_lw)
     real(jprb) :: ZFLUXFAC
 
@@ -689,5 +702,8 @@
           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)
+            planck_tmp(:,jg) = planck_store(:,iband) * PFRAC(:,jg,nlev+2-jlev)
+          end do
+          do jcol = istartcol,iendcol
+            planck_hl(:,jlev,jcol) = planck_tmp(jcol,:)
           end do
         end if
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_interface.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_interface.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_interface.F90	(revision 4489)
@@ -40,5 +40,7 @@
     use yomhook,          only : lhook, dr_hook
     use radiation_config, only : config_type, ISolverMcICA, &
-         &   IGasModelMonochromatic, IGasModelIFSRRTMG
+         &   IGasModelMonochromatic, IGasModelIFSRRTMG, IGasModelECCKD
+    use radiation_spectral_definition, only &
+         &  : SolarReferenceTemperature, TerrestrialReferenceTemperature
 
     ! Currently there are two gas absorption models: RRTMG (default)
@@ -48,6 +50,8 @@
          &   setup_cloud_optics_mono   => setup_cloud_optics, &
          &   setup_aerosol_optics_mono => setup_aerosol_optics
-    use radiation_ifs_rrtm,       only :  setup_gas_optics
+    use radiation_ifs_rrtm,       only :  setup_gas_optics_rrtmg => setup_gas_optics
+    use radiation_ecckd_interface,only :  setup_gas_optics_ecckd => setup_gas_optics
     use radiation_cloud_optics,   only :  setup_cloud_optics
+    use radiation_general_cloud_optics, only :  setup_general_cloud_optics
     use radiation_aerosol_optics, only :  setup_aerosol_optics
 
@@ -66,5 +70,7 @@
       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))
+      call setup_gas_optics_rrtmg(config, trim(config%directory_name))
+    else if (config%i_gas_model == IGasModelECCKD) then
+      call setup_gas_optics_ecckd(config)
     end if
 
@@ -100,18 +106,16 @@
     ! 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_sw) then
+      call config%consolidate_sw_albedo_intervals
+    end if
+    if (config%do_lw) then
+      call config%consolidate_lw_emiss_intervals
+    end if
 
     if (config%do_clouds) then
       if (config%i_gas_model == IGasModelMonochromatic) then
         !      call setup_cloud_optics_mono(config)
+      elseif (config%use_general_cloud_optics) then
+        call setup_general_cloud_optics(config)
       else
         call setup_cloud_optics(config)
@@ -147,7 +151,8 @@
     
     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
+    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
+    use radiation_ecckd_interface, only : set_gas_units_ecckd => set_gas_units
 
     type(config_type), intent(in)    :: config
@@ -156,4 +161,6 @@
     if (config%i_gas_model == IGasModelMonochromatic) then
       call set_gas_units_mono(gas)
+    elseif (config%i_gas_model == IGasModelECCKD) then
+      call set_gas_units_ecckd(gas)
     else
       call set_gas_units_ifs(gas)
@@ -207,6 +214,8 @@
          &   cloud_optics_mono       => cloud_optics, &
          &   add_aerosol_optics_mono => add_aerosol_optics
-    use radiation_ifs_rrtm,       only : gas_optics
+    use radiation_ifs_rrtm,       only : gas_optics_rrtmg => gas_optics
+    use radiation_ecckd_interface,only : gas_optics_ecckd => gas_optics
     use radiation_cloud_optics,   only : cloud_optics
+    use radiation_general_cloud_optics, only : general_cloud_optics
     use radiation_aerosol_optics, only : add_aerosol_optics
 
@@ -309,6 +318,12 @@
              &  od_lw, od_sw, ssa_sw, &
              &  planck_hl, lw_emission, incoming_sw)
+      else if (config%i_gas_model == IGasModelIFSRRTMG) then
+        call gas_optics_rrtmg(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)
       else
-        call gas_optics(ncol,nlev,istartcol,iendcol, config, &
+        call gas_optics_ecckd(ncol,nlev,istartcol,iendcol, config, &
              &  single_level, thermodynamics, gas, &
              &  od_lw, od_sw, ssa_sw, lw_albedo=lw_albedo, &
@@ -330,4 +345,9 @@
           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)
+        elseif (config%use_general_cloud_optics) then
+          call general_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)
@@ -351,8 +371,8 @@
         end if
       else
-        g_sw = 0.0_jprb
+        g_sw(:,:,istartcol:iendcol) = 0.0_jprb
         if (config%do_lw_aerosol_scattering) then
-          ssa_lw = 0.0_jprb
-          g_lw   = 0.0_jprb
+          ssa_lw(:,:,istartcol:iendcol) = 0.0_jprb
+          g_lw(:,:,istartcol:iendcol)   = 0.0_jprb
         end if
       end if
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_liquid_optics_socrates.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_liquid_optics_socrates.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_liquid_optics_socrates.F90	(revision 4489)
@@ -52,4 +52,5 @@
     real(jprb), intent(out) :: od(nb), scat_od(nb), g(nb)
 
+    integer    :: jb
     ! Local effective radius (m), after applying bounds
     real(jprb) :: re
@@ -62,12 +63,16 @@
     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)))
+! Added for DWD (2020)
+!NEC$ shortloop
+    do jb = 1, nb
+      od(jb) = lwp * (coeff(jb,1) + re*(coeff(jb,2) + re*coeff(jb,3))) &
+         &  / (1.0_jprb + re*(coeff(jb,4) + re*(coeff(jb,5) &
+         &  + re*coeff(jb,6))))
+      scat_od(jb) = od(jb) * (1.0_jprb &
+         &  - (coeff(jb,7) + re*(coeff(jb,8) + re*coeff(jb,9))) &
+         &  / (1.0_jprb + re*(coeff(jb,10) + re*coeff(jb,11))))
+      g(jb) = (coeff(jb,12) + re*(coeff(jb,13) + re*coeff(jb,14))) &
+         &  / (1.0_jprb + re*(coeff(jb,15) + re*coeff(jb,16)))
+    end do
 
     !if (lhook) call dr_hook('radiation_liquid_optics_socrates:calc_liq_optics_socrates',1,hook_handle)
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_matrix.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_matrix.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_matrix.F90	(revision 4489)
@@ -550,6 +550,4 @@
     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:
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_mcica_lw.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_mcica_lw.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_mcica_lw.F90	(revision 4489)
@@ -157,7 +157,5 @@
         ! 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, &
+          call calc_two_stream_gammas_lw(ng, ssa(:,jlev,jcol), g(:,jlev,jcol), &
                &  gamma1, gamma2)
           call calc_reflectance_transmittance_lw(ng, &
@@ -206,5 +204,6 @@
            &  config%cloud_inhom_decorr_scaling, cloud%fractional_std(jcol,:), &
            &  config%pdf_sampler, od_scaling, total_cloud_cover, &
-           &  is_beta_overlap=config%use_beta_overlap)
+           &  use_beta_overlap=config%use_beta_overlap, &
+           &  use_vectorizable_generator=config%use_vectorizable_generator)
       
       ! Store total cloud cover
@@ -225,9 +224,11 @@
             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
+            do jg = 1,ng
+              od_cloud_new(jg) = od_scaling(jg,jlev) &
+                 &  * od_cloud(config%i_band_from_reordered_g_lw(jg),jlev,jcol)
+              od_total(jg)  = od(jg,jlev,jcol) + od_cloud_new(jg)
+              ssa_total(jg) = 0.0_jprb
+              g_total(jg)   = 0.0_jprb
+            end do
 
             if (config%do_lw_cloud_scattering) then
@@ -239,18 +240,23 @@
                 ! 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
+                do jg = 1,ng
+                  if (od_total(jg) > 0.0_jprb) then
+                    scat_od_total(jg) = ssa(jg,jlev,jcol)*od(jg,jlev,jcol) &
+                     &     + ssa_cloud(config%i_band_from_reordered_g_lw(jg),jlev,jcol) &
+                     &     *  od_cloud_new(jg)
+                    ssa_total(jg) = scat_od_total(jg) / od_total(jg)
+
+                    if (scat_od_total(jg) > 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_lw(jg),jlev,jcol) &
+                         &     * ssa_cloud(config%i_band_from_reordered_g_lw(jg),jlev,jcol) &
+                         &     *  od_cloud_new(jg)) &
+                         &     / scat_od_total(jg)
+                    end if
+                  end if
+                end do
+
               else
+
                 do jg = 1,ng
                   if (od_total(jg) > 0.0_jprb) then
@@ -265,4 +271,5 @@
                   end if
                 end do
+
               end if
             
@@ -301,7 +308,4 @@
           ! 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), &
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_mcica_sw.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_mcica_sw.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_mcica_sw.F90	(revision 4489)
@@ -211,5 +211,6 @@
              &  config%cloud_inhom_decorr_scaling, cloud%fractional_std(jcol,:), &
              &  config%pdf_sampler, od_scaling, total_cloud_cover, &
-             &  is_beta_overlap=config%use_beta_overlap)
+             &  use_beta_overlap=config%use_beta_overlap, &
+             &  use_vectorizable_generator=config%use_vectorizable_generator)
 
         ! Store total cloud cover
@@ -221,13 +222,14 @@
             ! 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
+                od_cloud_new(jg) = od_scaling(jg,jlev) &
+                   &  * od_cloud(config%i_band_from_reordered_g_sw(jg),jlev,jcol)
+                od_total(jg)  = od(jg,jlev,jcol) + od_cloud_new(jg)
+                ssa_total(jg) = 0.0_jprb
+                g_total(jg)   = 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
                 if (od_total(jg) > 0.0_jprb) then
                   scat_od = ssa(jg,jlev,jcol)*od(jg,jlev,jcol) &
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_monochromatic.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_monochromatic.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_monochromatic.F90	(revision 4489)
@@ -345,9 +345,9 @@
     real(jprb), dimension(config%n_g_sw,nlev,istartcol:iendcol), intent(out) :: g_sw
 
-    g_sw = 0.0_jprb
+    g_sw(:,:,istartcol:iendcol) = 0.0_jprb
 
     if (config%do_lw_aerosol_scattering) then
-      ssa_lw = 0.0_jprb
-      g_lw   = 0.0_jprb
+      ssa_lw(:,:,istartcol:iendcol) = 0.0_jprb
+      g_lw(:,:,istartcol:iendcol)   = 0.0_jprb
     end if
 
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_pdf_sampler.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_pdf_sampler.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_pdf_sampler.F90	(revision 4489)
@@ -1,3 +1,3 @@
-! radiation_pdf_sampler.F90 - Get samples from a lognormal distribution for McICA
+! radiation_pdf_sampler.F90 - Get samples from a PDF for McICA
 !
 ! (C) Copyright 2015- ECMWF.
@@ -22,7 +22,8 @@
 
   !---------------------------------------------------------------------
-  ! 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)
+  ! Derived type for sampling from a lognormal or gamma distribution,
+  ! or other PDF, 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
@@ -43,4 +44,6 @@
     procedure :: sample => sample_from_pdf
     procedure :: masked_sample => sample_from_pdf_masked
+    procedure :: block_sample => sample_from_pdf_block
+    procedure :: masked_block_sample => sample_from_pdf_masked_block
     procedure :: deallocate => deallocate_pdf_sampler
 
@@ -117,8 +120,8 @@
 
   !---------------------------------------------------------------------
-  ! 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.
+  ! Extract the value from a PDF 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)
     
@@ -156,9 +159,8 @@
 
   !---------------------------------------------------------------------
-  ! 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.
+  ! For true elements of mask, extract the values of a PDF 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)
     
@@ -208,3 +210,114 @@
   end subroutine sample_from_pdf_masked
 
+  !---------------------------------------------------------------------
+  ! Extract the values of a PDF with fractional standard deviation
+  ! "fsd" corresponding to the cumulative distribution function values
+  ! "cdf", and return in val. This version works on 2D blocks of data.
+  subroutine sample_from_pdf_block(this, nz, ng, fsd, cdf, val)
+    
+    class(pdf_sampler_type), intent(in)  :: this
+
+    ! Number of samples
+    integer,    intent(in) :: nz, ng
+
+    ! Fractional standard deviation (0 to 4) and cumulative
+    ! distribution function (0 to 1)
+    real(jprb), intent(in)  :: fsd(nz), cdf(ng, nz)
+
+    ! Sample from distribution
+    real(jprb), intent(out) :: val(:,:)
+
+    ! Loop index
+    integer    :: jz, jg
+
+    ! Index to look-up table
+    integer    :: ifsd, icdf
+
+    ! Weights in bilinear interpolation
+    real(jprb) :: wfsd, wcdf
+
+    do jz = 1,nz
+      do jg = 1,ng
+        if (cdf(jg, jz) > 0.0_jprb) then
+          ! Bilinear interpolation with bounds
+          wcdf = cdf(jg,jz) * (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(jz)-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(jg,jz)=(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(jg,jz) = 0.0_jprb
+        end if
+      end do
+    end do
+
+  end subroutine sample_from_pdf_block
+
+  !---------------------------------------------------------------------
+  ! Extract the values of a PDF with fractional standard deviation
+  ! "fsd" corresponding to the cumulative distribution function values
+  ! "cdf", and return in val. This version works on 2D blocks of data.
+  subroutine sample_from_pdf_masked_block(this, nz, ng, fsd, cdf, val, mask)
+    
+    class(pdf_sampler_type), intent(in)  :: this
+
+    ! Number of samples
+    integer,    intent(in) :: nz, ng
+
+    ! Fractional standard deviation (0 to 4) and cumulative
+    ! distribution function (0 to 1)
+    real(jprb), intent(in)  :: fsd(nz), cdf(ng, nz)
+
+    ! Sample from distribution
+    real(jprb), intent(out) :: val(:,:)
+
+    ! Mask
+    logical,    intent(in), optional :: mask(nz)
+
+    ! Loop index
+    integer    :: jz, jg
+
+    ! Index to look-up table
+    integer    :: ifsd, icdf
+
+    ! Weights in bilinear interpolation
+    real(jprb) :: wfsd, wcdf
+
+    do jz = 1,nz
+
+      if (mask(jz)) then
+        
+        do jg = 1,ng
+          if (cdf(jg, jz) > 0.0_jprb) then
+            ! Bilinear interpolation with bounds
+            wcdf = cdf(jg,jz) * (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(jz)-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(jg,jz)=(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(jg,jz) = 0.0_jprb
+          end if
+        end do
+
+      end if
+
+    end do
+
+  end subroutine sample_from_pdf_masked_block
+
 end module radiation_pdf_sampler
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_random_numbers.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_random_numbers.F90	(revision 4489)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_random_numbers.F90	(revision 4489)
@@ -0,0 +1,304 @@
+! radiation_random_numbers.F90 - Generate random numbers for McICA solver
+!
+! (C) Copyright 2020- 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
+!
+! The derived type "rng_type" is a random number generator that uses
+! either (1) Fortran's built-in random_number function, or (2) a
+! vectorized version of the MINSTD linear congruential generator.  In
+! the case of (2), an rng_type object is initialized with a seed that
+! is used to fill up a state of "nmaxstreams" elements using the C++
+! minstd_rand0 version of the MINSTD linear congruential generator
+! (LNG), which has the form istate[i+1] = mod(istate[i]*A0, M) from
+! i=1 to i=nmaxstreams. Subsequent requests for blocks of nmaxstreams
+! of random numbers use the C++ minstd_ran algorithm in a vectorizable
+! form, which modifies the state elements via istate[i] <-
+! mod(istate[i]*A, M). Uniform deviates are returned that normalize
+! the state elements to the range 0-1.
+!
+! The MINSTD generator was coded because the random_numbers_mix
+! generator in the IFS was found not to vectorize well on some
+! hardware.  I am no expert on random number generators, so my
+! implementation should really be looked at and improved by someone
+! who knows what they are doing.
+!
+! Reference for MINSTD: Park, Stephen K.; Miller, Keith
+! W. (1988). "Random Number Generators: Good Ones Are Hard To Find"
+! (PDF). Communications of the ACM. 31 (10):
+! 1192–1201. doi:10.1145/63039.63042
+!
+! Modifications
+!   2022-12-01  R. Hogan  Fixed zeroed state in single precision
+
+module radiation_random_numbers
+
+  use parkind1, only : jprb, jprd, jpim, jpib
+
+  implicit none
+
+  public :: rng_type, IRngMinstdVector, IRngNative
+
+  enum, bind(c) 
+    enumerator IRngNative, &    ! Built-in Fortran-90 RNG
+         &     IRngMinstdVector ! Vector MINSTD algorithm
+  end enum
+  
+  ! Maximum number of random numbers that can be computed in one call
+  ! - this can be increased
+  integer(kind=jpim), parameter :: NMaxStreams = 512
+  
+  ! A requirement of the generator is that the operation mod(A*X,M) is
+  ! performed with no loss of precision, so type used for A and X must
+  ! be able to hold the largest possible value of A*X without
+  ! overflowing, going negative or losing precision. The largest
+  ! possible value is 48271*2147483647 = 103661183124337. This number
+  ! can be held in either a double-precision real number, or an 8-byte
+  ! integer. Either may be used, but on some hardwares it has been
+  ! found that operations on double-precision reals are faster. Select
+  ! which you prefer by defining USE_REAL_RNG_STATE for double
+  ! precision, or undefining it for an 8-byte integer.
+#define USE_REAL_RNG_STATE 1
+
+  ! Define RNG_STATE_TYPE based on USE_REAL_RNG_STATE, where jprd
+  ! refers to a double-precision number regardless of the working
+  ! precision described by jprb, while jpib describes an 8-byte
+  ! integer
+#ifdef USE_REAL_RNG_STATE
+#define RNG_STATE_TYPE real(kind=jprd)
+#else
+#define RNG_STATE_TYPE integer(kind=jpib)
+#endif
+
+  ! The constants used in the main random number generator
+  RNG_STATE_TYPE , parameter :: IMinstdA  = 48271
+  RNG_STATE_TYPE , parameter :: IMinstdM  = 2147483647
+
+  ! An alternative value of A that can be used to initialize the
+  ! members of the state from a single seed
+  RNG_STATE_TYPE , parameter :: IMinstdA0 = 16807
+  
+  ! Scaling to convert the state to a uniform deviate in the range 0
+  ! to 1 in working precision
+  real(kind=jprb), parameter :: IMinstdScale = 1.0_jprb / real(IMinstdM,jprb)
+
+  !---------------------------------------------------------------------
+  ! A random number generator type: after being initialized with a
+  ! seed, type and optionally a number of vector streams, subsequent
+  ! calls to "uniform_distribution" are used to fill 1D or 2D arrays
+  ! with random numbers in a way that ought to be fast.
+  type rng_type
+
+    integer(kind=jpim) :: itype = IRngNative
+    RNG_STATE_TYPE     :: istate(NMaxStreams)
+    integer(kind=jpim) :: nmaxstreams = NMaxStreams
+    integer(kind=jpim) :: iseed
+
+  contains
+    procedure :: initialize
+    procedure :: uniform_distribution_1d, &
+         &       uniform_distribution_2d, &
+         &       uniform_distribution_2d_masked
+    generic   :: uniform_distribution => uniform_distribution_1d, &
+         &                               uniform_distribution_2d, &
+         &                               uniform_distribution_2d_masked
+
+  end type rng_type
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Initialize a random number generator, where "itype" may be either
+  ! IRngNative, indicating to use Fortran's native random_number
+  ! subroutine, or IRngMinstdVector, indicating to use the MINSTD
+  ! linear congruential generator (LCG).  In the latter case
+  ! "nmaxstreams" should be provided indicating that random numbers
+  ! will be requested in blocks of this length. The generator is
+  ! seeded with "iseed".
+  subroutine initialize(this, itype, iseed, nmaxstreams)
+
+    class(rng_type), intent(inout) :: this
+    integer(kind=jpim), intent(in), optional :: itype
+    integer(kind=jpim), intent(in), optional :: iseed
+    integer(kind=jpim), intent(in), optional :: nmaxstreams
+
+    integer, allocatable :: iseednative(:)
+    integer :: nseed, jseed, jstr
+    real(jprd) :: rseed ! Note this must be in double precision
+
+    if (present(itype)) then
+      this%itype = itype
+    else
+      this%itype = IRngNative
+    end if
+    
+    if (present(iseed)) then
+      this%iseed = iseed
+    else
+      this%iseed = 1
+    end if
+
+    if (present(nmaxstreams)) then
+      this%nmaxstreams = nmaxstreams
+    else
+      this%nmaxstreams = NMaxStreams
+    end if
+    
+    if (this%itype == IRngMinstdVector) then
+      ! ! OPTION 1: Use the C++ minstd_rand0 algorithm to populate the
+      ! ! state: this loop is not vectorizable because the state in
+      ! ! one stream depends on the one in the previous stream.
+      ! this%istate(1) = this%iseed
+      ! do jseed = 2,this%nmaxstreams
+      !   this%istate(jseed) = mod(IMinstdA0 * this%istate(jseed-1), IMinstdM)
+      ! end do
+
+      ! OPTION 2: Use a modified (and vectorized) C++ minstd_rand0 algorithm to
+      ! populate the state
+      rseed = real(abs(this%iseed),jprd)
+      do jstr = 1,this%nmaxstreams
+        ! Note that nint returns an integer of type jpib (8-byte)
+        ! which may be converted to double if that is the type of
+        ! istate
+        this%istate(jstr) = nint(mod(rseed*jstr*(1.0_jprd-0.05_jprd*jstr &
+             &      +0.005_jprd*jstr**2)*IMinstdA0, real(IMinstdM,jprd)),kind=jpib)
+      end do
+
+      ! One warmup of the C++ minstd_rand algorithm
+      do jstr = 1,this%nmaxstreams
+        this%istate(jstr) = mod(IMinstdA * this%istate(jstr), IMinstdM)
+      end do
+      
+    else
+      ! Native generator by default
+      call random_seed(size=nseed)
+      allocate(iseednative(nseed))
+      do jseed = 1,nseed
+        iseednative(jseed) = this%iseed + jseed - 1
+      end do
+      call random_seed(put=iseednative)
+      deallocate(iseednative)
+    end if
+
+  end subroutine initialize
+
+  !---------------------------------------------------------------------
+  ! Populate vector "randnum" with pseudo-random numbers; if rannum is
+  ! of length greater than nmaxstreams (specified when the generator
+  ! was initialized) then only the first nmaxstreams elements will be
+  ! assigned.
+  subroutine uniform_distribution_1d(this, randnum)
+
+    class(rng_type), intent(inout) :: this
+    real(kind=jprb), intent(out)   :: randnum(:)
+
+    integer :: imax, i
+
+    if (this%itype == IRngMinstdVector) then
+      
+      imax = min(this%nmaxstreams, size(randnum))
+
+      ! C++ minstd_rand algorithm
+      do i = 1, imax
+        ! The following calculation is computed entirely with 8-byte
+        ! numbers (whether real or integer)
+        this%istate(i) = mod(IMinstdA * this%istate(i), IMinstdM)
+        ! Scale the current state to a number in working precision
+        ! (jprb) between 0 and 1
+        randnum(i) = IMinstdScale * this%istate(i)
+      end do
+
+    else
+
+      call random_number(randnum)
+
+    end if
+
+  end subroutine uniform_distribution_1d
+
+
+  !---------------------------------------------------------------------
+  ! Populate matrix "randnum" with pseudo-random numbers; if the inner
+  ! dimension of rannum is of length greater than nmaxstreams
+  ! (specified when the generator was initialized) then only the first
+  ! nmaxstreams elements along this dimension will be assigned.
+  subroutine uniform_distribution_2d(this, randnum)
+
+    class(rng_type), intent(inout) :: this
+    real(kind=jprb), intent(out)   :: randnum(:,:)
+
+    integer :: imax, jblock, i
+
+    if (this%itype == IRngMinstdVector) then
+      
+      imax = min(this%nmaxstreams, size(randnum,1))
+
+      ! C++ minstd_ran algorithm
+      do jblock = 1,size(randnum,2)
+        ! These lines should be vectorizable
+        do i = 1, imax
+          this%istate(i) = mod(IMinstdA * this%istate(i), IMinstdM)
+          randnum(i,jblock) = IMinstdScale * this%istate(i)
+        end do
+      end do
+
+    else
+
+      call random_number(randnum)
+
+    end if
+
+  end subroutine uniform_distribution_2d
+
+  !---------------------------------------------------------------------
+  ! Populate matrix "randnum" with pseudo-random numbers; if the inner
+  ! dimension of rannum is of length greater than nmaxstreams
+  ! (specified when the generator was initialized) then only the first
+  ! nmaxstreams elements along this dimension will be assigned. This
+  ! version only operates on outer dimensions for which "mask" is true.
+  subroutine uniform_distribution_2d_masked(this, randnum, mask)
+
+    class(rng_type), intent(inout) :: this
+    real(kind=jprb), intent(inout) :: randnum(:,:)
+    logical,         intent(in)    :: mask(:)
+
+    integer :: imax, jblock, i
+
+    if (this%itype == IRngMinstdVector) then
+      
+      imax = min(this%nmaxstreams, size(randnum,1))
+
+      ! C++ minstd_ran algorithm
+      do jblock = 1,size(randnum,2)
+        if (mask(jblock)) then
+          ! These lines should be vectorizable
+          do i = 1, imax
+            this%istate(i) = mod(IMinstdA * this%istate(i), IMinstdM)
+            randnum(i,jblock) = IMinstdScale * this%istate(i)
+          end do
+        end if
+      end do
+
+    else
+
+      do jblock = 1,size(randnum,2)
+        if (mask(jblock)) then
+          call random_number(randnum(:,jblock))
+        end if
+      end do
+
+    end if
+
+  end subroutine uniform_distribution_2d_masked
+
+
+end module radiation_random_numbers
+
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_save.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_save.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_save.F90	(revision 4489)
@@ -33,5 +33,6 @@
   ! thermodynamics object
   subroutine save_fluxes(file_name, config, thermodynamics, flux, &
-       &                 iverbose, is_hdf5_file, experiment_name)
+       &                 iverbose, is_hdf5_file, experiment_name, &
+       &                 is_double_precision)
 
     use yomhook,                  only : lhook, dr_hook
@@ -50,4 +51,5 @@
     integer,          optional, intent(in) :: iverbose
     logical,          optional, intent(in) :: is_hdf5_file
+    logical,          optional, intent(in) :: is_double_precision
     character(len=*), optional, intent(in) :: experiment_name
 
@@ -96,4 +98,9 @@
     ! output file column varies most slowly so need to transpose
     call out_file%transpose_matrices(.true.)
+
+    ! Set default precision for file, if specified
+    if (present(is_double_precision)) then
+      call out_file%double_precision(is_double_precision)
+    end if
 
     ! Spectral fluxes in memory are dimensioned (nband,ncol,nlev), but
@@ -885,5 +892,5 @@
            &   dim2_name="column", dim1_name="level", &
            &   units_str="m", long_name="Ice effective radius")
-      if (allocated(cloud%re_ice)) then
+      if (associated(cloud%re_ice)) then
         call out_file%define_variable("re_ice", &
              &   dim2_name="column", dim1_name="level", &
@@ -966,5 +973,5 @@
       call out_file%put("q_ice", cloud%q_ice)
       call out_file%put("re_liquid", cloud%re_liq)
-      if (allocated(cloud%re_ice)) then
+      if (associated(cloud%re_ice)) then
         call out_file%put("re_ice", cloud%re_ice)
       end if
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_scheme.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_scheme.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_scheme.F90	(revision 4489)
@@ -13,16 +13,15 @@
 SUBROUTINE RADIATION_SCHEME &
 ! Inputs
-     & (KIDIA, KFDIA, KLON, KLEV, KAEROLMDZ, NSW, &
+     & (KIDIA, KFDIA, KLON, KLEV, KAEROSOL, NSW, &
      &  IDAY, TIME, &
      &  PSOLAR_IRRADIANCE, &
-     &  PMU0, PTEMPERATURE_SKIN, PALBEDO_DIF, PALBEDO_DIR, &
+     &  PMU0, PTEMPERATURE_SKIN, &
+     &  PALBEDO_DIF, PALBEDO_DIR, &
      &  PEMIS, PEMIS_WINDOW, &
-     &  PCCN_LAND, PCCN_SEA, &
-     &  PGELAM, PGEMU, PLAND_SEA_MASK, &
-     &  PPRESSURE, PTEMPERATURE, &
+     &  PGELAM, PGEMU, &
      &  PPRESSURE_H, PTEMPERATURE_H, PQ, PQSAT, &
      &  PCO2, PCH4, PN2O, PNO2, PCFC11, PCFC12, PHCFC22, &
      &  PCCL4, PO3, PO2, &
-     &  PCLOUD_FRAC, PQ_LIQUID, PQ_ICE, PQ_RAIN, PQ_SNOW, &
+     &  PCLOUD_FRAC, PQ_LIQUID, PQ_ICE, PQ_SNOW, &
      &  ZRE_LIQUID_UM, ZRE_ICE_UM, &
      &  PAEROSOL_OLD, PAEROSOL, &
@@ -117,9 +116,10 @@
 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) :: KAEROLMDZ ! Number of aerosol types
+INTEGER(KIND=JPIM),INTENT(IN) :: KAEROSOL
 INTEGER(KIND=JPIM),INTENT(IN) :: NSW ! Numbe of bands
 
 ! AI ATTENTION
-INTEGER, PARAMETER :: KAEROSOL = 12
+!INTEGER, PARAMETER :: KAEROSOL = 12
 
 ! *** Single-level fields
@@ -139,9 +139,9 @@
 REAL(KIND=JPRB),   INTENT(IN) :: PGEMU(KLON)
 ! Land-sea mask
-REAL(KIND=JPRB),   INTENT(IN) :: PLAND_SEA_MASK(KLON) 
+!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)
+!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)
@@ -167,5 +167,5 @@
 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_RAIN(KLON,KLEV)
 REAL(KIND=JPRB),   INTENT(IN) :: PQ_SNOW(KLON,KLEV)
 
@@ -174,6 +174,6 @@
 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) 
+!REAL(KIND=JPRB),   INTENT(IN) :: PCCN_LAND(KLON) 
+!REAL(KIND=JPRB),   INTENT(IN) :: PCCN_SEA(KLON) 
 
 !AI mars 2021
@@ -313,6 +313,6 @@
 if (lprint_input) then
   print*,'********** Verification des entrees *************'
-  print*,'KIDIA, KFDIA, KLON, KLEV, KAEROLMDZ, NSW =', &
-        KIDIA, KFDIA, KLON, KLEV, KAEROLMDZ, NSW
+  print*,'KIDIA, KFDIA, KLON, KLEV, KAEROSOL, NSW =', &
+        KIDIA, KFDIA, KLON, KLEV, KAEROSOL, NSW
   print*,'IDAY, TIME =', IDAY, TIME
   print*,'PSOLAR_IRRADIANCE =', PSOLAR_IRRADIANCE
@@ -320,8 +320,5 @@
   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
@@ -331,6 +328,6 @@
         PCO2, PCH4, PN2O, PNO2, PCFC11, PCFC12, PHCFC22, PCCL4
   print*,'PO3 =',PO3
-  print*,'PCLOUD_FRAC, PQ_LIQUID, PQ_ICE, PQ_RAIN, PQ_SNOW =', &
-        PCLOUD_FRAC, PQ_LIQUID, PQ_ICE, PQ_RAIN, PQ_SNOW
+  print*,'PCLOUD_FRAC, PQ_LIQUID, PQ_ICE, PQ_SNOW =', &
+        PCLOUD_FRAC, PQ_LIQUID, PQ_ICE, PQ_SNOW
   print*,'ZRE_LIQUID_UM, ZRE_ICE_UM =', &
         ZRE_LIQUID_UM, ZRE_ICE_UM
@@ -407,9 +404,10 @@
 ! Alternative approximate version using temperature and pressure from
 ! the thermodynamics structure
-CALL thermodynamics%calc_saturation_wrt_liquid(KIDIA, KFDIA)
+!CALL thermodynamics%calc_saturation_wrt_liquid(KIDIA, KFDIA)
+!AI ATTENTION
+thermodynamics%h2o_sat_liq = PQSAT
 
 print*,'********** SINGLE LEVEL VARS **********************************'
 !AI ATTENTION
-!thermodynamics%h2o_sat_liq = PQSAT
 ! Set single-level fileds
 single_level%solar_irradiance              = PSOLAR_IRRADIANCE
@@ -510,9 +508,9 @@
 
 print*,'******** AEROSOLS (allocate + input) **************************************'
-IF (NAERMACC > 0) THEN
+!IF (NAERMACC > 0) THEN
   CALL aerosol%allocate(KLON, 1, KLEV, KAEROSOL) ! MACC climatology
-ELSE
-  CALL aerosol%allocate(KLON, 1, KLEV, 6) ! Tegen climatology
-ENDIF
+!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
@@ -644,4 +642,6 @@
 
 ! Compute UV fluxes as weighted sum of appropriate shortwave bands
+!AI ATTENTION
+if (0.eq.1) then
 PFLUX_UV       (KIDIA:KFDIA) = 0.0_JPRB
 DO JBAND = 1,NWEIGHT_UV
@@ -660,5 +660,5 @@
        &  * flux%sw_dn_surf_clear_band(IBAND_PAR(JBAND),KIDIA:KFDIA)
 ENDDO
-
+endif
 ! Compute effective broadband emissivity
 ZBLACK_BODY_NET_LW = flux%lw_dn(KIDIA:KFDIA,KLEV+1) &
@@ -679,4 +679,5 @@
 !AI ATTENTION
 !IF (YRERAD%LAPPROXSWUPDATE) THEN
+if (0.eq.1) then
 IF (rad_config%do_surface_sw_spectral_flux) THEN
   PSWDIFFUSEBAND(KIDIA:KFDIA,:) = 0.0_JPRB
@@ -693,5 +694,5 @@
   ENDDO
 ENDIF
-
+endif
 CALL single_level%deallocate
 CALL thermodynamics%deallocate
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_setup.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_setup.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_setup.F90	(revision 4489)
@@ -69,5 +69,5 @@
 CONTAINS
 
-  ! This routine copies information between the IFS radiation
+  ! This routine copies information between the LMDZ radiation
   ! configuration (stored in global variables) and the radiation
   ! configuration of the modular radiation scheme (stored in
@@ -75,16 +75,20 @@
   ! to print lots of information during the setup stage (default is
   ! no).
+! AI At the end of the routine, the parameters are read in namelist
+!    
   SUBROUTINE SETUP_RADIATION_SCHEME(LOUTPUT)
 
     USE YOMHOOK,  ONLY : LHOOK, DR_HOOK
+! AI (propre a IFS)    
 !    USE YOMLUN,   ONLY : NULNAM, NULOUT, NULERR
     USE YOMLUN,   ONLY : NULOUT, NULERR
     USE YOESRTWN, ONLY : NMPSRTM
-! AI ATTENTION
+! AI ATTENTION (propre a IFS)
 !    USE YOERAD,   ONLY : YRERAD
 
     USE radiation_interface,      ONLY : setup_radiation
-    USE radiation_aerosol_optics, ONLY : dry_aerosol_sw_mass_extinction
-
+!    USE radiation_aerosol_optics, ONLY : dry_aerosol_sw_mass_extinction
+
+! AI (propre a IFS)    
 !#include "posname.intfb.h"
 
@@ -143,4 +147,5 @@
     ! Do we do Hogan and Bozzo (2014) approximate longwave updates?
 ! AI ATTENTION (ifs : )
+     ! AI (propre a IFS)
 !    rad_config%do_lw_derivatives = YRERAD%LAPPROXLWUPDATE
     rad_config%do_lw_derivatives = .false.
@@ -161,6 +166,5 @@
     ! *** SETUP GAS OPTICS ***
 
-    ! Assume IFS has already set-up RRTM, so the setup_radiation
-    ! routine below does not have to (ifs : F)
+! routine below does not have to (ifs : F)
     print*,'i_gas_model =',rad_config%i_gas_model
     rad_config%do_setup_ifsrrtm = .TRUE.
@@ -174,7 +178,4 @@
 ! 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
@@ -182,25 +183,12 @@
       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
-
+
+! AI (propre a IFS)      
     ! For consistency with earlier versions of the IFS radiation
     ! scheme, we perform shortwave delta-Eddington scaling *after* the
@@ -215,4 +203,5 @@
     endif
 
+! AI (propre a IFS)    
     ! Use Exponential-Exponential cloud overlap to match original IFS
     ! implementation of Raisanen cloud generator
@@ -230,64 +219,4 @@
     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 ***
 
@@ -300,8 +229,4 @@
     ! 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
@@ -309,36 +234,8 @@
       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
@@ -357,17 +254,4 @@
            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 ***
@@ -379,23 +263,8 @@
     ! 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
+
+! AI ATTENTION (parameters read in namelist file)
     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
@@ -409,10 +278,5 @@
     ! 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 /))
+! AI (6 albedo SW bands) 
     call rad_config%define_sw_albedo_intervals(6, &
        &  [0.25e-6_jprb, 0.44e-6_jprb, 0.69e-6_jprb, &
@@ -422,5 +286,5 @@
     ! 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
+! AI ATTENTION ?????
 !!    call rad_config%define_lw_emiss_intervals(3, &
 !!         &  (/ 8.0e-6_jprb,13.0e-6_jprb /),  (/ 1,2,1 /))
@@ -432,4 +296,20 @@
          &  NWEIGHT_PAR, IBAND_PAR, WEIGHT_PAR, &
          &  'photosynthetically active radiation, PAR')
+
+     rad_config%i_aerosol_type_map(1:13) = (/ &
+           &  -1, &  ! Sea salt, size bin 1 (OPAC)
+           &  -2, &  ! Sea salt, size bin 2 (OPAC)
+           &  -3, &  ! Sea salt, size bin 3 (OPAC)
+           &  -4, &  ! Hydrophilic organic matter (OPAC)
+           &  -5, &  ! Ammonium sulphate (OPAC)
+           &  -6, &
+           &  -7, &
+           &   1, &
+           &   2, &
+           &   3, &
+           &  -8, &
+           &  -9, &
+           &   4 /)  ! Stratospheric sulphate (hand edited from OPAC)
+   rad_config%aerosol_optics_override_file_name = 'aerosol_optics_lmdz.nc'
 
 !    IF (YRERAD%NAERMACC > 0) THEN
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_single_level.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_single_level.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_single_level.F90	(revision 4489)
@@ -95,4 +95,5 @@
   
   !---------------------------------------------------------------------
+  ! Allocate the arrays of a single-level type
   subroutine allocate_single_level(this, ncol, nalbedobands, nemisbands, &
        &                           use_sw_albedo_direct, is_simple_surface)
@@ -142,4 +143,5 @@
 
   !---------------------------------------------------------------------
+  ! Deallocate the arrays of a single-level type
   subroutine deallocate_single_level(this)
 
@@ -227,5 +229,5 @@
     ! 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)
+    real(jprb) :: lw_albedo_band(istartcol:iendcol, config%n_bands_lw)
 
     ! Number of albedo bands
@@ -233,5 +235,5 @@
 
     ! Loop indices for ecRad bands and albedo bands
-    integer :: jband, jalbedoband
+    integer :: jband, jalbedoband, jcol
 
     real(jprb) :: hook_handle
@@ -239,63 +241,79 @@
     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
+    if (config%do_sw) then
+      ! 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
+        if (size(this%sw_albedo,2) /= config%n_g_sw) then
+          write(nulerr,'(a,i0,a)') '*** Error: single_level%sw_albedo does not have the expected ', &
+               &  config%n_g_sw, ' spectral intervals'
+          call radiation_abort()
+        end if
+        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
+      else if (.not. config%do_nearest_spectral_sw_albedo) then
+        ! Albedos averaged accurately to ecRad spectral bands
+        nalbedoband = size(config%sw_albedo_weights,1)
+        if (size(this%sw_albedo,2) /= nalbedoband) then
+          write(nulerr,'(a,i0,a)') '*** Error: single_level%sw_albedo does not have the expected ', &
+               &  nalbedoband, ' bands'
+          call radiation_abort()
+        end if
+
         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)
+              do jcol = istartcol,iendcol
+                sw_albedo_band(jcol,jband) &
+                    &  = sw_albedo_band(jcol,jband) & 
+                    &  + config%sw_albedo_weights(jalbedoband,jband) &
+                    &    * this%sw_albedo(jcol, jalbedoband)
+              end do
             end if
           end do
         end do
-        sw_albedo_direct = transpose(sw_albedo_band(istartcol:iendcol, &
-             &                             config%i_band_from_reordered_g_sw))
+
+        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
-        sw_albedo_direct = sw_albedo_diffuse
+        ! 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
-    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
+    end if
+
+    if (config%do_lw .and. 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()   
+          write(nulerr,'(a,i0,a)') '*** Error: single_level%lw_emissivity does not have the expected ', &
+               &  config%n_g_lw, ' spectral intervals'
+          call radiation_abort()
         end if
         lw_albedo = 1.0_jprb - transpose(this%lw_emissivity(istartcol:iendcol,:))
@@ -303,12 +321,19 @@
         ! Albedos averaged accurately to ecRad spectral bands
         nalbedoband = size(config%lw_emiss_weights,1)
+        if (nalbedoband /= size(this%lw_emissivity,2)) then
+          write(nulerr,'(a,i0,a)') '*** Error: single_level%lw_emissivity does not have the expected ', &
+               &  nalbedoband, ' bands'
+          call radiation_abort()
+        end if
         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))
+              do jcol = istartcol,iendcol
+                lw_albedo_band(jcol,jband) &
+                    &  = lw_albedo_band(jcol,jband) & 
+                    &  + config%lw_emiss_weights(jalbedoband,jband) &
+                    &    * (1.0_jprb-this%lw_emissivity(jcol, jalbedoband))
+              end do
             end if
           end do
@@ -335,5 +360,5 @@
 
     use yomhook,          only : lhook, dr_hook
-    use radiation_config, only : out_of_bounds_1d, out_of_bounds_2d
+    use radiation_check,  only : out_of_bounds_1d, out_of_bounds_2d
 
     class(single_level_type), intent(inout) :: this
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_spartacus_lw.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_spartacus_lw.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_spartacus_lw.F90	(revision 4489)
@@ -66,5 +66,5 @@
     use radiation_matrix
     use radiation_two_stream,     only : calc_two_stream_gammas_lw, &
-         calc_reflectance_transmittance_lw, LwDiffusivity
+         calc_reflectance_transmittance_lw, LwDiffusivityWP
     use radiation_lw_derivatives, only : calc_lw_derivatives_matrix
     use radiation_constants,      only : Pi, GasConstantDryAir, &
@@ -615,10 +615,10 @@
             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_hl(1:ng3D,jlev,jcol)*LwDiffusivityWP
             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_hl(1:ng3D,jlev,jcol))*LwDiffusivityWP
             planck_diff(1:ng3D,jreg) = -planck_diff(1:ng3D,nreg+jreg)
           end do
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_spartacus_sw.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_spartacus_sw.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_spartacus_sw.F90	(revision 4489)
@@ -1303,5 +1303,5 @@
                   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))
+                       &  * 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
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_spectral_definition.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_spectral_definition.F90	(revision 4489)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_spectral_definition.F90	(revision 4489)
@@ -0,0 +1,902 @@
+! radiation_spectral_definition.F90 - Derived type to describe a spectral definition
+!
+! (C) Copyright 2020- 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
+! License: see the COPYING file for details
+!
+
+module radiation_spectral_definition
+
+  use parkind1,    only : jprb
+
+  implicit none
+
+  public
+
+  real(jprb), parameter :: SolarReferenceTemperature = 5777.0_jprb ! K
+  real(jprb), parameter :: TerrestrialReferenceTemperature = 273.15_jprb ! K
+
+  !---------------------------------------------------------------------
+  ! A derived type describing the contribution of the g points of a
+  ! correlated k-distribution gas-optics model from each part of the
+  ! spectrum. This is used primarily to map the cloud and aerosol
+  ! optical properties on to the gas g points.
+  type spectral_definition_type
+    
+    ! Spectral mapping of g points
+
+    ! Number of wavenumber intervals
+    integer :: nwav = 0
+    ! Number of k terms / g points
+    integer :: ng   = 0
+    ! Start and end wavenumber (cm-1), dimensioned (nwav)
+    real(jprb), allocatable :: wavenumber1(:)
+    real(jprb), allocatable :: wavenumber2(:)
+    ! Fraction of each g point in each wavenumber interval,
+    ! dimensioned (nwav, ng)
+    real(jprb), allocatable :: gpoint_fraction(:,:)
+
+    ! Band information
+
+    ! Number of bands
+    integer :: nband = 0
+    ! Lower and upper bounds of wavenumber bands (cm-1), dimensioned
+    ! (nband)
+    real(jprb), allocatable :: wavenumber1_band(:)
+    real(jprb), allocatable :: wavenumber2_band(:)
+    ! Band (one based) to which each g point belongs
+    integer,    allocatable :: i_band_number(:)
+
+  contains
+    procedure :: read => read_spectral_definition
+    procedure :: allocate_bands_only
+    procedure :: deallocate
+    procedure :: find => find_wavenumber
+    procedure :: calc_mapping
+    procedure :: calc_mapping_from_bands
+    procedure :: calc_mapping_from_wavenumber_bands
+    procedure :: print_mapping_from_bands
+    procedure :: min_wavenumber, max_wavenumber
+
+  end type spectral_definition_type
+
+contains
+
+  !---------------------------------------------------------------------
+  ! Read the description of a spectral definition from a NetCDF
+  ! file of the type used to describe an ecCKD model
+  subroutine read_spectral_definition(this, file)
+
+    use easy_netcdf, only : netcdf_file
+    use yomhook,     only : lhook, dr_hook
+
+    class(spectral_definition_type), intent(inout) :: this
+    type(netcdf_file),               intent(inout) :: file
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_spectral_definition:read',0,hook_handle)
+
+    ! Read spectral mapping of g points
+    call file%get('wavenumber1', this%wavenumber1)
+    call file%get('wavenumber2', this%wavenumber2)
+    call file%get('gpoint_fraction', this%gpoint_fraction)
+
+    ! Read band information
+    call file%get('wavenumber1_band', this%wavenumber1_band)
+    call file%get('wavenumber2_band', this%wavenumber2_band)
+    call file%get('band_number', this%i_band_number)
+
+    ! Band number is 0-based: add 1
+    this%i_band_number = this%i_band_number + 1
+
+    this%nwav  = size(this%wavenumber1)
+    this%ng    = size(this%gpoint_fraction, 2);
+    this%nband = size(this%wavenumber1_band)
+
+    if (lhook) call dr_hook('radiation_spectral_definition:read',1,hook_handle)
+
+  end subroutine read_spectral_definition
+
+
+  !---------------------------------------------------------------------
+  ! Store a simple band description by copying over the lower and
+  ! upper wavenumbers of each band
+  subroutine allocate_bands_only(this, wavenumber1, wavenumber2)
+
+    use yomhook,     only : lhook, dr_hook
+
+    class(spectral_definition_type), intent(inout) :: this
+    real(jprb),        dimension(:), intent(in)    :: wavenumber1, wavenumber2
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_spectral_definition:allocate_bands_only',0,hook_handle)
+
+    call this%deallocate()
+
+    this%nband = size(wavenumber1)
+    allocate(this%wavenumber1_band(this%nband))
+    allocate(this%wavenumber2_band(this%nband))
+    this%wavenumber1_band = wavenumber1
+    this%wavenumber2_band = wavenumber2
+
+    if (lhook) call dr_hook('radiation_spectral_definition:allocate_bands_only',1,hook_handle)
+
+  end subroutine allocate_bands_only
+
+
+  !---------------------------------------------------------------------
+  ! Deallocate memory inside a spectral definition object
+  subroutine deallocate(this)
+
+    class(spectral_definition_type), intent(inout) :: this
+    
+    this%nwav  = 0
+    this%ng    = 0
+    this%nband = 0
+
+    if (allocated(this%wavenumber1))      deallocate(this%wavenumber1)
+    if (allocated(this%wavenumber2))      deallocate(this%wavenumber2)
+    if (allocated(this%wavenumber1_band)) deallocate(this%wavenumber1_band)
+    if (allocated(this%wavenumber2_band)) deallocate(this%wavenumber2_band)
+    if (allocated(this%gpoint_fraction))  deallocate(this%gpoint_fraction)
+    if (allocated(this%i_band_number))    deallocate(this%i_band_number)
+
+  end subroutine deallocate
+
+
+  !---------------------------------------------------------------------
+  ! Find the index to the highest wavenumber in the spectral
+  ! definition that is lower than or equal to "wavenumber", used for
+  ! implementing look-up tables
+  pure function find_wavenumber(this, wavenumber)
+    class(spectral_definition_type), intent(in) :: this
+    real(jprb),                      intent(in) :: wavenumber ! cm-1
+    integer                                     :: find_wavenumber
+
+    if (wavenumber < this%wavenumber1(1) .or. wavenumber > this%wavenumber2(this%nwav)) then
+      ! Wavenumber not present
+      find_wavenumber = 0
+    else
+      find_wavenumber = 1
+      do while (wavenumber > this%wavenumber2(find_wavenumber) &
+           &    .and. find_wavenumber < this%nwav)
+        find_wavenumber = find_wavenumber + 1
+      end do
+    end if
+  end function find_wavenumber
+
+
+  !---------------------------------------------------------------------
+  ! Compute a mapping matrix "mapping" that can be used in an
+  ! expression y=matmul(mapping,x) where x is a variable containing
+  ! optical properties at each input "wavenumber", and y is this
+  ! variable mapped on to the spectral intervals in the spectral
+  ! definition "this". Temperature (K) is used to generate a Planck
+  ! function to weight each wavenumber appropriately.
+  subroutine calc_mapping(this, temperature, wavenumber, mapping, use_bands)
+
+    use yomhook,      only : lhook, dr_hook
+    use radiation_io, only : nulerr, radiation_abort
+
+    class(spectral_definition_type), intent(in)    :: this
+    real(jprb),                      intent(in)    :: temperature   ! K
+    real(jprb),                      intent(in)    :: wavenumber(:) ! cm-1
+    real(jprb), allocatable,         intent(inout) :: mapping(:,:)
+    logical,    optional,            intent(in)    :: use_bands
+
+    ! Spectral weights to apply, same length as wavenumber above
+    real(jprb), dimension(:), allocatable :: weight, planck_weight
+
+    ! Wavenumbers (cm-1) marking triangle of influence of a cloud
+    ! spectral point
+    real(jprb) :: wavenum0, wavenum1, wavenum2
+
+    integer    :: nwav ! Number of wavenumbers describing cloud
+
+    ! Indices to wavenumber intervals in spectral definition structure
+    integer    :: isd, isd0, isd1, isd2
+
+    ! Wavenumber index
+    integer    :: iwav
+    
+    ! Loop indices
+    integer    :: jg, jwav, jband
+
+    logical    :: use_bands_local
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_spectral_definition:calc_mapping',0,hook_handle)
+
+    if (present(use_bands)) then
+      use_bands_local = use_bands
+    else
+      use_bands_local = .false.
+    end if
+
+    nwav = size(wavenumber)
+
+    if (allocated(mapping)) then
+      deallocate(mapping)
+    end if
+    
+    ! Define the mapping matrix
+    if (use_bands_local) then
+      ! Cloud properties per band
+
+      allocate(mapping(this%nband, nwav))
+      allocate(weight(nwav))
+
+      ! Planck weight uses the wavenumbers of the cloud points
+      allocate(planck_weight(nwav))
+      planck_weight = calc_planck_function_wavenumber(wavenumber, &
+           &                                          temperature)
+
+      do jband = 1,this%nband
+        weight = 0.0_jprb
+        do jwav = 1,nwav
+          ! Work out wavenumber range for which this cloud wavenumber
+          ! will be applicable
+          if (wavenumber(jwav) >= this%wavenumber1_band(jband) &
+               & .and. wavenumber(jwav) <= this%wavenumber2_band(jband)) then
+            if (jwav > 1) then
+              wavenum1 = max(this%wavenumber1_band(jband), &
+                   &  0.5_jprb*(wavenumber(jwav-1)+wavenumber(jwav)))
+            else
+              wavenum1 = this%wavenumber1_band(jband)
+            end if
+            if (jwav < nwav) then
+              wavenum2 = min(this%wavenumber2_band(jband), &
+                   &  0.5_jprb*(wavenumber(jwav)+wavenumber(jwav+1)))
+            else
+              wavenum2 = this%wavenumber2_band(jband)
+            end if
+            ! This cloud wavenumber is weighted by the wavenumber
+            ! range of its applicability multiplied by the Planck
+            ! function at an appropriate temperature
+            weight(jwav) = (wavenum2-wavenum1) * planck_weight(jwav)
+          end if
+        end do
+        if (sum(weight) <= 0.0_jprb) then
+          ! No cloud wavenumbers lie in the band; interpolate to
+          ! central wavenumber of band instead
+          if (wavenumber(1) >= this%wavenumber2_band(jband)) then
+            ! Band is entirely below first cloudy wavenumber
+            weight(1) = 1.0_jprb
+          else if (wavenumber(nwav) <= this%wavenumber1_band(jband)) then
+            ! Band is entirely above last cloudy wavenumber
+            weight(nwav) = 1.0_jprb
+          else
+            ! Find interpolating points
+            iwav = 2
+            do while (wavenumber(iwav) < this%wavenumber2_band(jband))
+              iwav = iwav+1
+            end do
+            weight(iwav-1) = planck_weight(iwav-1) * (wavenumber(iwav) &
+                 &  - 0.5_jprb*(this%wavenumber2_band(jband)+this%wavenumber1_band(jband)))
+            weight(iwav) = planck_weight(iwav) * (-wavenumber(iwav-1) &
+                 &  + 0.5_jprb*(this%wavenumber2_band(jband)+this%wavenumber1_band(jband)))
+          end if
+        end if
+        mapping(jband,:) = weight / sum(weight)
+      end do
+
+      deallocate(weight)
+      deallocate(planck_weight)
+
+    else
+      ! Cloud properties per g-point
+
+      if (this%ng == 0) then
+        write(nulerr,'(a)') '*** Error: requested cloud/aerosol mapping per g-point but only available per band'
+        call radiation_abort('Radiation configuration error')
+      end if
+
+      allocate(mapping(this%ng, nwav))
+      allocate(weight(this%nwav))
+      allocate(planck_weight(this%nwav))
+
+      planck_weight = calc_planck_function_wavenumber(0.5_jprb &
+           &  * (this%wavenumber1 + this%wavenumber2), &
+           &  temperature)
+
+      mapping = 0.0_jprb
+      ! Loop over wavenumbers representing cloud
+      do jwav = 1,nwav
+        ! Clear the weights. The weight says for one wavenumber in the
+        ! cloud file, what is its fractional contribution to each of
+        ! the spectral-definition intervals
+        weight = 0.0_jprb
+
+        ! Cloud properties are linearly interpolated between each of
+        ! the nwav cloud points; therefore, the influence of a
+        ! particular cloud point extends as a triangle between
+        ! wavenum0 and wavenum2, peaking at wavenum1
+        wavenum1 = wavenumber(jwav)
+        isd1 = this%find(wavenum1)
+        if (isd1 < 1) then
+          cycle
+        end if
+        if (jwav > 1) then
+          wavenum0 = wavenumber(jwav-1)
+
+          ! Map triangle under (wavenum0,0) to (wavenum1,1) to the
+          ! wavenumbers in this%gpoint_fraction
+          isd0 = this%find(wavenum0)
+          if (isd0 == isd1) then
+            ! Triangle completely within the range
+            ! this%wavenumber1(isd0)-this%wavenumber2(isd0)
+            weight(isd0) = 0.5_jprb*(wavenum1-wavenum0) &
+                 &       / (this%wavenumber2(isd0)-this%wavenumber1(isd0))
+          else
+            if (isd0 >= 1) then
+              ! Left part of triangle
+              weight(isd0) = 0.5_jprb * (this%wavenumber2(isd0)-wavenum0)**2 &
+                   &       / ((this%wavenumber2(isd0)-this%wavenumber1(isd0)) &
+                   &         *(wavenum1-wavenum0))
+            end if
+            ! Right part of triangle (trapezium)
+!            weight(isd1) = 0.5_jprb * (wavenum1-this%wavenumber1(isd1)) &
+!                 &       * (wavenum1 + this%wavenumber1(isd1) - 2.0_jprb*wavenum0) &
+!                 &       / (wavenum1-wavenum0)
+            weight(isd1) = 0.5_jprb * (1.0_jprb &
+                 &  + (this%wavenumber1(isd1)-wavenum1)/(wavenum1-wavenum0)) &
+                 &  * (wavenum1-this%wavenumber1(isd1)) &
+                 &  / (this%wavenumber2(isd1)-this%wavenumber1(isd1))
+            if (isd1-isd0 > 1) then
+              do isd = isd0+1,isd1-1
+                ! Intermediate trapezia
+                weight(isd) = 0.5_jprb * (this%wavenumber1(isd)+this%wavenumber2(isd) &
+                     &                    - 2.0_jprb*wavenum0) &
+                     &      / (wavenum1-wavenum0)
+              end do
+            end if
+          end if
+
+        else
+          ! First cloud wavenumber: all wavenumbers in the spectral
+          ! definition below this will use the first one
+          if (isd1 >= 1) then
+            weight(1:isd1-1) = 1.0_jprb
+            weight(isd1) = (wavenum1-this%wavenumber1(isd1)) &
+                 &       / (this%wavenumber2(isd1)-this%wavenumber1(isd1))
+          end if
+        end if
+
+        if (jwav < nwav) then
+          wavenum2 = wavenumber(jwav+1)
+
+          ! Map triangle under (wavenum1,1) to (wavenum2,0) to the
+          ! wavenumbers in this%gpoint_fraction
+          isd2 = this%find(wavenum2)
+
+          if (isd1 == isd2) then
+            ! Triangle completely within the range
+            ! this%wavenumber1(isd1)-this%wavenumber2(isd1)
+            weight(isd1) = weight(isd1) + 0.5_jprb*(wavenum2-wavenum1) &
+                 &       / (this%wavenumber2(isd1)-this%wavenumber1(isd1))
+          else
+            if (isd2 >= 1 .and. isd2 <= this%nwav) then
+              ! Right part of triangle
+              weight(isd2) = weight(isd2) + 0.5_jprb * (wavenum2-this%wavenumber1(isd2))**2 &
+                   &       / ((this%wavenumber2(isd2)-this%wavenumber1(isd2)) &
+                   &         *(wavenum2-wavenum1))
+            end if
+            ! Left part of triangle (trapezium)
+!            weight(isd1) = weight(isd1) + 0.5_jprb * (this%wavenumber2(isd1)-wavenum1) &
+!                 &       * (wavenum1 + this%wavenumber2(isd1) - 2.0_jprb*wavenum2) &
+!                 &       / (wavenum2-wavenum1)
+            weight(isd1) = weight(isd1) + 0.5_jprb * (1.0_jprb &
+                 &  + (wavenum2-this%wavenumber2(isd1)) / (wavenum2-wavenum1)) &
+                 &  * (this%wavenumber2(isd1)-wavenum1) &
+                 &  / (this%wavenumber2(isd1)-this%wavenumber1(isd1))
+            if (isd2-isd1 > 1) then
+              do isd = isd1+1,isd2-1
+                ! Intermediate trapezia
+                weight(isd) = weight(isd) + 0.5_jprb * (2.0_jprb*wavenum2 &
+                     & - this%wavenumber1(isd) - this%wavenumber2(isd)) &
+                     &      / (wavenum2-wavenum1)
+              end do
+            end if
+          end if
+
+        else
+          ! Last cloud wavenumber: all wavenumbers in the spectral
+          ! definition above this will use the last one
+          if (isd1 <= this%nwav) then
+            weight(isd1+1:this%nwav) = 1.0_jprb
+            weight(isd1) = (this%wavenumber2(isd1)-wavenum1) &
+                 &       / (this%wavenumber2(isd1)-this%wavenumber1(isd1))
+          end if
+        end if
+
+        weight = weight * planck_weight
+
+        do jg = 1,this%ng
+          mapping(jg, jwav) = sum(weight * this%gpoint_fraction(:,jg))
+        end do
+
+      end do
+
+      deallocate(weight)
+      deallocate(planck_weight)
+
+      ! Normalize mapping matrix
+      do jg = 1,this%ng
+        mapping(jg,:) = mapping(jg,:) * (1.0_jprb/sum(mapping(jg,:)))
+      end do
+
+    end if
+
+    if (lhook) call dr_hook('radiation_spectral_definition:calc_mapping',1,hook_handle)
+
+  end subroutine calc_mapping
+
+
+  !---------------------------------------------------------------------
+  ! Under normal operation (if use_fluxes is .false. or not present),
+  ! compute a mapping matrix "mapping" that can be used in an
+  ! expression y=matmul(mapping^T,x) where x is a variable containing
+  ! optical properties in input bands (e.g. albedo in shortwave albedo
+  ! bands), and y is this variable mapped on to the spectral intervals
+  ! in the spectral definition "this". Temperature (K) is used to
+  ! generate a Planck function to weight each input band
+  ! appropriately. Note that "mapping" is here transposed from the
+  ! convention in the calc_mapping routine.  Under the alternative
+  ! operation (if use_fluxes is present and .true.), the mapping works
+  ! in the reverse sense: if y contains fluxes in each ecRad band or
+  ! g-point, then x=matmul(mapping,y) would return fluxes in x
+  ! averaged to user-supplied "input" bands. In this version, the
+  ! bands are described by their wavelength bounds (wavelength_bound,
+  ! which must be increasing and exclude the end points) and the index
+  ! of the mapping matrix that each band corresponds to (i_intervals,
+  ! which has one more element than wavelength_bound and can have
+  ! duplicated values if an albedo/emissivity value is to be
+  ! associated with more than one discontinuous ranges of the
+  ! spectrum).
+  subroutine calc_mapping_from_bands(this, temperature, &
+       &  wavelength_bound, i_intervals, mapping, use_bands, use_fluxes)
+
+    use yomhook,      only : lhook, dr_hook
+    use radiation_io, only : nulerr, radiation_abort
+
+    class(spectral_definition_type), intent(in)    :: this
+    real(jprb),                      intent(in)    :: temperature   ! K
+    ! Monotonically increasing wavelength bounds (m) between
+    ! intervals, not including the outer bounds (which are assumed to
+    ! be zero and infinity)
+    real(jprb), intent(in)    :: wavelength_bound(:)
+    ! The albedo band indices corresponding to each interval
+    integer,    intent(in)    :: i_intervals(:)
+    real(jprb), allocatable,         intent(inout) :: mapping(:,:)
+    logical,    optional,            intent(in)    :: use_bands
+    logical,    optional,            intent(in)    :: use_fluxes
+
+    ! Planck function and central wavenumber of each wavenumber
+    ! interval of the spectral definition
+    real(jprb) :: planck(this%nwav)         ! W m-2 (cm-1)-1
+    real(jprb) :: wavenumber_mid(this%nwav) ! cm-1
+
+    real(jprb), allocatable :: mapping_denom(:,:)
+
+    real(jprb) :: wavenumber1_bound, wavenumber2_bound
+
+    ! To work out weights we sample the Planck function at five points
+    ! in the interception between an input interval and a band, and
+    ! use the Trapezium Rule
+    integer, parameter :: nsample = 5
+    integer :: isamp
+    real(jprb), dimension(nsample) :: wavenumber_sample, planck_sample
+    real(jprb), parameter :: weight_sample(nsample) &
+         &        = [0.5_jprb, 1.0_jprb, 1.0_jprb, 1.0_jprb, 0.5_jprb]
+
+    ! Index of input value corresponding to each wavenumber interval
+    integer :: i_input(this%nwav)
+
+    ! Number of albedo/emissivity values that will be provided, some
+    ! of which may span discontinuous intervals in wavelength space
+    integer :: ninput
+
+    ! Number of albedo/emissivity intervals represented, where some
+    ! may be grouped to have the same value of albedo/emissivity (an
+    ! example is in the thermal infrared where classically the IFS has
+    ! ninput=2 and ninterval=3, since only two emissivities are
+    ! provided representing (1) the infrared window, and (2) the
+    ! intervals to each side of the infrared window.
+    integer :: ninterval
+
+    logical    :: use_bands_local, use_fluxes_local
+
+    ! Loop indices
+    integer    :: jg, jband, jin, jint
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_spectral_definition:calc_mapping_from_bands',0,hook_handle)
+
+    if (present(use_bands)) then
+      use_bands_local = use_bands
+    else
+      use_bands_local = .false.
+    end if
+
+    if (present(use_fluxes)) then
+      use_fluxes_local = use_fluxes
+    else
+      use_fluxes_local = .false.
+    end if
+
+    ! Count the number of input intervals 
+    ninterval = size(i_intervals)
+    ninput    = maxval(i_intervals)
+    
+    if (allocated(mapping)) then
+      deallocate(mapping)
+    end if
+    
+    ! Check wavelength is monotonically increasing
+    if (ninterval > 2) then
+      do jint = 2,ninterval-1
+        if (wavelength_bound(jint) <= wavelength_bound(jint-1)) then
+          write(nulerr, '(a)') '*** Error: wavelength bounds must be monotonically increasing'
+          call radiation_abort()
+        end if
+      end do
+    end if
+
+    ! Define the mapping matrix
+    if (use_bands_local) then
+      ! Require properties per band
+
+      allocate(mapping(ninput, this%nband))
+      mapping = 0.0_jprb
+
+      if (use_fluxes_local) then
+        allocate(mapping_denom(ninput, this%nband))
+        mapping_denom = 0.0_jprb
+      end if
+
+      do jband = 1,this%nband
+        do jint = 1,ninterval
+          if (jint == 1) then
+            ! First input interval in wavelength space: lower
+            ! wavelength bound is 0 m, so infinity cm-1
+            wavenumber2_bound = this%wavenumber2_band(jband)
+          else
+            wavenumber2_bound = min(this%wavenumber2_band(jband), &
+                 &                  0.01_jprb/wavelength_bound(jint-1))
+          end if
+
+          if (jint == ninterval) then
+            ! Final input interval in wavelength space: upper
+            ! wavelength bound is infinity m, so 0 cm-1
+            wavenumber1_bound = this%wavenumber1_band(jband)
+          else
+            wavenumber1_bound = max(this%wavenumber1_band(jband), &
+                 &                  0.01_jprb/wavelength_bound(jint))
+
+          end if
+
+          if (wavenumber2_bound > wavenumber1_bound) then
+            ! Current input interval contributes to current band;
+            ! compute the weight of the contribution in proportion to
+            ! an approximate calculation of the integral of the Planck
+            ! function over the relevant part of the spectrum
+            wavenumber_sample = wavenumber1_bound + [(isamp,isamp=0,nsample-1)] &
+                 &  * (wavenumber2_bound-wavenumber1_bound) / real(nsample-1,jprb)
+            planck_sample = calc_planck_function_wavenumber(wavenumber_sample, temperature)
+            mapping(i_intervals(jint),jband) = mapping(i_intervals(jint),jband) &
+                 &  + sum(planck_sample*weight_sample) * (wavenumber2_bound-wavenumber1_bound)
+            if (use_fluxes_local) then
+              ! Compute an equivalent sample containing the entire ecRad band
+              wavenumber_sample = this%wavenumber1_band(jband) + [(isamp,isamp=0,nsample-1)] &
+                   &  * (this%wavenumber2_band(jband)-this%wavenumber1_band(jband)) &
+                   &  / real(nsample-1,jprb)
+              planck_sample = calc_planck_function_wavenumber(wavenumber_sample, temperature)
+              mapping_denom(i_intervals(jint),jband) = mapping_denom(i_intervals(jint),jband) &
+                 &  + sum(planck_sample*weight_sample) * (this%wavenumber2_band(jband)-this%wavenumber1_band(jband))
+            end if
+          end if
+
+        end do
+      end do
+
+      if (use_fluxes_local) then
+        mapping = mapping / max(1.0e-12_jprb, mapping_denom)
+        deallocate(mapping_denom)
+      end if
+
+    else
+      ! Require properties per g-point
+
+      if (this%ng == 0) then
+        write(nulerr,'(a)') '*** Error: requested surface mapping per g-point but only available per band'
+        call radiation_abort('Radiation configuration error')
+      end if
+
+      allocate(mapping(ninput,this%ng))
+      mapping = 0.0_jprb
+
+      wavenumber_mid = 0.5_jprb * (this%wavenumber1 + this%wavenumber2)
+      planck = calc_planck_function_wavenumber(wavenumber_mid, temperature)
+
+      ! In the processing that follows, we assume that the wavenumber
+      ! grid on which the g-points are defined in the spectral
+      ! definition is much finer than the albedo/emissivity intervals
+      ! that the user will provide.  This means that each wavenumber
+      ! is assigned to only one of the albedo/emissivity intervals.
+
+      ! By default set all wavenumbers to use first input
+      ! albedo/emissivity
+      i_input = 1
+      
+      ! All bounded intervals
+      do jint = 2,ninterval-1
+        wavenumber1_bound = 0.01_jprb / wavelength_bound(jint)
+        wavenumber2_bound = 0.01_jprb / wavelength_bound(jint-1)
+        where (wavenumber_mid > wavenumber1_bound &
+             & .and. wavenumber_mid <= wavenumber2_bound)
+          i_input = i_intervals(jint)
+        end where
+      end do
+
+      ! Final interval in wavelength space goes up to wavenumber of
+      ! infinity
+      if (ninterval > 1) then
+        wavenumber2_bound = 0.01_jprb / wavelength_bound(ninterval-1)
+        where (wavenumber_mid <= wavenumber2_bound)
+          i_input = i_intervals(ninterval)
+        end where
+      end if
+
+      do jg = 1,this%ng
+        do jin = 1,ninput
+          mapping(jin,jg) = sum(this%gpoint_fraction(:,jg) * planck, &
+               &                 mask=(i_input==jin))
+          if (use_fluxes_local) then
+            mapping(jin,jg) = mapping(jin,jg) / sum(this%gpoint_fraction(:,jg) * planck)
+          end if
+        end do
+      end do
+
+    end if
+
+    if (.not. use_fluxes_local) then
+      ! Normalize mapping matrix
+      do jg = 1,size(mapping,dim=2)
+        mapping(:,jg) = mapping(:,jg) * (1.0_jprb/sum(mapping(:,jg)))
+      end do
+    end if
+
+    if (lhook) call dr_hook('radiation_spectral_definition:calc_mapping_from_bands',1,hook_handle)
+
+  end subroutine calc_mapping_from_bands
+
+
+  !---------------------------------------------------------------------
+  ! As calc_mapping_from_bands but in terms of wavenumber bounds from
+  ! wavenumber1 to wavenumber2
+  subroutine calc_mapping_from_wavenumber_bands(this, temperature, &
+       &  wavenumber1, wavenumber2, mapping, use_bands, use_fluxes)
+
+    use yomhook,      only : lhook, dr_hook
+    use radiation_io, only : nulerr, radiation_abort
+
+    class(spectral_definition_type), intent(in)    :: this
+    real(jprb),                      intent(in)    :: temperature   ! K
+    real(jprb), intent(in)    :: wavenumber1(:), wavenumber2(:)
+    real(jprb), allocatable,         intent(inout) :: mapping(:,:)
+    logical,    optional,            intent(in)    :: use_bands
+    logical,    optional,            intent(in)    :: use_fluxes
+
+    ! Monotonically increasing wavelength bounds (m) between
+    ! intervals, not including the outer bounds (which are assumed to
+    ! be zero and infinity)
+    real(jprb) :: wavelength_bound(size(wavenumber1)-1)
+    ! The albedo band indices corresponding to each interval
+    integer    :: i_intervals(size(wavenumber1))
+
+    ! Lower wavelength bound (m) of each band
+    real(jprb) :: wavelength1(size(wavenumber1))
+
+    logical    :: is_band_unassigned(size(wavenumber1))
+
+    ! Number of albedo/emissivity intervals represented, where some
+    ! may be grouped to have the same value of albedo/emissivity (an
+    ! example is in the thermal infrared where classically the IFS has
+    ! ninput=2 and ninterval=3, since only two emissivities are
+    ! provided representing (1) the infrared window, and (2) the
+    ! intervals to each side of the infrared window.
+    integer :: ninterval
+
+    ! Index to next band in order of increasing wavelength
+    integer :: inext
+
+    ! Loop indices
+    integer :: jint
+
+    real(jprb) :: hook_handle
+
+    if (lhook) call dr_hook('radiation_spectral_definition:calc_mapping_from_wavenumber_bands',0,hook_handle)
+
+    wavelength1 = 0.01_jprb / wavenumber2
+    ninterval = size(wavelength1)
+    
+    is_band_unassigned = .true.
+
+    do jint = 1,ninterval
+      inext = minloc(wavelength1, dim=1, mask=is_band_unassigned)
+      if (jint > 1) then
+        wavelength_bound(jint-1) = wavelength1(inext)
+      end if
+      is_band_unassigned(inext) = .false.
+      i_intervals(jint) = inext
+    end do
+
+    call calc_mapping_from_bands(this, temperature, &
+         &  wavelength_bound, i_intervals, mapping, use_bands, use_fluxes)
+
+    if (lhook) call dr_hook('radiation_spectral_definition:calc_mapping_from_wavenumber_bands',1,hook_handle)
+
+  end subroutine calc_mapping_from_wavenumber_bands
+
+
+  !---------------------------------------------------------------------
+  ! Print out the mapping computed by calc_mapping_from_bands
+  subroutine print_mapping_from_bands(this, mapping, use_bands)
+
+    use radiation_io, only : nulout
+
+    class(spectral_definition_type), intent(in) :: this
+    real(jprb), allocatable,         intent(in) :: mapping(:,:) ! (ninput,nband/ng)
+    logical,    optional,            intent(in) :: use_bands
+
+    logical :: use_bands_local
+
+    integer :: nin, nout
+    integer :: jin, jout
+
+    if (present(use_bands)) then
+      use_bands_local = use_bands
+    else
+      use_bands_local = .false.
+    end if
+
+    nin = size(mapping,1)
+    nout = size(mapping,2)
+
+    if (nin <= 1) then
+      write(nulout, '(a)') '  All spectral intervals will use the same albedo/emissivity'
+    else if (use_bands_local) then
+      write(nulout, '(a,i0,a,i0,a)') '  Mapping from ', nin, ' values to ', nout, ' bands (wavenumber ranges in cm-1)'
+      if (nout <= 40) then
+        do jout = 1,nout
+          write(nulout,'(i6,a,i6,a)',advance='no') nint(this%wavenumber1_band(jout)), ' to', &
+               &                        nint(this%wavenumber2_band(jout)), ':'
+          do jin = 1,nin
+            write(nulout,'(f5.2)',advance='no') mapping(jin,jout)
+          end do
+          write(nulout, '()')
+        end do
+      else
+        do jout = 1,30
+          write(nulout,'(i6,a,i6,a)',advance='no') nint(this%wavenumber1_band(jout)), ' to', &
+               &                        nint(this%wavenumber2_band(jout)), ':'
+          do jin = 1,nin
+            write(nulout,'(f5.2)',advance='no') mapping(jin,jout)
+          end do
+          write(nulout, '()')
+        end do
+        write(nulout,'(a)') '  ...'
+        write(nulout,'(i6,a,i6,a)',advance='no') nint(this%wavenumber1_band(nout)), ' to', &
+             &                        nint(this%wavenumber2_band(nout)), ':'
+        do jin = 1,nin
+          write(nulout,'(f5.2)',advance='no') mapping(jin,nout)
+        end do
+        write(nulout, '()')
+      end if
+    else
+      write(nulout, '(a,i0,a,i0,a)') '  Mapping from ', nin, ' values to ', nout, ' g-points'
+      if (nout <= 40) then
+        do jout = 1,nout
+          write(nulout,'(i3,a)',advance='no') jout, ':'
+          do jin = 1,nin
+            write(nulout,'(f5.2)',advance='no') mapping(jin,jout)
+          end do
+          write(nulout, '()')
+        end do
+      else
+        do jout = 1,30
+          write(nulout,'(i3,a)',advance='no') jout, ':'
+          do jin = 1,nin
+            write(nulout,'(f5.2)',advance='no') mapping(jin,jout)
+          end do
+          write(nulout, '()')
+        end do
+        write(nulout,'(a)') '  ...'
+        write(nulout,'(i3,a)',advance='no') nout, ':'
+        do jin = 1,nin
+          write(nulout,'(f5.2)',advance='no') mapping(jin,nout)
+        end do
+        write(nulout, '()')
+      end if
+    end if
+
+  end subroutine print_mapping_from_bands
+
+
+  !---------------------------------------------------------------------
+  ! Return the minimum wavenumber of this object in cm-1
+  pure function min_wavenumber(this)
+
+    class(spectral_definition_type), intent(in)    :: this
+    real(jprb) :: min_wavenumber
+
+    if (this%nwav > 0) then
+      min_wavenumber = this%wavenumber1(1)
+    else
+      min_wavenumber = minval(this%wavenumber1_band)
+    end if
+
+  end function min_wavenumber
+
+
+  !---------------------------------------------------------------------
+  ! Return the maximum wavenumber of this object in cm-1
+  pure function max_wavenumber(this)
+
+    class(spectral_definition_type), intent(in)    :: this
+    real(jprb) :: max_wavenumber
+
+    if (this%nwav > 0) then
+      max_wavenumber = this%wavenumber1(this%nwav)
+    else
+      max_wavenumber = maxval(this%wavenumber2_band)
+    end if
+
+  end function max_wavenumber
+
+
+  !---------------------------------------------------------------------
+  ! Return the Planck function (in W m-2 (cm-1)-1) for a given
+  ! wavenumber (cm-1) and temperature (K), ensuring double precision
+  ! for internal calculation.  If temperature is 0 or less then unity
+  ! is returned; since this function is primarily used to weight an
+  ! integral by the Planck function, a temperature of 0 or less means
+  ! no weighting is to be applied.
+  elemental function calc_planck_function_wavenumber(wavenumber, temperature)
+
+    use parkind1,            only : jprb, jprd
+    use radiation_constants, only : SpeedOfLight, BoltzmannConstant, PlanckConstant
+
+    real(jprb), intent(in) :: wavenumber  ! cm-1
+    real(jprb), intent(in) :: temperature ! K
+    real(jprb) :: calc_planck_function_wavenumber
+
+    real(jprd) :: freq ! Hz
+    real(jprd) :: planck_fn_freq ! W m-2 Hz-1
+
+    if (temperature > 0.0_jprd) then
+      freq = 100.0_jprd * real(SpeedOfLight,jprd) * real(wavenumber,jprd)
+      planck_fn_freq = 2.0_jprd * real(PlanckConstant,jprd) * freq**3 &
+           &  / (real(SpeedOfLight,jprd)**2 * (exp(real(PlanckConstant,jprd)*freq &
+           &     /(real(BoltzmannConstant,jprd)*real(temperature,jprd))) - 1.0_jprd))
+      calc_planck_function_wavenumber = real(planck_fn_freq * 100.0_jprd * real(SpeedOfLight,jprd), jprb)
+    else
+      calc_planck_function_wavenumber = 1.0_jprb
+    end if
+
+  end function calc_planck_function_wavenumber
+
+end module radiation_spectral_definition
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_thermodynamics.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_thermodynamics.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_thermodynamics.F90	(revision 4489)
@@ -297,5 +297,5 @@
 
     use yomhook,          only : lhook, dr_hook
-    use radiation_config, only : out_of_bounds_2d
+    use radiation_check,  only : out_of_bounds_2d
 
     class(thermodynamics_type), intent(inout) :: this
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_tripleclouds_lw.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_tripleclouds_lw.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_tripleclouds_lw.F90	(revision 4489)
@@ -18,4 +18,6 @@
 !   2017-10-23  R. Hogan  Renamed single-character variables
 !   2018-10-08  R. Hogan  Call calc_region_properties
+!   2020-09-18  R. Hogan  Replaced some array expressions with loops
+!   2020-09-19  R. Hogan  Implement the cloud-only-scattering optimization
 
 module radiation_tripleclouds_lw
@@ -28,4 +30,5 @@
 #include "radiation_optical_depth_scaling.h"
 
+  !---------------------------------------------------------------------
   ! This module contains just one subroutine, the longwave
   ! "Tripleclouds" solver in which cloud inhomogeneity is treated by
@@ -33,5 +36,4 @@
   ! cloudy (with differing optical depth). This approach was described
   ! by Shonk and Hogan (2008).
-
   subroutine solver_tripleclouds_lw(nlev,istartcol,iendcol, &
        &  config, cloud, & 
@@ -48,10 +50,10 @@
     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_flux, only           : flux_type, 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_adding_ica_lw, only  : adding_ica_lw, calc_fluxes_no_scattering_lw
     use radiation_lw_derivatives, only : calc_lw_derivatives_region
 
@@ -130,9 +132,13 @@
     ! streams
     real(jprb), dimension(config%n_g_lw, nregions, nlev) &
-         &  :: Sup, Sdn
+         &  :: source_up, source_dn
+
+    ! Clear-sky reflectance and transmittance
+    real(jprb), dimension(config%n_g_lw, nlev) &
+         &  :: ref_clear, trans_clear
 
     ! ...clear-sky equivalent
     real(jprb), dimension(config%n_g_lw, nlev) &
-         &  :: Sup_clear, Sdn_clear
+         &  :: source_up_clear, source_dn_clear
 
     ! Total albedo of the atmosphere/surface just above a layer
@@ -147,7 +153,4 @@
     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) &
@@ -160,5 +163,5 @@
 
     ! ...clear-sky equivalent (no distinction between "above/below")
-    real(jprb), dimension(config%n_g_lw) &
+    real(jprb), dimension(config%n_g_lw, nlev+1) &
          &  :: flux_dn_clear, flux_up_clear
 
@@ -170,4 +173,7 @@
     ! and below the ground, both treated as single-region clear skies
     logical :: is_clear_sky_layer(0:nlev+1)
+
+    ! Index of the highest cloudy layer
+    integer :: i_cloud_top
 
     integer :: jcol, jlev, jg, jreg, jreg2, ng
@@ -208,16 +214,96 @@
       ! cloud%crop_cloud_fraction has already been called
       is_clear_sky_layer = .true.
+      i_cloud_top = nlev+1
       do jlev = 1,nlev
         if (cloud%fraction(jcol,jlev) > 0.0_jprb) 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
         end if
       end do
-
-      ! --------------------------------------------------------
-      ! Section 3: Loop over layers to compute reflectance and transmittance
+      if (config%do_lw_aerosol_scattering) then
+        ! This is actually the first layer in which we need to
+        ! consider scattering
+        i_cloud_top = 1
+      end if
+
+      ! --------------------------------------------------------
+      ! Section 3: Clear-sky calculation
+      ! --------------------------------------------------------
+
+      if (.not. config%do_lw_aerosol_scattering) then
+        ! No scattering in clear-sky flux calculation
+        do jlev = 1,nlev
+          ! Array-wise assignments
+          gamma1 = 0.0_jprb
+          gamma2 = 0.0_jprb
+          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))
+          ref_clear(:,jlev) = 0.0_jprb
+        end do
+        ! Simple 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)
+      else
+        ! Scattering in clear-sky flux calculation
+        do jlev = 1,nlev
+          ! Array-wise assignments
+          gamma1 = 0.0_jprb
+          gamma2 = 0.0_jprb
+          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), &
+               &  ref_clear(:,jlev), trans_clear(:,jlev), &
+               &  source_up_clear(:,jlev), source_dn_clear(:,jlev))
+        end do
+        ! 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)
+      end if
+
+      if (config%do_clear) then
+        ! 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)
+        ! Save the spectral fluxes if required
+        if (config%do_save_spectral_flux) then
+          do jlev = 1,nlev+1
+            call indexed_sum(flux_up_clear(:,jlev), &
+                 &           config%i_spec_from_reordered_g_lw, &
+                 &           flux%lw_up_clear_band(:,jcol,jlev))
+            call indexed_sum(flux_dn_clear(:,jlev), &
+                 &           config%i_spec_from_reordered_g_lw, &
+                 &           flux%lw_dn_clear_band(:,jcol,jlev))
+          end do
+        end if
+      end if
+
+      ! --------------------------------------------------------
+      ! Section 4: Loop over cloudy 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
+      
+      ! Firstly, ensure clear-sky transmittance is valid for whole
+      ! depth of the atmosphere, because even above cloud it is used
+      ! by the LW derivatives
+      transmittance(:,1,:) = trans_clear(:,:)
+      ! Dummy values in cloudy regions above cloud top
+      if (i_cloud_top > 0) then
+        transmittance(:,2:,1:min(i_cloud_top,nlev)) = 1.0_jprb
+      end if
+
+      do jlev = i_cloud_top,nlev ! Start at cloud top and work down
 
         ! Array-wise assignments
@@ -225,30 +311,17 @@
         gamma2 = 0.0_jprb
 
+        ! Copy over clear-sky properties
+        reflectance(:,1,jlev)    = ref_clear(:,jlev)
+        source_up(:,1,jlev)      = source_up_clear(:,jlev) ! Scaled later by region size
+        source_dn(:,1,jlev)      = source_dn_clear(:,jlev) ! Scaled later by region size
         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
+          transmittance(:,2:,jlev) = 1.0_jprb
+          source_up(:,2:,jlev)     = 0.0_jprb
+          source_dn(:,2:,jlev)     = 0.0_jprb
+        else
+          do jreg = 2,nreg
             ! Cloudy sky
             ! Add scaled cloud optical depth to clear-sky value
@@ -291,5 +364,5 @@
                    &  planck_hl(:,jlev,jcol), planck_hl(:,jlev+1,jcol), &
                    &  reflectance(:,jreg,jlev), transmittance(:,jreg,jlev), &
-                   &  Sup(:,jreg,jlev), Sdn(:,jreg,jlev))
+                   &  source_up(:,jreg,jlev), source_dn(:,jreg,jlev))
             else
               ! No-scattering case: use simpler functions for
@@ -297,18 +370,12 @@
               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))
+                   &  transmittance(:,jreg,jlev), source_up(:,jreg,jlev), source_dn(:,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
+          end do
           ! 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)
+            source_up(:,jreg,jlev) = region_fracs(jreg,jlev,jcol) * source_up(:,jreg,jlev)
+            source_dn(:,jreg,jlev) = region_fracs(jreg,jlev,jcol) * source_dn(:,jreg,jlev)
           end do
         end if
@@ -317,5 +384,5 @@
 
       ! --------------------------------------------------------
-      ! Section 4: Compute total sources albedos
+      ! Section 5: Compute total sources and albedos at each half level
       ! --------------------------------------------------------
 
@@ -333,48 +400,26 @@
         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
+      do jlev = nlev,i_cloud_top,-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)
+          do jg = 1,ng
+            inv_denom(jg,1) = 1.0_jprb &
+                 &  / (1.0_jprb - total_albedo(jg,1,jlev+1)*reflectance(jg,1,jlev))
+            total_albedo_below(jg,1) = reflectance(jg,1,jlev) &
+                 &  + transmittance(jg,1,jlev)*transmittance(jg,1,jlev)*total_albedo(jg,1,jlev+1) &
+                 &  * inv_denom(jg,1)
+            total_source_below(jg,1) = source_up(jg,1,jlev) &
+                 &  + transmittance(jg,1,jlev)*(total_source(jg,1,jlev+1) &
+                 &  + total_albedo(jg,1,jlev+1)*source_dn(jg,1,jlev)) &
+                 &  * inv_denom(jg,1)
+          end do
         else
           inv_denom = 1.0_jprb / (1.0_jprb - total_albedo(:,:,jlev+1)*reflectance(:,:,jlev))
@@ -382,7 +427,7 @@
                &  + transmittance(:,:,jlev)*transmittance(:,:,jlev)*total_albedo(:,:,jlev+1) &
                &  * inv_denom
-          total_source_below = Sup(:,:,jlev) &
+          total_source_below = source_up(:,:,jlev) &
                &  + transmittance(:,:,jlev)*(total_source(:,:,jlev+1) &
-               &  + total_albedo(:,:,jlev+1)*Sdn(:,:,jlev)) &
+               &  + total_albedo(:,:,jlev+1)*source_dn(:,:,jlev)) &
                &  * inv_denom
         end if
@@ -415,57 +460,73 @@
 
       ! --------------------------------------------------------
-      ! 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
+      ! Section 6: Copy over downwelling fluxes above cloud top
+      ! --------------------------------------------------------
+      do jlev = 1,i_cloud_top
+        if (config%do_clear) then
+          ! Clear-sky fluxes have already been averaged: use these
+          flux%lw_dn(jcol,jlev) = flux%lw_dn_clear(jcol,jlev)
+          if (config%do_save_spectral_flux) then
+            flux%lw_dn_band(:,jcol,jlev) = flux%lw_dn_clear_band(:,jcol,jlev)
+          end if
+        else
+          flux%lw_dn(jcol,:) = sum(flux_dn_clear(:,jlev))
+          if (config%do_save_spectral_flux) then
+            call indexed_sum(flux_dn_clear(:,jlev), &
+                 &           config%i_spec_from_reordered_g_lw, &
+                 &           flux%lw_dn_band(:,jcol,jlev))
+          end if
+        end if
+      end do
+
+      ! --------------------------------------------------------
+      ! Section 7: Compute fluxes up to top-of-atmosphere
+      ! --------------------------------------------------------
+
+      ! Compute the fluxes just above the highest cloud
+      flux_up(:,1) = total_source(:,1,i_cloud_top) &
+           &  + total_albedo(:,1,i_cloud_top)*flux_dn_clear(:,i_cloud_top)
+      flux_up(:,2:) = 0.0_jprb
+      flux%lw_up(jcol,i_cloud_top) = sum(flux_up(:,1))
+      if (config%do_save_spectral_flux) then
+        call indexed_sum(flux_up(:,1), &
+             &           config%i_spec_from_reordered_g_lw, &
+             &           flux%lw_up_band(:,jcol,i_cloud_top))
       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), &
+      do jlev = i_cloud_top-1,1,-1
+        flux_up(:,1) = trans_clear(:,jlev)*flux_up(:,1) + source_up_clear(:,jlev)
+        flux%lw_up(jcol,jlev) = sum(flux_up(:,1))
+        if (config%do_save_spectral_flux) then
+          call indexed_sum(flux_up(:,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
+               &           flux%lw_up_band(:,jcol,jlev))
+        end if
+      end do
+
+      ! --------------------------------------------------------
+      ! Section 8: Compute fluxes down to surface
+      ! --------------------------------------------------------
+
+      ! Copy over downwelling spectral fluxes at top of first
+      ! scattering layer, using overlap matrix to translate to the
+      ! regions of the first layer of cloud
+      do jreg = 1,nregions
+        flux_dn(:,jreg)  = v_matrix(jreg,1,i_cloud_top,jcol)*flux_dn_clear(:,i_cloud_top)
+      end do
 
       ! 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
+      do jlev = i_cloud_top,nlev
 
         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))
+          do jg = 1,ng
+            flux_dn(jg,1) = (transmittance(jg,1,jlev)*flux_dn(jg,1) &
+                 &  + reflectance(jg,1,jlev)*total_source(jg,1,jlev+1) + source_dn(jg,1,jlev) ) &
+                 &  / (1.0_jprb - reflectance(jg,1,jlev)*total_albedo(jg,1,jlev+1))
+            flux_up(jg,1) = total_source(jg,1,jlev+1) + flux_dn(jg,1)*total_albedo(jg,1,jlev+1)
+          end do
           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) ) &
+               &     + reflectance(:,:,jlev)*total_source(:,:,jlev+1) + source_dn(:,:,jlev) ) &
                &  / (1.0_jprb - reflectance(:,:,jlev)*total_albedo(:,:,jlev+1))
           flux_up = total_source(:,:,jlev+1) + flux_dn*total_albedo(:,:,jlev+1)
@@ -485,8 +546,4 @@
         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
@@ -498,13 +555,5 @@
                &           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 if
 
       end do ! Final loop over levels
@@ -513,7 +562,4 @@
       ! 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
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_tripleclouds_sw.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_tripleclouds_sw.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_tripleclouds_sw.F90	(revision 4489)
@@ -19,4 +19,5 @@
 !   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
+!   2020-09-18  R. Hogan  Replaced some array expressions with loops for speed
 
 module radiation_tripleclouds_sw
@@ -32,4 +33,5 @@
 #include "radiation_optical_depth_scaling.h"
 
+  !---------------------------------------------------------------------
   ! This module contains just one subroutine, the shortwave
   ! "Tripleclouds" solver in which cloud inhomogeneity is treated by
@@ -37,5 +39,4 @@
   ! 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, & 
@@ -356,25 +357,29 @@
           ! "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)
+          do jg = 1,ng
+            inv_denom(jg,1) = 1.0_jprb &
+                 &  / (1.0_jprb - total_albedo_clear(jg,jlev+1)*reflectance(jg,1,jlev))
+            total_albedo_clear(jg,jlev) = reflectance(jg,1,jlev) &
+                 &  + transmittance(jg,1,jlev) * transmittance(jg,1,jlev) &
+                 &  * total_albedo_clear(jg,jlev+1) * inv_denom(jg,1)
+            total_albedo_clear_direct(jg,jlev) = ref_dir(jg,1,jlev) &
+                 &  + (trans_dir_dir(jg,1,jlev)*total_albedo_clear_direct(jg,jlev+1) &
+                 &     +trans_dir_diff(jg,1,jlev)*total_albedo_clear(jg,jlev+1)) &
+                 &  * transmittance(jg,1,jlev) * inv_denom(jg,1)
+          end do
         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)
+          do jg = 1,ng
+            inv_denom(jg,1) = 1.0_jprb &
+                 &  / (1.0_jprb - total_albedo(jg,1,jlev+1)*reflectance(jg,1,jlev))
+            total_albedo_below(jg,1) = reflectance(jg,1,jlev) &
+                 &  + transmittance(jg,1,jlev)  * transmittance(jg,1,jlev) &
+                 &  * total_albedo(jg,1,jlev+1) * inv_denom(jg,1)
+            total_albedo_below_direct(jg,1) = ref_dir(jg,1,jlev) &
+                 &  + (trans_dir_dir(jg,1,jlev)*total_albedo_direct(jg,1,jlev+1) &
+                 &     +trans_dir_diff(jg,1,jlev)*total_albedo(jg,1,jlev+1)) &
+                 &  * transmittance(jg,1,jlev) * inv_denom(jg,1)
+          end do
         else
           inv_denom = 1.0_jprb / (1.0_jprb - total_albedo(:,:,jlev+1)*reflectance(:,:,jlev))
@@ -488,21 +493,26 @@
       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)
+          do jg = 1,ng
+            flux_dn_clear(jg) = (transmittance(jg,1,jlev)*flux_dn_clear(jg) + direct_dn_clear(jg) &
+               &  * (trans_dir_dir(jg,1,jlev)*total_albedo_clear_direct(jg,jlev+1)*reflectance(jg,1,jlev) &
+               &     + trans_dir_diff(jg,1,jlev) )) &
+               &  / (1.0_jprb - reflectance(jg,1,jlev)*total_albedo_clear(jg,jlev+1))
+            direct_dn_clear(jg) = trans_dir_dir(jg,1,jlev)*direct_dn_clear(jg)
+            flux_up_clear(jg) = direct_dn_clear(jg)*total_albedo_clear_direct(jg,jlev+1) &
+               &        +   flux_dn_clear(jg)*total_albedo_clear(jg,jlev+1)
+          end do
         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)
+          do jg = 1,ng
+            flux_dn(jg,1) = (transmittance(jg,1,jlev)*flux_dn(jg,1) + direct_dn(jg,1) &
+                 &  * (trans_dir_dir(jg,1,jlev)*total_albedo_direct(jg,1,jlev+1)*reflectance(jg,1,jlev) &
+                 &     + trans_dir_diff(jg,1,jlev) )) &
+                 &  / (1.0_jprb - reflectance(jg,1,jlev)*total_albedo(jg,1,jlev+1))
+            direct_dn(jg,1) = trans_dir_dir(jg,1,jlev)*direct_dn(jg,1)
+            flux_up(jg,1) = direct_dn(jg,1)*total_albedo_direct(jg,1,jlev+1) &
+                 &  +        flux_dn(jg,1)*total_albedo(jg,1,jlev+1)
+          end do
+
           flux_dn(:,2:)  = 0.0_jprb
           flux_up(:,2:)  = 0.0_jprb
Index: LMDZ6/trunk/libf/phylmd/ecrad/radiation_two_stream.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/radiation_two_stream.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/radiation_two_stream.F90	(revision 4489)
@@ -18,4 +18,5 @@
 !   2017-07-26  R Hogan  Added calc_frac_scattered_diffuse_sw routine
 !   2017-10-23  R Hogan  Renamed single-character variables
+!   2021-02-19  R Hogan  Security for shortwave singularity
 
 module radiation_two_stream
@@ -31,5 +32,6 @@
   ! think of acos(1/lw_diffusivity) to be the effective zenith angle
   ! of longwave radiation.
-  real(jprd), parameter :: LwDiffusivity = 1.66_jprd
+  real(jprd), parameter :: LwDiffusivity   = 1.66_jprd
+  real(jprb), parameter :: LwDiffusivityWP = 1.66_jprb ! Working precision version
 
   ! Shortwave diffusivity factor assumes hemispheric isotropy, assumed
@@ -87,5 +89,6 @@
     if (lhook) call dr_hook('radiation_two_stream:calc_two_stream_gammas_lw',0,hook_handle)
 #endif
-
+! Added for DWD (2020)
+!NEC$ shortloop
     do jg = 1, ng
       ! Fu et al. (1997), Eq 2.9 and 2.10:
@@ -136,4 +139,6 @@
     ! Zdunkowski "PIFM" (Zdunkowski et al., 1980; Contributions to
     ! Atmospheric Physics 53, 147-66)
+! Added for DWD (2020)
+!NEC$ shortloop
     do jg = 1, ng
       !      gamma1(jg) = 2.0_jprb  - ssa(jg) * (1.25_jprb + 0.75_jprb*g(jg))
@@ -205,4 +210,6 @@
 #endif
 
+! Added for DWD (2020)
+!NEC$ shortloop
     do jg = 1, ng
       if (od(jg) > 1.0e-3_jprd) then
@@ -293,4 +300,6 @@
 #endif
 
+! Added for DWD (2020)
+!NEC$ shortloop
     do jg = 1, ng
       k_exponent = sqrt(max((gamma1(jg) - gamma2(jg)) * (gamma1(jg) + gamma2(jg)), &
@@ -359,4 +368,6 @@
 #endif
 
+! Added for DWD (2020)
+!NEC$ shortloop
     do jg = 1, ng
       ! Compute upward and downward emission assuming the Planck
@@ -450,4 +461,9 @@
     integer    :: jg
 
+    ! Local value of cosine of solar zenith angle, in case it needs to be
+    ! tweaked to avoid near division by zero. This is intentionally in working
+    ! precision (jprb) rather than fixing at double precision (jprd).
+    real(jprb) :: mu0_local
+
 #ifdef DO_DR_HOOK_TWO_STREAM
     real(jprb) :: hook_handle
@@ -456,20 +472,31 @@
 #endif
 
+! Added for DWD (2020)
+!NEC$ shortloop
     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
-        
+
+        k_exponent = sqrt(max((gamma1(jg) - gamma2(jg)) * (gamma1(jg) + gamma2(jg)), &
+             &       1.0e-12_jprd)) ! Eq 18
+
+        ! We had a rare crash where k*mu0 was within around 1e-13 of 1,
+        ! leading to ref_dir and trans_dir_diff being well outside the range
+        ! 0-1. The following approach is appropriate when k_exponent is double
+        ! precision and mu0_local is single precision, although work is needed
+        ! to make this entire routine secure in single precision.
+        mu0_local = mu0
+        if (abs(1.0_jprd - k_exponent*mu0) < 1000.0_jprd * epsilon(1.0_jprd)) then
+          mu0_local = mu0 * (1.0_jprb - 10.0_jprb*epsilon(1.0_jprb))
+        end if
+
+        od_over_mu0 = max(od(jg) / mu0_local, 0.0_jprd)
+
         ! 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_mu0 = k_exponent*mu0_local
         k_gamma3 = k_exponent*gamma3(jg)
         k_gamma4 = k_exponent*gamma4
@@ -482,8 +509,4 @@
         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)
         
@@ -498,5 +521,5 @@
         ! 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)
+        reftrans_factor = mu0_local * ssa(jg) * reftrans_factor / (1.0_jprd - k_mu0*k_mu0)
         
         ! Meador & Weaver (1980) Eq. 14, multiplying top & bottom by
@@ -505,23 +528,18 @@
              &  * ( (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)
+             &     -k_2_exponential*(gamma3(jg) - alpha2*mu0_local)*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) &
+        trans_dir_diff(jg) = reftrans_factor * ( k_2_exponential*(gamma4 + alpha1*mu0_local) &
             & - 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
+        ! Final check that ref_dir + trans_dir_diff <= 1
+        ref_dir(jg) = max(0.0_jprb, min(ref_dir(jg), 1.0_jprb))
+        trans_dir_diff(jg) = max(0.0_jprb, min(trans_dir_diff(jg), 1.0_jprb-ref_dir(jg)))
+
     end do
     
@@ -587,4 +605,6 @@
 #endif
 
+! Added for DWD (2020)
+!NEC$ shortloop
     do jg = 1, ng
       od_over_mu0 = max(gamma0(jg) * depth, 0.0_jprd)
@@ -699,4 +719,6 @@
 #endif
 
+! Added for DWD (2020)
+!NEC$ shortloop
     do jg = 1, ng
       ! Note that if the minimum value is reduced (e.g. to 1.0e-24)
Index: LMDZ6/trunk/libf/phylmd/ecrad/random_numbers_mix.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/random_numbers_mix.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/ecrad/random_numbers_mix.F90	(revision 4489)
@@ -239,9 +239,8 @@
   ! Generate uniformly distributed random numbers in the range 0.0<= px < 1.0
   !--------------------------------------------------------------------------------
-!  INTEGER(KIND=JPIM), PARAMETER :: IVAR=Z"3FFFFFFF"
-  INTEGER(KIND=JPIM) :: IVAR
-  DATA IVAR /Z"3FFFFFFF"/
+  INTEGER(KIND=JPIM), PARAMETER :: IVAR = INT(Z"3FFFFFFF",JPIM)
   TYPE(RANDOMNUMBERSTREAM), INTENT(INOUT) :: YD_STREAM
   REAL(KIND=JPRB), DIMENSION(:),     INTENT(  OUT) :: PX
+
   INTEGER(KIND=JPIM)                :: JJ, JK, IN, IFILLED
   
@@ -253,5 +252,5 @@
   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.
Index: LMDZ6/trunk/libf/phylmd/ecrad/readaerosol_optic_ecrad.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/readaerosol_optic_ecrad.F90	(revision 4489)
+++ LMDZ6/trunk/libf/phylmd/ecrad/readaerosol_optic_ecrad.F90	(revision 4489)
@@ -0,0 +1,311 @@
+! $Id: readaerosol_optic_ecrad.F90
+!
+SUBROUTINE readaerosol_optic_ecrad(debut, aerosol_couple, ok_alw, ok_volcan, &
+     flag_aerosol, flag_bc_internal_mixture, itap, rjourvrai, &
+     pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &
+     tr_seri, mass_solu_aero, mass_solu_aero_pi, &
+     tau_aero, piz_aero, cg_aero, &
+     tausum_aero, drytausum_aero, tau3d_aero )
+
+  ! This routine will :
+  ! 1) recevie the aerosols(already read and interpolated) corresponding to flag_aerosol
+  ! 2) calculate the optical properties for the aerosols
+  !
+
+  USE dimphy
+  USE aero_mod
+  USE phys_local_var_mod, only: sconcso4,sconcno3,sconcoa,sconcbc,sconcss,sconcdust, &
+       concso4,concno3,concoa,concbc,concss,concdust,loadso4,loadoa,loadbc,loadss,loaddust, &
+       loadno3,load_tmp1,load_tmp2,load_tmp3,load_tmp4,load_tmp5,load_tmp6,load_tmp7, & 
+       load_tmp8,load_tmp9,load_tmp10,m_allaer
+
+  USE infotrac_phy, ONLY: tracers, nqtot, nbtr
+  USE YOMCST
+
+  IMPLICIT NONE
+
+  include "clesphys.h"
+
+  ! Input arguments
+  !****************************************************************************************
+  LOGICAL, INTENT(IN)                      :: debut
+  LOGICAL, INTENT(IN)                      :: aerosol_couple
+  LOGICAL, INTENT(IN)                      :: ok_alw
+  LOGICAL, INTENT(IN)                      :: ok_volcan
+  INTEGER, INTENT(IN)                      :: flag_aerosol
+  LOGICAL, INTENT(IN)                      :: flag_bc_internal_mixture
+  INTEGER, INTENT(IN)                      :: itap
+  REAL, INTENT(IN)                         :: rjourvrai
+  REAL, INTENT(IN)                         :: pdtphys
+  REAL, DIMENSION(klon,klev), INTENT(IN)   :: pplay
+  REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs
+  REAL, DIMENSION(klon,klev), INTENT(IN)   :: t_seri
+  REAL, DIMENSION(klon,klev), INTENT(IN)   :: rhcl   ! humidite relative ciel clair
+  REAL, DIMENSION(klev), INTENT(IN)        :: presnivs
+  REAL, DIMENSION(klon,klev,nbtr), INTENT(IN) :: tr_seri ! concentration tracer
+
+  ! Output arguments
+  !****************************************************************************************
+  REAL, DIMENSION(klon,klev), INTENT(OUT)     :: mass_solu_aero    ! Total mass for all soluble aerosols
+  REAL, DIMENSION(klon,klev), INTENT(OUT)     :: mass_solu_aero_pi !     -"-     preindustrial values
+  REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: tau_aero    ! Aerosol optical thickness
+  REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: piz_aero    ! Single scattering albedo aerosol
+  REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: cg_aero     ! asymmetry parameter aerosol
+  REAL, DIMENSION(klon,nwave,naero_tot), INTENT(OUT)       :: tausum_aero
+  REAL, DIMENSION(klon,naero_tot), INTENT(OUT)             :: drytausum_aero
+  REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(OUT)  :: tau3d_aero
+
+  ! Local variables
+  !****************************************************************************************
+  REAL, DIMENSION(klon)        :: aerindex      ! POLDER aerosol index 
+  REAL, DIMENSION(klon,klev)   :: sulfacc       ! SO4 accumulation concentration [ug/m3]
+  REAL, DIMENSION(klon,klev)   :: sulfcoarse    ! SO4 coarse concentration [ug/m3]
+  REAL, DIMENSION(klon,klev)   :: bcsol         ! BC soluble concentration [ug/m3]
+  REAL, DIMENSION(klon,klev)   :: bcins         ! BC insoluble concentration [ug/m3]
+  REAL, DIMENSION(klon,klev)   :: pomsol        ! POM soluble concentration [ug/m3]
+  REAL, DIMENSION(klon,klev)   :: pomins        ! POM insoluble concentration [ug/m3]
+  REAL, DIMENSION(klon,klev)   :: cidust        ! DUST aerosol concentration  [ug/m3]
+  REAL, DIMENSION(klon,klev)   :: sscoarse      ! SS Coarse concentration [ug/m3]
+  REAL, DIMENSION(klon,klev)   :: sssupco       ! SS Super Coarse concentration [ug/m3]
+  REAL, DIMENSION(klon,klev)   :: ssacu         ! SS Acumulation concentration [ug/m3]
+  REAL, DIMENSION(klon,klev)   :: nitracc       ! nitrate accumulation concentration [ug/m3]
+  REAL, DIMENSION(klon,klev)   :: nitrcoarse    ! nitrate coarse concentration [ug/m3]
+  REAL, DIMENSION(klon,klev)   :: nitrinscoarse ! nitrate insoluble coarse concentration [ug/m3]
+  REAL, DIMENSION(klon,klev)   :: sulfacc_pi
+  REAL, DIMENSION(klon,klev)   :: sulfcoarse_pi
+  REAL, DIMENSION(klon,klev)   :: bcsol_pi
+  REAL, DIMENSION(klon,klev)   :: bcins_pi
+  REAL, DIMENSION(klon,klev)   :: pomsol_pi
+  REAL, DIMENSION(klon,klev)   :: pomins_pi
+  REAL, DIMENSION(klon,klev)   :: cidust_pi
+  REAL, DIMENSION(klon,klev)   :: sscoarse_pi
+  REAL, DIMENSION(klon,klev)   :: sssupco_pi
+  REAL, DIMENSION(klon,klev)   :: ssacu_pi
+  REAL, DIMENSION(klon,klev)   :: nitracc_pi
+  REAL, DIMENSION(klon,klev)   :: nitrcoarse_pi
+  REAL, DIMENSION(klon,klev)   :: nitrinscoarse_pi
+  REAL, DIMENSION(klon,klev)   :: pdel, zrho
+!  REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer
+  REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer_pi !RAF  
+
+  integer :: id_ASBCM, id_ASPOMM, id_ASSO4M, id_ASMSAM, id_CSSO4M, id_CSMSAM, id_SSSSM
+  integer :: id_CSSSM, id_ASSSM, id_CIDUSTM, id_AIBCM, id_AIPOMM, id_ASNO3M, id_CSNO3M, id_CINO3M
+  INTEGER :: k, i, iq, itr
+
+  !--air density
+  zrho(:,:)=pplay(:,:)/t_seri(:,:)/RD                     !--kg/m3
+
+  !****************************************************************************************
+  ! 1) Get aerosol mass
+  !    
+  !****************************************************************************************
+  !
+  !
+  IF (aerosol_couple) THEN   !--we get aerosols from tr_seri array from INCA
+     !
+     !--copy fields from INCA tr_seri 
+     !--convert to ug m-3 unit for consistency with offline fields
+     !
+     itr = 0
+     DO iq = 1,nqtot
+        IF(.NOT. tracers(iq)%isInPhysics) CYCLE
+        itr = itr+1
+        SELECT CASE(trim(tracers(iq)%name))
+           CASE ("ASBCM");  id_ASBCM  = itr
+           CASE ("ASPOMM"); id_ASPOMM = itr
+           CASE ("ASSO4M"); id_ASSO4M = itr
+           CASE ("ASMSAM"); id_ASMSAM = itr
+           CASE ("CSSO4M"); id_CSSO4M = itr
+           CASE ("CSMSAM"); id_CSMSAM = itr
+           CASE ("SSSSM");  id_SSSSM  = itr
+           CASE ("CSSSM");  id_CSSSM  = itr
+           CASE ("ASSSM");  id_ASSSM  = itr
+           CASE ("CIDUSTM");id_CIDUSTM= itr
+           CASE ("AIBCM");  id_AIBCM  = itr
+           CASE ("AIPOMM"); id_AIPOMM = itr
+           CASE ("ASNO3M"); id_ASNO3M = itr
+           CASE ("CSNO3M"); id_CSNO3M = itr
+           CASE ("CINO3M"); id_CINO3M = itr
+        END SELECT
+     END DO
+
+     bcsol(:,:)        =   tr_seri(:,:,id_ASBCM)                         *zrho(:,:)*1.e9  ! ASBCM
+     pomsol(:,:)       =   tr_seri(:,:,id_ASPOMM)                        *zrho(:,:)*1.e9  ! ASPOMM
+     sulfacc(:,:)      =  (tr_seri(:,:,id_ASSO4M)+tr_seri(:,:,id_ASMSAM))*zrho(:,:)*1.e9  ! ASSO4M (=SO4) + ASMSAM (=MSA)
+     sulfcoarse(:,:)   =  (tr_seri(:,:,id_CSSO4M)+tr_seri(:,:,id_CSMSAM))*zrho(:,:)*1.e9  ! CSSO4M (=SO4) + CSMSAM (=MSA)
+     sssupco(:,:)      =   tr_seri(:,:,id_SSSSM)                         *zrho(:,:)*1.e9  ! SSSSM
+     sscoarse(:,:)     =   tr_seri(:,:,id_CSSSM)                         *zrho(:,:)*1.e9  ! CSSSM
+     ssacu(:,:)        =   tr_seri(:,:,id_ASSSM)                         *zrho(:,:)*1.e9  ! ASSSM
+     cidust(:,:)       =   tr_seri(:,:,id_CIDUSTM)                       *zrho(:,:)*1.e9  ! CIDUSTM
+     bcins(:,:)        =   tr_seri(:,:,id_AIBCM)                         *zrho(:,:)*1.e9  ! AIBCM
+     pomins(:,:)       =   tr_seri(:,:,id_AIPOMM)                        *zrho(:,:)*1.e9  ! AIPOMM
+     nitracc(:,:)      =   tr_seri(:,:,id_ASNO3M)                        *zrho(:,:)*1.e9  ! ASNO3M
+     nitrcoarse(:,:)   =   tr_seri(:,:,id_CSNO3M)                        *zrho(:,:)*1.e9  ! CSNO3M
+     nitrinscoarse(:,:)=   tr_seri(:,:,id_CINO3M)                        *zrho(:,:)*1.e9  ! CINO3M
+     !
+     bcsol_pi(:,:)        =   0.0 ! ASBCM pre-ind
+     pomsol_pi(:,:)       =   0.0 ! ASPOMM pre-ind
+     sulfacc_pi(:,:)      =   0.0 ! ASSO4M (=SO4) + ASMSAM (=MSA) pre-ind
+     sulfcoarse_pi(:,:)   =   0.0 ! CSSO4M (=SO4) + CSMSAM (=MSA) pre-ind
+     sssupco_pi(:,:)      =   0.0 ! SSSSM pre-ind
+     sscoarse_pi(:,:)     =   0.0 ! CSSSM pre-ind
+     ssacu_pi(:,:)        =   0.0 ! ASSSM pre-ind
+     cidust_pi(:,:)       =   0.0 ! CIDUSTM pre-ind
+     bcins_pi(:,:)        =   0.0 ! AIBCM pre-ind
+     pomins_pi(:,:)       =   0.0 ! AIPOMM pre-ind
+     nitracc_pi(:,:)      =   0.0 ! ASNO3M pre-ind
+     nitrcoarse_pi(:,:)   =   0.0 ! CSNO3M pre-ind
+     nitrinscoarse_pi(:,:)=   0.0 ! CINO3M
+     !
+  ELSE !--not aerosol_couple
+     !
+     ! Read and interpolate sulfate
+     IF ( flag_aerosol .EQ. 1 .OR. flag_aerosol .EQ. 6 .OR. flag_aerosol .EQ. 7 ) THEN 
+
+        CALL readaerosol_interp(id_ASSO4M_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sulfacc, sulfacc_pi,loadso4)
+     ELSE
+        sulfacc(:,:) = 0. ; sulfacc_pi(:,:) = 0.
+        loadso4=0.
+     ENDIF
+
+     ! Read and interpolate bcsol and bcins
+     IF ( flag_aerosol .EQ. 2 .OR. flag_aerosol .EQ. 6 .OR. flag_aerosol .EQ. 7 ) THEN 
+
+        ! Get bc aerosol distribution 
+        CALL readaerosol_interp(id_ASBCM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcsol, bcsol_pi, load_tmp1 )
+        CALL readaerosol_interp(id_AIBCM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcins, bcins_pi, load_tmp2 )
+        loadbc(:)=load_tmp1(:)+load_tmp2(:)
+     ELSE
+        bcsol(:,:) = 0. ; bcsol_pi(:,:) = 0.
+        bcins(:,:) = 0. ; bcins_pi(:,:) = 0.
+        loadbc=0.
+     ENDIF
+
+     ! Read and interpolate pomsol and pomins
+     IF ( flag_aerosol .EQ. 3 .OR. flag_aerosol .EQ. 6 .OR. flag_aerosol .EQ. 7 ) THEN
+
+        CALL readaerosol_interp(id_ASPOMM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomsol, pomsol_pi, load_tmp3)
+        CALL readaerosol_interp(id_AIPOMM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomins, pomins_pi, load_tmp4)
+        loadoa(:)=load_tmp3(:)+load_tmp4(:)
+     ELSE
+        pomsol(:,:) = 0. ; pomsol_pi(:,:) = 0.
+        pomins(:,:) = 0. ; pomins_pi(:,:) = 0.
+        loadoa=0.
+     ENDIF
+
+     ! Read and interpolate csssm, ssssm, assssm
+     IF (flag_aerosol .EQ. 4 .OR. flag_aerosol .EQ. 6 .OR. flag_aerosol .EQ. 7 ) THEN 
+
+        CALL readaerosol_interp(id_SSSSM_phy ,itap, pdtphys,rjourvrai, &
+        debut, pplay, paprs, t_seri, sssupco, sssupco_pi, load_tmp5) 
+        CALL readaerosol_interp(id_CSSSM_phy ,itap, pdtphys,rjourvrai, &
+        debut, pplay, paprs, t_seri, sscoarse,sscoarse_pi, load_tmp6) 
+        CALL readaerosol_interp(id_ASSSM_phy ,itap, pdtphys,rjourvrai, &
+        debut, pplay, paprs, t_seri, ssacu, ssacu_pi, load_tmp7) 
+        loadss(:)=load_tmp5(:)+load_tmp6(:)+load_tmp7(:)
+     ELSE
+        sscoarse(:,:) = 0. ; sscoarse_pi(:,:) = 0. 
+        ssacu(:,:)    = 0. ; ssacu_pi(:,:) = 0. 
+        sssupco(:,:)  = 0. ; sssupco_pi = 0. 
+        loadss=0.
+     ENDIF
+
+     ! Read and interpolate cidustm
+     IF (flag_aerosol .EQ. 5 .OR. flag_aerosol .EQ. 6 .OR. flag_aerosol .EQ. 7 ) THEN 
+
+        CALL readaerosol_interp(id_CIDUSTM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, cidust, cidust_pi, loaddust) 
+
+     ELSE
+        cidust(:,:) = 0. ; cidust_pi(:,:) = 0. 
+        loaddust=0.
+     ENDIF
+     !
+     ! Read and interpolate asno3m, csno3m, cino3m
+     IF (flag_aerosol .EQ. 6 .OR. flag_aerosol .EQ. 7 ) THEN 
+
+        CALL readaerosol_interp(id_ASNO3M_phy, itap, pdtphys, rjourvrai, & 
+        debut, pplay, paprs, t_seri, nitracc, nitracc_pi, load_tmp8) 
+        CALL readaerosol_interp(id_CSNO3M_phy, itap, pdtphys, rjourvrai, & 
+        debut, pplay, paprs, t_seri, nitrcoarse, nitrcoarse_pi, load_tmp9) 
+        CALL readaerosol_interp(id_CINO3M_phy, itap, pdtphys, rjourvrai, & 
+        debut, pplay, paprs, t_seri, nitrinscoarse, nitrinscoarse_pi, load_tmp10) 
+        loadno3(:)=load_tmp8(:)+load_tmp9(:)+load_tmp10(:)
+
+     ELSE
+        nitracc(:,:)         =   0.0 ; nitracc_pi(:,:)      =   0.0 
+        nitrcoarse(:,:)      =   0.0 ; nitrcoarse_pi(:,:)   =   0.0
+        nitrinscoarse(:,:)   =   0.0 ; nitrinscoarse_pi(:,:)=   0.0
+        loadno3(:)=0.0
+     ENDIF
+     !
+     ! CSSO4M is set to 0 as not reliable
+     sulfcoarse(:,:)      =   0.0 ! CSSO4M (=SO4) + CSMSAM (=MSA) 
+     sulfcoarse_pi(:,:)   =   0.0 ! CSSO4M (=SO4) + CSMSAM (=MSA) pre-ind
+
+  ENDIF !--not aerosol_couple
+
+  !
+  ! Store all aerosols mixing ratios in one variable for radiation scheme (unit kg/kg for ECRAD)
+  ! present-day values
+  m_allaer(:,:,id_ASBCM_phy)  = bcsol(:,:)        /1.e9/zrho(:,:) ! ASBCM
+  m_allaer(:,:,id_ASPOMM_phy) = pomsol(:,:)       /1.e9/zrho(:,:) ! ASPOMM
+  m_allaer(:,:,id_ASSO4M_phy) = sulfacc(:,:)      /1.e9/zrho(:,:) ! ASSO4M (= SO4) 
+  m_allaer(:,:,id_CSSO4M_phy) = sulfcoarse(:,:)   /1.e9/zrho(:,:) ! CSSO4M 
+  m_allaer(:,:,id_SSSSM_phy)  = sssupco(:,:)      /1.e9/zrho(:,:) ! SSSSM
+  m_allaer(:,:,id_CSSSM_phy)  = sscoarse(:,:)     /1.e9/zrho(:,:) ! CSSSM
+  m_allaer(:,:,id_ASSSM_phy)  = ssacu(:,:)        /1.e9/zrho(:,:) ! ASSSM
+  m_allaer(:,:,id_CIDUSTM_phy)= cidust(:,:)       /1.e9/zrho(:,:) ! CIDUSTM
+  m_allaer(:,:,id_AIBCM_phy)  = bcins(:,:)        /1.e9/zrho(:,:) ! AIBCM
+  m_allaer(:,:,id_ASNO3M_phy) = nitracc(:,:)      /1.e9/zrho(:,:) ! ASNO3M
+  m_allaer(:,:,id_CSNO3M_phy) = nitrcoarse(:,:)   /1.e9/zrho(:,:) ! CSNO3M
+  m_allaer(:,:,id_CINO3M_phy) = nitrinscoarse(:,:)/1.e9/zrho(:,:) ! CINO3M
+  m_allaer(:,:,id_AIPOMM_phy) = pomins(:,:)       /1.e9/zrho(:,:) ! AIPOMM
+  m_allaer(:,:,id_STRAT_phy)  = 0.0
+
+  !  pre-industrial (pi) values
+  m_allaer_pi(:,:,id_ASBCM_phy)  = bcsol_pi(:,:)        /1.e9/zrho(:,:) ! ASBCM pre-ind
+  m_allaer_pi(:,:,id_ASPOMM_phy) = pomsol_pi(:,:)       /1.e9/zrho(:,:) ! ASPOMM pre-ind
+  m_allaer_pi(:,:,id_ASSO4M_phy) = sulfacc_pi(:,:)      /1.e9/zrho(:,:) ! ASSO4M (= SO4) pre-ind
+  m_allaer_pi(:,:,id_CSSO4M_phy) = sulfcoarse_pi(:,:)   /1.e9/zrho(:,:) ! CSSO4M pre-ind
+  m_allaer_pi(:,:,id_SSSSM_phy)  = sssupco_pi(:,:)      /1.e9/zrho(:,:) ! SSSSM pre-ind
+  m_allaer_pi(:,:,id_CSSSM_phy)  = sscoarse_pi(:,:)     /1.e9/zrho(:,:) ! CSSSM pre-ind
+  m_allaer_pi(:,:,id_ASSSM_phy)  = ssacu_pi(:,:)        /1.e9/zrho(:,:) ! ASSSM pre-ind
+  m_allaer_pi(:,:,id_CIDUSTM_phy)= cidust_pi(:,:)       /1.e9/zrho(:,:) ! CIDUSTM pre-ind
+  m_allaer_pi(:,:,id_AIBCM_phy)  = bcins_pi(:,:)        /1.e9/zrho(:,:) ! AIBCM pre-ind
+  m_allaer_pi(:,:,id_ASNO3M_phy) = nitracc_pi(:,:)      /1.e9/zrho(:,:) ! ASNO3M pre-ind
+  m_allaer_pi(:,:,id_CSNO3M_phy) = nitrcoarse_pi(:,:)   /1.e9/zrho(:,:) ! CSNO3M pre-ind
+  m_allaer_pi(:,:,id_CINO3M_phy) = nitrinscoarse_pi(:,:)/1.e9/zrho(:,:) ! CINO3M pre-ind
+  m_allaer_pi(:,:,id_AIPOMM_phy) = pomins_pi(:,:)       /1.e9/zrho(:,:) ! AIPOMM pre-ind
+  m_allaer_pi(:,:,id_STRAT_phy)  = 0.0
+
+  !
+  ! Calculate the total mass of all soluble aersosols (in unit ug /m3)
+  ! to be revisited for AR6
+  mass_solu_aero(:,:)    = sulfacc(:,:)    + bcsol(:,:)    + pomsol(:,:)    + nitracc(:,:)    + ssacu(:,:)
+  mass_solu_aero_pi(:,:) = sulfacc_pi(:,:) + bcsol_pi(:,:) + pomsol_pi(:,:) + nitracc_pi(:,:) + ssacu_pi(:,:)
+
+  !****************************************************************************************
+  ! 2) Calculate optical properties for the aerosols
+  !
+  !****************************************************************************************
+  DO k = 1, klev
+     DO i = 1, klon
+        pdel(i,k) = paprs(i,k) - paprs (i,k+1)
+     ENDDO
+  ENDDO
+
+  ! Diagnostics calculation for CMIP5 protocol unit (in unit kg/m3)
+  sconcso4(:)  =m_allaer(:,1,id_ASSO4M_phy)*1.e-9
+  sconcno3(:)  =(m_allaer(:,1,id_ASNO3M_phy)+m_allaer(:,1,id_CSNO3M_phy)+m_allaer(:,1,id_CINO3M_phy))*1.e-9
+  sconcoa(:)   =(m_allaer(:,1,id_ASPOMM_phy)+m_allaer(:,1,id_AIPOMM_phy))*1.e-9
+  sconcbc(:)   =(m_allaer(:,1,id_ASBCM_phy)+m_allaer(:,1,id_AIBCM_phy))*1.e-9
+  sconcss(:)   =(m_allaer(:,1,id_ASSSM_phy)+m_allaer(:,1,id_CSSSM_phy)+m_allaer(:,1,id_SSSSM_phy))*1.e-9
+  sconcdust(:) =m_allaer(:,1,id_CIDUSTM_phy)*1.e-9
+  concso4(:,:) =m_allaer(:,:,id_ASSO4M_phy)*1.e-9
+  concno3(:,:) =(m_allaer(:,:,id_ASNO3M_phy)+m_allaer(:,:,id_CSNO3M_phy)+m_allaer(:,:,id_CINO3M_phy))*1.e-9
+  concoa(:,:)  =(m_allaer(:,:,id_ASPOMM_phy)+m_allaer(:,:,id_AIPOMM_phy))*1.e-9
+  concbc(:,:)  =(m_allaer(:,:,id_ASBCM_phy)+m_allaer(:,:,id_AIBCM_phy))*1.e-9
+  concss(:,:)  =(m_allaer(:,:,id_ASSSM_phy)+m_allaer(:,:,id_CSSSM_phy)+m_allaer(:,:,id_SSSSM_phy))*1.e-9
+  concdust(:,:)=m_allaer(:,:,id_CIDUSTM_phy)*1.e-9
+
+END SUBROUTINE readaerosol_optic_ecrad
Index: LMDZ6/trunk/libf/phylmd/ecrad/setup_aerosol_optics_lmdz_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/ecrad/setup_aerosol_optics_lmdz_m.F90	(revision 4489)
+++ LMDZ6/trunk/libf/phylmd/ecrad/setup_aerosol_optics_lmdz_m.F90	(revision 4489)
@@ -0,0 +1,126 @@
+module setup_aerosol_optics_lmdz_m
+
+  implicit none
+
+contains
+
+  subroutine setup_aerosol_optics_lmdz(ao, file_name)
+
+    ! Read aerosol optical properties. Note differences with
+    ! "radiation_aerosol_optics_data::setup_aerosol_optics":
+
+    ! -- The input NetCDF file is not flat, it contains NetCDF groups.
+
+    ! -- We do not define ao%ssa_mono_phobic, ao%g_mono_phobic,
+    ! ao%lidar_ratio_mono_phobic, ao%ssa_mono_philic,
+    ! ao%g_mono_philic, ao%lidar_ratio_mono_philic. They are not in
+    ! the input NetCDF file and they are not used by ECRad.
+
+    ! -- We do not define ao%description_phobic_str and
+    ! ao%description_philic_str. We just leave the initialization
+    ! value, which is a blank.
+
+    ! -- We have to cshift the shortwave fields because the the
+    ! shortwave bands are in ascending order in the NetCDF file while
+    ! they are not in ECRad.
+
+    use radiation_aerosol_optics_data, only: aerosol_optics_type, &
+         IAerosolClassUndefined
+    use netcdf95, only: nf95_open, nf95_inq_grp_full_ncid, nf95_close, &
+         nf95_inq_dimid, nf95_inq_varid, nf95_inquire_dimension, &
+         nf95_get_var, nf95_gw_var
+    use netcdf, only: nf90_nowrite
+
+    type(aerosol_optics_type), intent(out):: ao
+
+    character(len=*), intent(in):: file_name
+    ! NetCDF file containing the aerosol optics data
+
+    ! Local:
+    integer ncid, grpid, dimid, varid
+
+    !-----------------------------------------------------------------------
+
+    ao%use_hydrophilic = .true.
+    ao%use_monochromatic = .true.
+    print*,'file_name= ',file_name
+    call nf95_open(file_name, nf90_nowrite, ncid)
+    call nf95_inq_grp_full_ncid(ncid, "Hydrophilic", grpid)
+    call nf95_inq_dimid(grpid, "hur", dimid)
+    call nf95_inquire_dimension(grpid, dimid, nclen = ao%nrh)
+    allocate(ao%rh_lower(ao%nrh))
+    call nf95_inq_varid(grpid, "hur_bounds", varid)
+    call nf95_get_var(grpid, varid, ao%rh_lower, count_nc = [1, ao%nrh])
+
+    ! Hydrophilic/LW_bands:
+    call nf95_inq_grp_full_ncid(ncid, "Hydrophilic/LW_bands", grpid)
+    call nf95_inq_varid(grpid, "asymmetry", varid)
+    call nf95_gw_var(grpid, varid, ao%g_lw_philic)
+    call nf95_inq_varid(grpid, "single_scat_alb", varid)
+    call nf95_gw_var(grpid, varid, ao%ssa_lw_philic)
+    call nf95_inq_varid(grpid, "mass_ext", varid)
+    call nf95_gw_var(grpid, varid, ao%mass_ext_lw_philic)
+
+    ! Hydrophilic/SW_bands:
+    call nf95_inq_grp_full_ncid(ncid, "Hydrophilic/SW_bands", grpid)
+    call nf95_inq_varid(grpid, "asymmetry", varid)
+    call nf95_gw_var(grpid, varid, ao%g_sw_philic)
+    ao%g_sw_philic = cshift(ao%g_sw_philic, 1)
+    call nf95_inq_varid(grpid, "single_scat_alb", varid)
+    call nf95_gw_var(grpid, varid, ao%ssa_sw_philic)
+    ao%g_sw_philic = cshift(ao%ssa_sw_philic, 1)
+    call nf95_inq_varid(grpid, "mass_ext", varid)
+    call nf95_gw_var(grpid, varid, ao%mass_ext_sw_philic)
+    ao%g_sw_philic = cshift(ao%mass_ext_sw_philic, 1)
+
+    ! Hydrophilic/Monochromatic:
+    call nf95_inq_grp_full_ncid(ncid, "Hydrophilic/Monochromatic", grpid)
+    call nf95_inq_varid(grpid, "mass_ext", varid)
+    call nf95_gw_var(grpid, varid, ao%mass_ext_mono_philic)
+
+    ! Hydrophobic/LW_bands:
+    call nf95_inq_grp_full_ncid(ncid, "Hydrophobic/LW_bands", grpid)
+    call nf95_inq_varid(grpid, "asymmetry", varid)
+    call nf95_gw_var(grpid, varid, ao%g_lw_phobic)
+    call nf95_inq_varid(grpid, "single_scat_alb", varid)
+    call nf95_gw_var(grpid, varid, ao%ssa_lw_phobic)
+    call nf95_inq_varid(grpid, "mass_ext", varid)
+    call nf95_gw_var(grpid, varid, ao%mass_ext_lw_phobic)
+
+    ! Hydrophobic/SW_bands:
+    call nf95_inq_grp_full_ncid(ncid, "Hydrophobic/SW_bands", grpid)
+    call nf95_inq_varid(grpid, "asymmetry", varid)
+    call nf95_gw_var(grpid, varid, ao%g_sw_phobic)
+    ao%g_sw_phobic = cshift(ao%g_sw_phobic, 1)
+    call nf95_inq_varid(grpid, "single_scat_alb", varid)
+    call nf95_gw_var(grpid, varid, ao%ssa_sw_phobic)
+    ao%g_sw_phobic = cshift(ao%ssa_sw_phobic, 1)
+    call nf95_inq_varid(grpid, "mass_ext", varid)
+    call nf95_gw_var(grpid, varid, ao%mass_ext_sw_phobic)
+    ao%g_sw_phobic = cshift(ao%mass_ext_sw_phobic, 1)
+
+    ! Hydrophobic/Monochromatic:
+    call nf95_inq_grp_full_ncid(ncid, "Hydrophobic/Monochromatic", grpid)
+    call nf95_inq_varid(grpid, "mass_ext", varid)
+    call nf95_gw_var(grpid, varid, ao%mass_ext_mono_phobic)
+
+    call nf95_close(ncid)
+
+    ! Get array sizes
+    ao%n_bands_lw = size(ao%mass_ext_lw_phobic, 1)
+    ao%n_bands_sw = size(ao%mass_ext_sw_phobic, 1)
+    ao%n_mono_wl = size(ao%mass_ext_mono_phobic, 1)
+    ao%n_type_phobic = size(ao%mass_ext_lw_phobic, 2)
+    ao%n_type_philic = size(ao%mass_ext_lw_philic, 3)
+
+    ! Allocate memory for mapping arrays
+    ao%ntype = ao%n_type_phobic + ao%n_type_philic
+    allocate(ao%iclass(ao%ntype))
+    allocate(ao%itype(ao%ntype))
+
+    ao%iclass = IAerosolClassUndefined
+    ao%itype  = 0
+
+  end subroutine setup_aerosol_optics_lmdz
+
+end module setup_aerosol_optics_lmdz_m
Index: LMDZ6/trunk/libf/phylmd/open_climoz_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/open_climoz_m.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/open_climoz_m.F90	(revision 4489)
@@ -27,7 +27,7 @@
 ! Arguments (OpenMP shared):
   INTEGER, INTENT(OUT):: ncid      !--- "climoz_LMDZ.nc" identifier
-  REAL, POINTER :: press_in_cen(:) !--- at cells centers
-  REAL, POINTER :: press_in_edg(:) !--- at the interfaces (pressure intervals)
-  REAL, POINTER :: time_in(:)      !--- records times, in days since Jan. 1st
+  REAL, allocatable, intent(out):: press_in_cen(:) !--- at cells centers
+  REAL, allocatable, INTENT(OUT):: press_in_edg(:) !--- at the interfaces (pressure intervals)
+  REAL, allocatable, intent(out):: time_in(:)      !--- records times, in days since Jan. 1st
   LOGICAL, INTENT(IN) :: daily     !--- daily files (calendar dependent days nb)
   LOGICAL, INTENT(IN) :: adjust    !--- tropopause adjustement required
Index: LMDZ6/trunk/libf/phylmd/phys_local_var_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/phys_local_var_mod.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/phys_local_var_mod.F90	(revision 4489)
@@ -24,4 +24,6 @@
       REAL, SAVE, ALLOCATABLE :: tr_seri(:,:,:)
       !$OMP THREADPRIVATE(tr_seri)
+      REAL, SAVE, ALLOCATABLE :: rhcl(:,:)
+      !$OMP THREADPRIVATE(rhcl)
       REAL, SAVE, ALLOCATABLE :: d_t_dyn(:,:), d_q_dyn(:,:)
       !$OMP THREADPRIVATE(d_t_dyn, d_q_dyn)
@@ -116,4 +118,7 @@
       !$OMP THREADPRIVATE(d_ts, d_tr)
 
+! aerosols
+      REAL, SAVE, ALLOCATABLE :: m_allaer (:,:,:)
+      !$OMP THREADPRIVATE(m_allaer)
 ! diagnostique pour le rayonnement
       REAL, SAVE, ALLOCATABLE :: topswad_aero(:),  solswad_aero(:)      ! diag
@@ -608,4 +613,5 @@
       l_mix(:,:,:)=0.;l_mixmin(:,:,:)=0.;tke_dissip(:,:,:)=0.;wprime(:,:,:)=0. ! doit etre initialse car pas toujours remplis
 
+      ALLOCATE(rhcl(klon,klev))
       ALLOCATE(tr_seri(klon,klev,nbtr))
       ALLOCATE(d_t_dyn(klon,klev),d_q_dyn(klon,klev))
@@ -647,4 +653,7 @@
       ALLOCATE(d_u_lif(klon,klev),d_v_lif(klon,klev))
       ALLOCATE(d_ts(klon,nbsrf), d_tr(klon,klev,nbtr))
+
+! aerosols
+      ALLOCATE(m_allaer(klon,klev,naero_tot))
 ! Special RRTM
       ALLOCATE(ZLWFT0_i(klon,klev+1),ZSWFT0_i(klon,klev+1),ZFLDN0(klon,klev+1))
@@ -937,4 +946,5 @@
       DEALLOCATE(l_mixmin,l_mix, tke_dissip,wprime)
 
+      DEALLOCATE(rhcl)
       DEALLOCATE(tr_seri)
       DEALLOCATE(d_t_dyn,d_q_dyn)
@@ -1046,5 +1056,6 @@
       DEALLOCATE(solsw_aerop, solsw0_aerop)
       DEALLOCATE(topswcf_aerop, solswcf_aerop)
-
+!AI Aerosols
+      DEALLOCATE(m_allaer)
 !CK LW diagnostics
       DEALLOCATE(toplwad_aerop, sollwad_aerop)
Index: LMDZ6/trunk/libf/phylmd/phys_output_write_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/phys_output_write_mod.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/phys_output_write_mod.F90	(revision 4489)
@@ -1569,4 +1569,5 @@
 !--OLIVIER
 !This is warranted by treating INCA aerosols as offline aerosols
+#ifndef CPP_ECRAD
        IF (flag_aerosol.GT.0) THEN
           IF (type_trac/='inca' .OR. config_inca=='aeNP') THEN 
@@ -1774,4 +1775,5 @@
           ENDIF
        ENDIF
+
        CALL histwrite_phy(o_lwcon, flwc)
        CALL histwrite_phy(o_iwcon, fiwc)
@@ -1808,4 +1810,5 @@
 #endif
 !solbnd end
+#endif
 #endif
 
Index: LMDZ6/trunk/libf/phylmd/physiq_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/physiq_mod.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/physiq_mod.F90	(revision 4489)
@@ -145,4 +145,5 @@
        ! Variables locales pour effectuer les appels en serie
        t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,tr_seri,rneb_seri, &
+       rhcl, &        
        ! Dynamic tendencies (diagnostics)
        d_t_dyn,d_q_dyn,d_ql_dyn,d_qs_dyn,d_u_dyn,d_v_dyn,d_tr_dyn,d_rneb_dyn, &
@@ -826,5 +827,5 @@
     ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     !
-    REAL rhcl(klon,klev)    ! humiditi relative ciel clair
+!    REAL rhcl(klon,klev)    ! humiditi relative ciel clair
     REAL dialiq(klon,klev)  ! eau liquide nuageuse
     REAL diafra(klon,klev)  ! fraction nuageuse
@@ -1120,7 +1121,7 @@
     !     climatology and the daylight climatology
     INTEGER,SAVE :: ncid_climoz                ! NetCDF file identifier
-    REAL, POINTER, SAVE :: press_cen_climoz(:) ! Pressure levels
-    REAL, POINTER, SAVE :: press_edg_climoz(:) ! Edges of pressure intervals
-    REAL, POINTER, SAVE :: time_climoz(:)      ! Time vector
+    REAL, allocatable, SAVE :: press_cen_climoz(:) ! Pressure levels
+    REAL, allocatable, SAVE :: press_edg_climoz(:) ! Edges of pressure intervals
+    REAL, allocatable, SAVE :: time_climoz(:)      ! Time vector
     CHARACTER(LEN=13), PARAMETER :: vars_climoz(2) &
                                   = ["tro3         ","tro3_daylight"]
@@ -4013,5 +4014,5 @@
                      tausum_aero, tau3d_aero)
              ENDIF
-          ELSE                       ! RRTM radiation
+          ELSE IF (iflag_rrtm .EQ.1) THEN  ! RRTM radiation
              IF (aerosol_couple .AND. config_inca == 'aero' ) THEN
                 abort_message='config_inca=aero et rrtm=1 impossible'
@@ -4079,5 +4080,19 @@
                 !
              ENDIF
+          ELSE IF (iflag_rrtm .EQ.2) THEN    ! ecrad RADIATION
+#ifdef CPP_ECRAD
+             !--climatologies or INCA aerosols
+             CALL readaerosol_optic_ecrad( debut, aerosol_couple, ok_alw, ok_volcan, &
+                  flag_aerosol, flag_bc_internal_mixture, itap, jD_cur-jD_ref, &
+                  pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
+                  tr_seri, mass_solu_aero, mass_solu_aero_pi,  &
+                  tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,  &
+                  tausum_aero, drytausum_aero, tau3d_aero)
+#else
+                abort_message='You should compile with -rad ecrad if running with iflag_rrtm=2'
+                CALL abort_physic(modname,abort_message,1)
+#endif
           ENDIF
+
        ELSE   !--flag_aerosol = 0 
           tausum_aero(:,:,:) = 0.
@@ -5388,6 +5403,6 @@
          IF (read_climoz >= 1) THEN
            IF (is_mpi_root) CALL nf95_close(ncid_climoz)
-            DEALLOCATE(press_edg_climoz) ! pointer
-            DEALLOCATE(press_cen_climoz) ! pointer
+            DEALLOCATE(press_edg_climoz)
+            DEALLOCATE(press_cen_climoz)
          ENDIF
        
Index: LMDZ6/trunk/libf/phylmd/press_coefoz_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/press_coefoz_m.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/press_coefoz_m.F90	(revision 4489)
@@ -4,5 +4,5 @@
   implicit none
 
-  real, pointer, save:: plev(:)
+  real, allocatable, save:: plev(:)
   ! (pressure level of Mobidic input data, converted to Pa, in strictly
   ! ascending order)
Index: LMDZ6/trunk/libf/phylmd/radlwsw_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/radlwsw_m.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/radlwsw_m.F90	(revision 4489)
@@ -78,4 +78,5 @@
 ! Besoin pour ECRAD de pctsrf, zmasq, longitude, altitude
 #ifdef CPP_ECRAD
+      USE phys_local_var_mod, ONLY: rhcl, m_allaer
       USE geometry_mod, ONLY: latitude, longitude
       USE phys_state_var_mod, ONLY: pctsrf
@@ -323,5 +324,5 @@
                ZQ_SNOW(klon,klev)           ! Snow cloud mass mixing ratio (kg/kg) ?
   REAL(KIND=8) ZAEROSOL_OLD(KLON,6,KLEV), &  ! 
-               ZAEROSOL(KLON,KLEV,naero_tot) !
+               ZAEROSOL(KLON,KLEV,naero_grp) !
 ! OUTPUTS
   REAL(KIND=8) ZFLUX_DIR(klon), &           ! Direct compt of surf flux into horizontal plane
@@ -1181,7 +1182,7 @@
 !
 ! AI ATTENTION Aerosols A REVOIR
-!      DO i = 1, kdlon
-!      DO k = 1, kflev
-!      DO kk= 1, naero_tot 
+      DO i = 1, kdlon
+      DO k = 1, kflev
+      DO kk= 1, naero_grp
 !      DO kk=1, NSW
 !
@@ -1194,8 +1195,9 @@
 !      PCGA_NAT(i,kflev+1-k,kk)=cg_aero_sw_rrtm(i,k,1,kk)
 !       ZAEROSOL(i,kflev+1-k,kk)=m_allaer(i,k,kk)
-!
-!      ENDDO
-!      ENDDO
-!      ENDDO
+       ZAEROSOL(i,kflev+1-k,kk)=m_allaer(i,k,kk)
+!
+      ENDDO
+      ENDDO
+      ENDDO
 !-end OB
 !
@@ -1345,8 +1347,9 @@
  
       CALL RADIATION_SCHEME &
-      & (ist, iend, klon, klev, naero_tot, NSW, &
-! ??? naero_tot
+      & (ist, iend, klon, klev, naero_grp, NSW, &
       & day_cur, current_time, & 
+!       Cste solaire/(d_Terre-Soleil)**2
       & SOLARIRAD, &
+!       Cos(angle zin), temp sol              
       & rmu0, tsol, &
 !       Albedo diffuse et directe
@@ -1354,11 +1357,7 @@
 !       Emessivite : PEMIS_WINDOW (???), &
       & ZEMIS, ZEMISW, &
-!       PCCN_LAND, PCCN_SEA, & ???
-      & pctsrf(:,is_ter), pctsrf(:,is_oce), &
 !       longitude(rad), sin(latitude), PMASQ_ ???
-      & ZGELAM, ZGEMU, zmasq, &
-!       pression et temp aux milieux
-      & pplay_i, t_i, &
-!       PTEMPERATURE_H ?, 
+      & ZGELAM, ZGEMU, &
+!       Temp et pres aux interf, vapeur eau, Satur spec humid 
       & paprs_i, ZTH_i, q_i, qsat_i, & 
 !       Gas
@@ -1366,5 +1365,6 @@
        & ZCCL4, POZON_i(:,:,1), ZO2, &
 !       nuages :
-      & cldfra_i, flwc_i, fiwc_i, ZQ_RAIN, ZQ_SNOW, &  
+      & cldfra_i, flwc_i, fiwc_i, ZQ_SNOW, &
+!       rayons effectifs des gouttelettes              
       & ref_liq_i, ref_ice_i, &
 !       aerosols
Index: LMDZ6/trunk/libf/phylmd/readaerosolstrato.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/readaerosolstrato.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/readaerosolstrato.F90	(revision 4489)
@@ -31,8 +31,8 @@
     integer n_lev   ! number of levels in the input data
     integer n_month ! number of months in the input data
-    real, pointer:: latitude(:)
-    real, pointer:: longitude(:)
-    real, pointer:: time(:)
-    real, pointer:: lev(:)
+    real, allocatable:: latitude(:)
+    real, allocatable:: longitude(:)
+    real, allocatable:: time(:)
+    real, allocatable:: lev(:)
     integer i, k, band, wave
     integer, save :: mth_pre=1
Index: LMDZ6/trunk/libf/phylmd/readaerosolstrato_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/readaerosolstrato_m.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/readaerosolstrato_m.F90	(revision 4489)
@@ -32,6 +32,6 @@
 !  USE YOERAD, ONLY : NLW
   IMPLICIT NONE
-  REAL, POINTER:: latitude(:)
-  REAL, POINTER:: longitude(:)
+  REAL, allocatable:: latitude(:)
+  REAL, allocatable:: longitude(:)
   INTEGER :: nlat, nlon
   REAL    :: null_array(0)
@@ -75,6 +75,6 @@
 !  USE YOERAD, ONLY : NLW
   IMPLICIT NONE
-  REAL, POINTER:: latitude(:)
-  REAL, POINTER:: wav(:)
+  REAL, allocatable:: latitude(:)
+  REAL, allocatable:: wav(:)
   INTEGER :: nlat,n_wav
   REAL    :: null_array(0)
Index: LMDZ6/trunk/libf/phylmd/readchlorophyll.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/readchlorophyll.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/readchlorophyll.F90	(revision 4489)
@@ -29,7 +29,7 @@
     INTEGER n_lev   ! number of levels in the input data
     INTEGER n_month ! number of months in the input data
-    REAL, POINTER :: latitude(:)
-    REAL, POINTER :: longitude(:)
-    REAL, POINTER :: time(:)
+    REAL, ALLOCATABLE :: latitude(:)
+    REAL, ALLOCATABLE :: longitude(:)
+    REAL, ALLOCATABLE :: time(:)
     INTEGER i, k
     INTEGER, SAVE :: mth_pre
Index: LMDZ6/trunk/libf/phylmd/regr_horiz_time_climoz_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/regr_horiz_time_climoz_m.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/regr_horiz_time_climoz_m.F90	(revision 4489)
@@ -4,10 +4,10 @@
   USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, grid_type, unstructured
   USE nrtype,            ONLY: pi
-  USE netcdf,   ONLY: NF90_CLOBBER, NF90_FLOAT,     NF90_GET_VAR, NF90_OPEN,   &
+  USE netcdf,   ONLY: NF90_CLOBBER, NF90_FLOAT,     NF90_OPEN,   &
                       NF90_NOWRITE, NF90_NOERR,     NF90_GET_ATT, NF90_GLOBAL
   USE netcdf95, ONLY: NF95_DEF_DIM, NF95_INQ_DIMID, NF95_INQUIRE_DIMENSION,    &
-                      NF95_DEF_VAR, NF95_INQ_VARID, NF95_INQUIRE_VARIABLE,     &
-          NF95_OPEN,  NF95_CREATE,  NF95_GET_ATT,   NF95_GW_VAR,  HANDLE_ERR,  &
-          NF95_CLOSE, NF95_ENDDEF,  NF95_PUT_ATT,   NF95_PUT_VAR, NF95_COPY_ATT
+       NF95_DEF_VAR, NF95_INQ_VARID, NF95_INQUIRE_VARIABLE, &
+       NF95_OPEN,  NF95_CREATE,  NF95_GET_ATT,   NF95_GW_VAR,  nf95_get_var,  &
+       NF95_CLOSE, NF95_ENDDEF,  NF95_PUT_ATT,   NF95_PUT_VAR, NF95_COPY_ATT
   USE print_control_mod, ONLY: lunout
   USE dimphy
@@ -88,7 +88,7 @@
   INTEGER :: nlev_in                       ! Number of pressure levels
   INTEGER :: nmth_in                       ! Number of months
-  REAL, POINTER     :: lon_in(:)           ! Longitudes   (ascending order, rad)
-  REAL, POINTER     :: lat_in(:)           ! Latitudes    (ascending order, rad)
-  REAL, POINTER     :: lev_in(:)           ! Pressure levels (ascen. order, hPa)
+  REAL, ALLOCATABLE:: lon_in(:)           ! Longitudes   (ascending order, rad)
+  REAL, ALLOCATABLE:: lat_in(:)           ! Latitudes    (ascending order, rad)
+  REAL, ALLOCATABLE:: lev_in(:)           ! Pressure levels (ascen. order, hPa)
   REAL, ALLOCATABLE :: lon_in_edge(:)      ! Longitude intervals edges
                                            !              (ascending order,  / )
@@ -125,5 +125,5 @@
   INTEGER :: fID_in_m, fID_in, levID_ou, dimid, vID_in(read_climoz), ntim_ou
   INTEGER :: fID_in_p, fID_ou, timID_ou, varid, vID_ou(read_climoz), ndims, ncerr
-  INTEGER, POINTER :: dIDs(:)
+  INTEGER, ALLOCATABLE :: dIDs(:)
   CHARACTER(LEN=20) :: cal_ou     !--- Calendar; no time inter => same as input
   CHARACTER(LEN=80) :: press_unit !--- Pressure unit
@@ -333,20 +333,16 @@
       !--- Read full current file and one record each available contiguous file
       DO iv=1,read_climoz
-        msg=TRIM(sub)//" NF90_GET_VAR "//TRIM(vars_in(iv))
         CALL NF95_INQ_VARID(fID_in, vars_in(1), vID_in(iv))
-        IF(l3D) ncerr=NF90_GET_VAR(fID_in, vID_in(iv), o3_in3(1:nlon_in,:,:,1:12,iv))
-        IF(l2D) ncerr=NF90_GET_VAR(fID_in, vID_in(iv), o3_in2(          :,:,1:12,iv))
-        CALL handle_err(TRIM(msg), ncerr, fID_in)
+        IF(l3D) call NF95_GET_VAR(fID_in, vID_in(iv), o3_in3(1:nlon_in,:,:,1:12,iv))
+        IF(l2D) call NF95_GET_VAR(fID_in, vID_in(iv), o3_in2(          :,:,1:12,iv))
         IF(lprev) THEN; sta(ndims)=12  
           CALL NF95_INQ_VARID(fID_in_m, vars_in(1), vID_in(iv))
-          IF(l3D) ncerr=NF90_GET_VAR(fID_in_m,vID_in(iv),o3_in3(1:nlon_in,:,:, 0,iv),sta,cnt)
-          IF(l2d) ncerr=NF90_GET_VAR(fID_in_m,vID_in(iv),o3_in2(          :,:, 0,iv),sta,cnt)
-          CALL handle_err(TRIM(msg)//" previous", ncerr, fID_in_m)
+          IF(l3D) call NF95_GET_VAR(fID_in_m,vID_in(iv),o3_in3(1:nlon_in,:,:, 0,iv),sta,cnt)
+          IF(l2d) call NF95_GET_VAR(fID_in_m,vID_in(iv),o3_in2(          :,:, 0,iv),sta,cnt)
         END IF
         IF(lnext) THEN; sta(ndims)=1  
           CALL NF95_INQ_VARID(fID_in_p, vars_in(1), vID_in(iv))
-          IF(l3D) ncerr=NF90_GET_VAR(fID_in_p,vID_in(iv),o3_in3(1:nlon_in,:,:,13,iv),sta,cnt)
-          IF(l2D) ncerr=NF90_GET_VAR(fID_in_p,vID_in(iv),o3_in2(          :,:,13,iv),sta,cnt)
-          CALL handle_err(TRIM(msg)//" next", ncerr, fID_in_p)
+          IF(l3D) call NF95_GET_VAR(fID_in_p,vID_in(iv),o3_in3(1:nlon_in,:,:,13,iv),sta,cnt)
+          IF(l2D) call NF95_GET_VAR(fID_in_p,vID_in(iv),o3_in2(          :,:,13,iv),sta,cnt)
         END IF
       END DO
Index: LMDZ6/trunk/libf/phylmd/regr_lat_time_coefoz_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/regr_lat_time_coefoz_m.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/regr_lat_time_coefoz_m.F90	(revision 4489)
@@ -43,7 +43,7 @@
     use regr_conserv_m, only: regr_conserv
     use regr_lint_m, only: regr_lint
-    use netcdf95, only: nf95_open, nf95_close, nf95_inq_varid, handle_err, &
+    use netcdf95, only: nf95_open, nf95_close, nf95_inq_varid, nf95_get_var, &
          nf95_put_var, nf95_gw_var
-    use netcdf, only: nf90_nowrite, nf90_get_var
+    use netcdf, only: nf90_nowrite
     use nrtype, only: pi
     use regular_lonlat_mod, only: boundslat_reg, south
@@ -55,5 +55,5 @@
     integer n_lat! number of latitudes in the input data
 
-    real, pointer:: latitude(:)
+    real, allocatable:: latitude(:)
     ! (of input data, converted to rad, sorted in strictly ascending order)
 
@@ -62,5 +62,5 @@
     ! ascending order)
 
-    real, pointer:: plev(:) ! pressure level of input data
+    real, allocatable:: plev(:) ! pressure level of input data
     logical desc_lat ! latitude in descending order in the input file
 
@@ -172,5 +172,5 @@
     forall (j = 2:n_lat) lat_in_edg(j) = (latitude(j - 1) + latitude(j)) / 2
     lat_in_edg(n_lat + 1) = pi / 2
-    deallocate(latitude) ! pointer
+    deallocate(latitude)
 
     call nf95_inq_varid(ncid_in, "plev", varid)
@@ -192,5 +192,5 @@
     call nf95_put_var(ncid_out, varid_plev, plev)
 
-    deallocate(plev) ! pointer
+    deallocate(plev)
 
     allocate(o3_par_in(n_lat, n_plev, 12))
@@ -201,7 +201,5 @@
        ! Process ozone parameter "name_in(i_v)"
 
-       ncerr = nf90_get_var(ncid_in, varid_in(i_v), o3_par_in)
-       call handle_err("nf90_get_var", ncerr, ncid_in)
-
+       call nf95_get_var(ncid_in, varid_in(i_v), o3_par_in)
        if (desc_lat) o3_par_in = o3_par_in(n_lat:1:-1, :, :)
 
Index: LMDZ6/trunk/libf/phylmd/regr_pr_int_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/regr_pr_int_m.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/regr_pr_int_m.F90	(revision 4489)
@@ -25,6 +25,5 @@
 
     use dimphy, only: klon
-    use netcdf95, only: nf95_inq_varid, handle_err
-    use netcdf, only: nf90_get_var
+    use netcdf95, only: nf95_inq_varid, nf95_get_var
     use assert_m, only: assert
     use regr_lint_m, only: regr_lint
@@ -79,6 +78,5 @@
 
        ! Get data at the right day from the input file:
-       ncerr = nf90_get_var(ncid, varid, v1(1, :, 1:), start=(/1, 1, julien/))
-       call handle_err("regr_pr_int nf90_get_var " // name, ncerr, ncid)
+       call nf95_get_var(ncid, varid, v1(1, :, 1:), start=(/1, 1, julien/))
        ! Latitudes are in ascending order in the input file while
        ! "rlatu" is in descending order so we need to invert order:
Index: LMDZ6/trunk/libf/phylmd/regr_pr_o3_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/regr_pr_o3_m.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/regr_pr_o3_m.F90	(revision 4489)
@@ -25,6 +25,6 @@
     ! hPa and strictly increasing.
 
-    use netcdf95, only: nf95_open, nf95_close, nf95_inq_varid, handle_err
-    use netcdf, only:  nf90_nowrite, nf90_get_var
+    use netcdf95, only: nf95_open, nf95_close, nf95_inq_varid, nf95_get_var
+    use netcdf, only:  nf90_nowrite
     use assert_m, only: assert
     use regr_conserv_m, only: regr_conserv
@@ -63,6 +63,5 @@
     call nf95_inq_varid(ncid, "r_Mob", varid)
     ! Get data at the right day from the input file:
-    ncerr = nf90_get_var(ncid, varid, r_mob, start=(/1, 1, day_ref/))
-    call handle_err("nf90_get_var r_Mob", ncerr)
+    call nf95_get_var(ncid, varid, r_mob, start=(/1, 1, day_ref/))
     ! Latitudes are in ascending order in the input file while
     ! "rlatu" is in descending order so we need to invert order:
Index: LMDZ6/trunk/libf/phylmd/regr_pr_time_av_m.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/regr_pr_time_av_m.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/regr_pr_time_av_m.F90	(revision 4489)
@@ -113,7 +113,7 @@
 !-------------------------------------------------------------------------------
   USE dimphy,         ONLY: klon
-  USE netcdf95,       ONLY: NF95_INQ_VARID, NF95_INQUIRE_VARIABLE, handle_err, &
-                            NF95_INQ_DIMID, NF95_INQUIRE_DIMENSION
-  USE netcdf,         ONLY: NF90_INQ_VARID, NF90_GET_VAR, NF90_NOERR
+  USE netcdf95,       ONLY: NF95_INQ_VARID, NF95_INQUIRE_VARIABLE, &
+                            NF95_INQ_DIMID, NF95_INQUIRE_DIMENSION, nf95_get_var
+  USE netcdf,         ONLY: NF90_INQ_VARID, NF90_NOERR
   USE assert_m,       ONLY: assert
   USE assert_eq_m,    ONLY: assert_eq
@@ -482,7 +482,6 @@
   CALL NF95_INQ_VARID(fID, TRIM(var), vID)
   CALL NF95_INQUIRE_VARIABLE(fID, vID, ndims=n_dim)
-  IF(n_dim==2) ncerr=NF90_GET_VAR(fID,vID,v(1,:), start=[  1,irec])
-  IF(n_dim==3) ncerr=NF90_GET_VAR(fID,vID,v(:,:), start=[1,1,irec])
-  CALL handle_err(TRIM(sub)//" NF90_GET_VAR "//TRIM(var),ncerr,fID)
+  IF(n_dim==2) call NF95_GET_VAR(fID,vID,v(1,:), start=[  1,irec])
+  IF(n_dim==3) call NF95_GET_VAR(fID,vID,v(:,:), start=[1,1,irec])
 
   !--- Flip latitudes: ascending in input file, descending in "rlatu".
@@ -514,7 +513,6 @@
     CALL NF95_INQ_VARID(fID, TRIM(nam(i)), vID)
     CALL NF95_INQUIRE_VARIABLE(fID, vID, ndims=n_dim)
-    IF(n_dim==3) ncerr=NF90_GET_VAR(fID,vID,v(1,:,:,i), start=[  1,1,irec])
-    IF(n_dim==4) ncerr=NF90_GET_VAR(fID,vID,v(:,:,:,i), start=[1,1,1,irec])
-    CALL handle_err(TRIM(sub)//" NF90_GET_VAR "//TRIM(nam(i)),ncerr,fID)
+    IF(n_dim==3) call NF95_GET_VAR(fID,vID,v(1,:,:,i), start=[  1,1,irec])
+    IF(n_dim==4) call NF95_GET_VAR(fID,vID,v(:,:,:,i), start=[1,1,1,irec])
   END DO
 
Index: LMDZ6/trunk/libf/phylmd/rrtm/read_rsun_rrtm.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/rrtm/read_rsun_rrtm.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/rrtm/read_rsun_rrtm.F90	(revision 4489)
@@ -27,5 +27,5 @@
 ! Local variables
   INTEGER :: ncid, dimid, varid, ncerr, nbday
-  REAL, POINTER :: wlen(:), time(:)
+  REAL, ALLOCATABLE :: wlen(:), time(:)
   REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: SSI_FRAC
 !$OMP THREADPRIVATE(SSI_FRAC)
Index: LMDZ6/trunk/libf/phylmd/rrtm/readaerosolstrato1_rrtm.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/rrtm/readaerosolstrato1_rrtm.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/rrtm/readaerosolstrato1_rrtm.F90	(revision 4489)
@@ -32,8 +32,8 @@
     INTEGER n_lev   ! number of levels in the input data
     INTEGER n_month ! number of months in the input data
-    REAL, POINTER:: latitude(:)
-    REAL, POINTER:: longitude(:)
-    REAL, POINTER:: time(:)
-    REAL, POINTER:: lev(:)
+    REAL, ALLOCATABLE:: latitude(:)
+    REAL, ALLOCATABLE:: longitude(:)
+    REAL, ALLOCATABLE:: time(:)
+    REAL, ALLOCATABLE:: lev(:)
     INTEGER k, band, wave, i
     INTEGER, SAVE :: mth_pre=1
Index: LMDZ6/trunk/libf/phylmd/rrtm/readaerosolstrato2_rrtm.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/rrtm/readaerosolstrato2_rrtm.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/rrtm/readaerosolstrato2_rrtm.F90	(revision 4489)
@@ -40,8 +40,8 @@
     INTEGER n_month ! number of months in the input data
     INTEGER n_wav   ! number of wavelengths in the input data
-    REAL, POINTER:: latitude(:)
-    REAL, POINTER:: time(:)
-    REAL, POINTER:: lev(:)
-    REAL, POINTER:: wav(:)
+    REAL, ALLOCATABLE:: latitude(:)
+    REAL, ALLOCATABLE:: time(:)
+    REAL, ALLOCATABLE:: lev(:)
+    REAL, ALLOCATABLE:: wav(:)
     INTEGER i,k,wave,band
     INTEGER, SAVE :: mth_pre=1
Index: LMDZ6/trunk/libf/phylmd/tracco2i_mod.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/tracco2i_mod.F90	(revision 4488)
+++ LMDZ6/trunk/libf/phylmd/tracco2i_mod.F90	(revision 4489)
@@ -365,5 +365,5 @@
 
     INTEGER :: n_glo, n_month
-    REAL, POINTER:: vector(:), time(:)
+    REAL, allocatable:: vector(:), time(:)
     REAL,ALLOCATABLE       :: flx_co2ff_glo(:,:) !  fossil-fuel CO2 
     REAL,ALLOCATABLE       :: flx_co2bb_glo(:,:) !  biomass-burning CO2 
Index: LMDZ6/trunk/makelmdz
===================================================================
--- LMDZ6/trunk/makelmdz	(revision 4488)
+++ LMDZ6/trunk/makelmdz	(revision 4489)
@@ -476,4 +476,7 @@
 
 #===============================================================================
+INCLUDE="$INCLUDE ${NETCDF95_INCDIR}"
+LIB="$LIB ${NETCDF95_LIBDIR} -l${LIBPREFIX}netcdf95"
+
 if [[ $io == ioipsl ]]
 then
Index: LMDZ6/trunk/makelmdz_fcm
===================================================================
--- LMDZ6/trunk/makelmdz_fcm	(revision 4488)
+++ LMDZ6/trunk/makelmdz_fcm	(revision 4489)
@@ -501,4 +501,7 @@
 fi
 
+INCLUDE="$INCLUDE ${NETCDF95_INCDIR}"
+LIB="$LIB ${NETCDF95_LIBDIR} ${NETCDF95_LIB}"
+
 if [[ $io == ioipsl ]]
 then
@@ -790,10 +793,4 @@
 build_status=$?
 
-err=$?
-# Check error message from fcm build
-if [ $err != 0 ] ; then
-  exit 1
-fi
-
 rm -rf tmp_src
 rm -rf config
