diff --git a/bin/spll b/bin/spll
index ba2fd7884933a0040563bbb5c72637abd64dde54..b0e9f3f2c56845dc46cf26e303722784fbbde369 100755
--- a/bin/spll
+++ b/bin/spll
@@ -27,7 +27,8 @@ extern_usersurc_ll.f90|\
extern_userio.f90|fmreadwrit.f90|fm_read_ll.f90|poub.f90|\
mode_glt.*.F90|\
rrtm_.*.F90|srtm_.*.F90|\
-libs4py.f90"
+libs4py.f90|\
+ec_meminfo.F90"
#
if [ "$SUF" = "f" ]
diff --git a/conf/profile_mesonh.ihm b/conf/profile_mesonh.ihm
index 15b72a3c69916cd2e9d2c2a76affe343cf13be17..11c7060f121da936de1c2838919ed1763808d31b 100755
--- a/conf/profile_mesonh.ihm
+++ b/conf/profile_mesonh.ihm
@@ -112,6 +112,7 @@ export VER_RTTOV=${VER_RTTOV}
#
export MNH_ECRAD=${MNH_ECRAD}
export VERSION_ECRAD=${VERSION_ECRAD}
+export VER_ECRAD=${VER_ECRAD}
#
# OASIS
#
@@ -135,7 +136,7 @@ export MNH_MEGAN=${MNH_MEGAN}
##########################################################
##########################################################
#
-export XYZ="-\${ARCH}-R\${MNH_REAL}I\${MNH_INT}-\${VERSION_XYZ}\${MNH_ECRAD:+-ECRAD}\${MNH_FOREFIRE:+-FF}\${VER_USER:+-\${VER_USER}}-\${VER_MPI}-\${OPTLEVEL}"
+export XYZ="-\${ARCH}-R\${MNH_REAL}I\${MNH_INT}-\${VERSION_XYZ}\${MNH_ECRAD:+-ECRAD${VER_ECRAD}}\${MNH_FOREFIRE:+-FF}\${VER_USER:+-\${VER_USER}}-\${VER_MPI}-\${OPTLEVEL}"
#[ "x\${VER_USER}" != "x" ] && export XYZ="\${XYZ}-\${VER_USER}"
# PATH to find tools like "makegen, etc ..."
export BIN_TOOLS=${BIN_TOOLS}
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/cmpl_binding.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/cmpl_binding.F90
new file mode 100644
index 0000000000000000000000000000000000000000..727f23375cad7dc1c0c09e6e1864975c97477660
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/cmpl_binding.F90
@@ -0,0 +1,159 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+SUBROUTINE CMPL_RECV(KBUF,KCOUNT,KTYPE,KSOURCE,KTAG,KCOMM,&
+ &KSYNC,KBLOCK,KRCOUNT,KRFROM,KRTAG,KERROR)
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+!USE MPL_MODULE
+USE MPL_RECV_MOD
+IMPLICIT NONE
+INTEGER KCOUNT,KTYPE,KSOURCE,KTAG,KCOMM
+INTEGER KRCOUNT,KRFROM,KRTAG,KERROR,KSYNC,KBLOCK
+INTEGER(KIND=JPIM) :: KBUF(*)
+INTEGER,EXTERNAL :: CONVIN,CONVOUT
+INTEGER ILENB,ILEN
+ILENB=CONVIN(KCOUNT,KTYPE)
+IF(KSOURCE > 0) THEN
+ IF(KTAG /= -1) THEN
+ CALL MPL_RECV(KBUF(1:ILENB),KSOURCE=KSOURCE,KTAG=KTAG,&
+ KFROM=KRFROM,KRECVTAG=KRTAG,KOUNT=ILEN,KERROR=KERROR)
+ ELSE
+ CALL MPL_RECV(KBUF(1:ILENB),KSOURCE=KSOURCE,&
+ KFROM=KRFROM,KRECVTAG=KRTAG,KOUNT=ILEN,KERROR=KERROR)
+ ENDIF
+ELSE
+ IF(KTAG /= -1) THEN
+ CALL MPL_RECV(KBUF(1:ILENB),KTAG=KTAG,&
+ KFROM=KRFROM,KRECVTAG=KRTAG,KOUNT=ILEN,KERROR=KERROR)
+ ELSE
+ CALL MPL_RECV(KBUF(1:ILENB),&
+ KFROM=KRFROM,KRECVTAG=KRTAG,KOUNT=ILEN,KERROR=KERROR)
+ ENDIF
+ENDIF
+KRCOUNT=CONVOUT(ILEN,KTYPE)
+END SUBROUTINE CMPL_RECV
+
+SUBROUTINE CMPL_SEND(KBUF,KCOUNT,KTYPE,KDEST,KTAG,KCOMM,&
+ &KSYNC,KBLOCK,KERROR)
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+!USE MPL_MODULE
+USE MPL_SEND_MOD
+IMPLICIT NONE
+INTEGER KCOUNT,KTYPE,KTAG,KCOMM,KSYNC,KBLOCK,KDEST
+INTEGER KERROR
+INTEGER KBUF(*)
+INTEGER,EXTERNAL :: CONVIN,CONVOUT
+INTEGER ILEN
+ILEN=CONVIN(KCOUNT,KTYPE)
+CALL MPL_SEND(KBUF(1:ILEN),KDEST=KDEST,KTAG=KTAG,KERROR=KERROR)
+END SUBROUTINE CMPL_SEND
+
+SUBROUTINE CMPL_BROADCAST(KBUF,KCOUNT,KTYPE,KROOT,KTAG,KCOMM,&
+ &KSYNC,KBLOCK,KERROR)
+!USE MPL_MODULE
+USE MPL_BROADCAST_MOD
+IMPLICIT NONE
+INTEGER KCOUNT,KTYPE,KTAG,KCOMM,KSYNC,KBLOCK,KROOT
+INTEGER KERROR
+INTEGER KBUF(*)
+INTEGER,EXTERNAL :: CONVIN,CONVOUT
+INTEGER ILEN
+ILEN=CONVIN(KCOUNT,KTYPE)
+CALL MPL_BROADCAST(KBUF(1:ILEN),KROOT=KROOT,KTAG=KTAG,KERROR=KERROR)
+END SUBROUTINE CMPL_BROADCAST
+
+SUBROUTINE CMPL_ABORT(CDMESS)
+USE MPL_MODULE
+IMPLICIT NONE
+CHARACTER(LEN=*) CDMESS
+CALL MPL_ABORT(CDMESS)
+END SUBROUTINE CMPL_ABORT
+
+SUBROUTINE CMPI_ABORT(KRC)
+USE MPL_MPIF, ONLY : MPI_COMM_WORLD
+IMPLICIT NONE
+INTEGER,INTENT(IN) :: KRC
+INTEGER :: IRET
+CALL MPI_ABORT(MPI_COMM_WORLD,KRC,IRET)
+END SUBROUTINE CMPI_ABORT
+
+SUBROUTINE CMPL_INIT(LDTRMSG,KERROR)
+!USE MPL_MODULE
+USE MPL_INIT_MOD
+IMPLICIT NONE
+LOGICAL LDTRMSG
+INTEGER KERROR
+CALL MPL_INIT(KERROR=KERROR,LDINFO=.FALSE.)
+END SUBROUTINE CMPL_INIT
+
+FUNCTION CMPL_NPROC()
+!USE MPL_MODULE
+USE MPL_NPROC_MOD
+IMPLICIT NONE
+INTEGER CMPL_NPROC
+CMPL_NPROC=MPL_NPROC()
+END FUNCTION CMPL_NPROC
+
+FUNCTION CMPL_MYRANK()
+!USE MPL_MODULE
+USE MPL_MYRANK_MOD
+IMPLICIT NONE
+INTEGER CMPL_MYRANK
+CMPL_MYRANK=MPL_MYRANK()
+END FUNCTION CMPL_MYRANK
+
+SUBROUTINE CMPL_BARRIER(KERROR)
+!USE MPL_MODULE
+USE MPL_BARRIER_MOD
+IMPLICIT NONE
+INTEGER KERROR
+CALL MPL_BARRIER(KERROR=KERROR)
+END SUBROUTINE CMPL_BARRIER
+
+SUBROUTINE CMPL_END(KERROR)
+!USE MPL_MODULE
+USE MPL_END_MOD
+IMPLICIT NONE
+INTEGER KERROR
+CALL MPL_END(KERROR=KERROR)
+END SUBROUTINE CMPL_END
+
+SUBROUTINE CMPL_GETARG(KARGNO, CDARG)
+USE MPL_MODULE
+IMPLICIT NONE
+INTEGER KARGNO
+CHARACTER(LEN=*) CDARG
+CALL MPL_GETARG(KARGNO, CDARG)
+END SUBROUTINE CMPL_GETARG
+
+FUNCTION CMPL_IARGC()
+!USE MPL_MODULE
+USE MPL_ARG_MOD
+IMPLICIT NONE
+INTEGER CMPL_IARGC
+CMPL_IARGC = MPL_IARGC()
+END FUNCTION CMPL_IARGC
+
+FUNCTION MPE_MYRANK()
+!USE MPL_MODULE
+USE MPL_MYRANK_MOD
+
+IMPLICIT NONE
+INTEGER MPE_MYRANK
+MPE_MYRANK=MPL_MYRANK()
+END FUNCTION MPE_MYRANK
+
+SUBROUTINE MPEI_ABORT(CDMESS)
+!USE MPL_MODULE
+USE MPL_ABORT_MOD
+
+IMPLICIT NONE
+CHARACTER(LEN=*) CDMESS
+CALL MPL_ABORT()
+END SUBROUTINE MPEI_ABORT
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/dr_hook_procinfo.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/dr_hook_procinfo.F90
new file mode 100644
index 0000000000000000000000000000000000000000..ada772f564253827627c4be5481d48a2cc313358
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/dr_hook_procinfo.F90
@@ -0,0 +1,19 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+SUBROUTINE DR_HOOK_PROCINFO(KMYPROC, KNPROC)
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+!USE MPL_MODULE, ONLY : MPL_WORLD_RANK, MPL_WORLD_SIZE
+USE MPL_INIT_MOD , ONLY : MPL_WORLD_RANK, MPL_WORLD_SIZE
+IMPLICIT NONE
+INTEGER(KIND=JPIM),INTENT(OUT) :: KMYPROC, KNPROC
+!INTEGER(KIND=JPIM) :: MPL_WORLD_RANK, MPL_WORLD_SIZE
+KMYPROC = MPL_WORLD_RANK + 1
+KNPROC = MPL_WORLD_SIZE
+END SUBROUTINE DR_HOOK_PROCINFO
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/dr_hook_util_multi.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/dr_hook_util_multi.F90
new file mode 100644
index 0000000000000000000000000000000000000000..aafece69bebd38a2bec474f9c316fcc1a67dac3b
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/dr_hook_util_multi.F90
@@ -0,0 +1,54 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+SUBROUTINE DR_HOOK_UTIL_MULTI(LDHOOK,CDNAME,KCASE,PKEY,KPKEY,CDFILENAME,KSIZEINFO)
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+USE OML_MOD,ONLY : OML_MAX_THREADS,OML_MY_THREAD
+IMPLICIT NONE
+LOGICAL,INTENT(INOUT) :: LDHOOK
+CHARACTER(LEN=*),INTENT(IN) :: CDNAME,CDFILENAME
+INTEGER(KIND=JPIM),INTENT(IN) :: KPKEY, KCASE,KSIZEINFO
+REAL(KIND=JPRB),INTENT(INOUT) :: PKEY(KPKEY)
+
+LOGICAL,SAVE :: LL_FIRST_TIME = .TRUE.
+REAL(KIND=JPRB) :: ZDUMMY
+INTEGER(KIND=JPIM) :: IMYTID, ISILENT, IMAXTH
+
+!#include "dr_hook_util.h"
+
+! -----------------------------------------------------------------
+
+IF (.NOT.LDHOOK) RETURN
+IF (LL_FIRST_TIME) THEN
+ LL_FIRST_TIME = .FALSE.
+ CALL DR_HOOK_UTIL(LDHOOK,'',-1,ZDUMMY,'',-1_JPIM)
+
+ ! Approximately the very first OpenMP-loop
+ IMAXTH = OML_MAX_THREADS()
+ ! trapfpe setting also for slave threads -- was missing
+ !$OMP PARALLEL DO SCHEDULE(STATIC,1) PRIVATE(IMYTID,ISILENT) IF (IMAXTH > 1)
+ DO IMYTID=1,IMAXTH
+ ISILENT = 1 ! no verbosity
+ IF (IMYTID == IMAXTH) ISILENT = 0 ! be verbose with the last thread
+ CALL TRAPFPE_SLAVE_THREADS(ISILENT) ! see drhook.c; does not anything for master thread
+ ENDDO ! IMYTID=1,IMAXTH
+ !$OMP END PARALLEL DO
+ENDIF
+
+!$OMP PARALLEL DO SCHEDULE(STATIC,1) PRIVATE(IMYTID)
+DO IMYTID=1,KPKEY
+ IF (KCASE == 0) THEN
+ CALL C_DRHOOK_START(CDNAME, IMYTID, PKEY(IMYTID), CDFILENAME, KSIZEINFO)
+ ELSE IF (KCASE == 1) THEN
+ CALL C_DRHOOK_END (CDNAME, IMYTID, PKEY(IMYTID), CDFILENAME, KSIZEINFO)
+ ENDIF
+ENDDO ! IMYTID=1,KPKEY
+!$OMP END PARALLEL DO
+
+END SUBROUTINE DR_HOOK_UTIL_MULTI
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/ec_meminfo_mnh_mod.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/ec_meminfo_mnh_mod.F90
new file mode 100644
index 0000000000000000000000000000000000000000..2a90bd219bc4fca2091491f4a05e75ebeb8245c3
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/ec_meminfo_mnh_mod.F90
@@ -0,0 +1,822 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+MODULE EC_MEMINFO_MOD
+
+CONTAINS
+
+SUBROUTINE EC_MEMINFO(KU,CDSTRING,KCOMM,KBARR,KIOTASK,KCALL)
+
+USE PARKIND1, ONLY : JPIM, JPIB, JPRD
+USE MPL_MPIF
+
+IMPLICIT NONE
+
+!-- EC_MEMINFO:
+! Author : Peter Towers (ECMWF) : 2015-2016
+! Modified : Sami Saarinen (ECMWF) : 21-SEP-2016 : Added getenv EC_MEMINFO -- export EC_MEMINFO=0 disables any EC_MEMINFO output
+! Sami Saarinen (ECMWF) : 02-MAR-2017 : Enabled flexible number of sockets & lots of tidying
+! Sami Saarinen (ECMWF) : 09-MAR-2017 : Power monitoring added (via EC_PMON) -- works at least on Cray systems
+! Sami Saarinen (ECMWF) : 12-MAR-2017 : Gather core affinities via call to ec_coreid()
+! Sami Saarinen (ECMWF) : 12-DEC-2017 : Obtain MPI & OpenMP version information
+
+!#include "ec_pmon.intfb.h"
+
+INTEGER(KIND=JPIM), INTENT(IN) :: KU,KCOMM,KBARR,KIOTASK,KCALL
+CHARACTER(LEN=*), INTENT(IN) :: CDSTRING
+INTEGER(KIND=JPIM), PARAMETER :: ITAG = 98765
+INTEGER(KIND=JPIM) :: ID,KULOUT
+INTEGER(KIND=JPIM) :: II,JJ,I,J,K,MYPROC,NPROC,LEN,ERROR,NODENUM,JID,IDX
+INTEGER(KIND=JPIB) :: TASKSMALL,NODEHUGE,MEMFREE,CACHED,NFREE
+INTEGER(KIND=JPIB),SAVE :: NODEHUGE_CACHED
+INTEGER(KIND=JPIM), PARAMETER :: MAXNUMA_DEF = 4 ! Max number of "sockets" supported by default
+INTEGER(KIND=JPIM), SAVE :: MAXNUMA = 0 ! Max number of "sockets" supported -- initialized to zero to enforce updated value (env EC_MAXNUMA)
+INTEGER(KIND=JPIM) :: NNUMA ! Actual number of "sockets" (can be 0 ob systems that do not have /proc/buddyinfo, e.g. WSL)
+!INTEGER(KIND=JPIB),DIMENSION(0:MAXNUMA-1) :: SMALLPAGE,HUGEPAGE
+INTEGER(KIND=JPIB),DIMENSION(:),ALLOCATABLE,SAVE :: SMALLPAGE,HUGEPAGE
+INTEGER(KIND=JPIB) :: GETMAXRSS,GETMAXHWM
+INTEGER(KIND=JPIB) :: HEAP_SIZE
+INTEGER(KIND=JPIB), PARAMETER :: ONEMEGA = 1024_JPIB * 1024_JPIB
+INTEGER(KIND=JPIB) :: ENERGY, POWER
+INTEGER(KIND=JPIB) :: TOT_ENERGY, MAXPOWER, AVGPOWER
+INTEGER(KIND=JPIM),SAVE :: PAGESIZE = 0
+INTEGER(KIND=JPIM),SAVE :: MAXTH = 0
+INTEGER(KIND=JPIM),SAVE :: MAXTH_COMP = 0
+INTEGER(KIND=JPIM),SAVE :: MAXTH_IO = 0
+INTEGER(KIND=JPIM),PARAMETER :: MAXCOLS = 18 ! Max numerical columns in /proc/buddyinfo (often just 11, but Cray has 18 entries)
+INTEGER(KIND=JPIM) :: N18
+!INTEGER(KIND=JPIB),DIMENSION(0:MAXCOLS-1,0:MAXNUMA-1) :: NODE, BUCKET
+!INTEGER(KIND=JPIB),DIMENSION(7+2*MAXNUMA) :: SENDBUF,RECVBUF
+INTEGER(KIND=JPIB),DIMENSION(:,:),ALLOCATABLE,SAVE :: NODE, BUCKET
+INTEGER(KIND=JPIB),DIMENSION(:),ALLOCATABLE,SAVE :: SENDBUF,RECVBUF
+REAL(KIND=JPRD) :: PERCENT_USED(2)
+CHARACTER(LEN=256) :: CLSTR
+CHARACTER(LEN=512) :: TMPDIR
+CHARACTER(LEN=512), SAVE :: PROGRAM = ' '
+CHARACTER(LEN=20) :: NODENAME,LASTNODE,CLMAXNODE
+CHARACTER(LEN=12) :: VAL
+CHARACTER(LEN=1) :: M
+CHARACTER(LEN=160) ::LINE
+CHARACTER(LEN=56) :: FILENAME
+CHARACTER(LEN=1) :: CLEC_MEMINFO
+CHARACTER(LEN=5) :: CSTAR
+CHARACTER(LEN=LEN(CSTAR)+1+LEN(CDSTRING)) :: ID_STRING
+CHARACTER(LEN=10) :: CLDATEOD,CLTIMEOD,CLZONEOD
+CHARACTER(LEN=3), PARAMETER :: CLMON(1:12) = (/ &
+ 'Jan','Feb','Mar','Apr','May','Jun', &
+ 'Jul','Aug','Sep','Oct','Nov','Dec' /)
+INTEGER(KIND=JPIM) :: IVALUES(8), IMON
+INTEGER(KIND=JPIM) :: IRECV_STATUS(MPI_STATUS_SIZE)
+LOGICAL :: LLNOCOMM, LLNOHDR
+INTEGER(KIND=JPIM), SAVE :: IAM_NODEMASTER = 0
+LOGICAL, SAVE :: LLFIRST_TIME = .TRUE.
+TYPE RANKNODE_T
+ INTEGER(KIND=JPIM) :: NODENUM
+ INTEGER(KIND=JPIM) :: RANK_WORLD
+ INTEGER(KIND=JPIM) :: RANK
+ INTEGER(KIND=JPIM) :: IORANK
+ INTEGER(KIND=JPIM) :: NODEMASTER
+ INTEGER(KIND=JPIM) :: NUMTH
+ INTEGER(KIND=JPIM), ALLOCATABLE :: COREIDS(:)
+ CHARACTER(LEN=LEN(NODENAME)) :: NODE
+ CHARACTER(LEN=LEN(CLSTR)) :: STR
+END TYPE
+TYPE (RANKNODE_T), ALLOCATABLE, SAVE :: RN(:)
+INTEGER(KIND=JPIM), ALLOCATABLE :: COREIDS(:)
+LOGICAL, ALLOCATABLE :: DONE(:)
+INTEGER(KIND=JPIM), SAVE :: NUMNODES = 0
+INTEGER(KIND=JPIM) :: NN
+INTEGER(KIND=JPIM), SAVE :: IOTASKS = 0
+INTEGER(KIND=JPIM) :: IORANK, NSEND, NRECV
+LOGICAL :: FILE_EXISTS
+REAL(KIND=JPRD), EXTERNAL :: UTIL_WALLTIME
+REAL(KIND=JPRD), SAVE :: WT0
+REAL(KIND=JPRD) :: WT
+CHARACTER(LEN=64) :: CLPFX
+CHARACTER(LEN=3) :: ZUM
+INTEGER(KIND=JPIM) :: IPFXLEN, NUMTH, MYTH
+INTEGER(KIND=JPIM) :: NCOMM_MEMINFO = 0
+COMMON /cmn_meminfo/ NCOMM_MEMINFO
+INTEGER OMP_GET_MAX_THREADS, OMP_GET_THREAD_NUM
+#ifdef _OPENMP
+EXTERNAL OMP_GET_MAX_THREADS, OMP_GET_THREAD_NUM
+#else
+OMP_GET_MAX_THREADS() = 1
+OMP_GET_THREAD_NUM() = 0
+#endif
+
+CALL GET_ENVIRONMENT_VARIABLE('EC_MEMINFO',CLEC_MEMINFO)
+IF (CLEC_MEMINFO == '0') RETURN
+
+IF (LLFIRST_TIME) WT0 = UTIL_WALLTIME()
+IF (MAXTH == 0) MAXTH = OMP_GET_MAX_THREADS()
+
+LLNOCOMM = (KCOMM == -1 .or. KCOMM == -2)
+LLNOHDR = (KCOMM == -2)
+
+IF (LLNOCOMM) THEN
+ ! Direct call to obtain EC_meminfo -output
+ ERROR = 0
+ MYPROC = 0
+ NPROC = 1
+ CLPFX = CDSTRING
+ IPFXLEN = LEN_TRIM(CLPFX)
+ ZUM = 'tsk'
+ELSE
+ CLPFX = ' '
+ IPFXLEN = 0
+ ZUM = 'sum'
+ CALL MPI_COMM_RANK(KCOMM,MYPROC,ERROR)
+ CALL CHECK_ERROR("from MPI_COMM_RANK",__FILE__,__LINE__)
+
+ CALL MPI_COMM_SIZE(KCOMM,NPROC,ERROR)
+ CALL CHECK_ERROR("from MPI_COMM_SIZE",__FILE__,__LINE__)
+
+ IF (KCALL == 0) THEN
+ CALL CONDBARR()
+ CALL CHECK_ERROR("from MPI_BARRIER(at start)",__FILE__,__LINE__)
+ ENDIF
+ENDIF
+
+IF (LLFIRST_TIME) THEN ! The *very* first time
+ CALL EC_PMON(ENERGY,POWER)
+
+ !-- Neither of these two may stop working when linking with C++ (like in OOPS) ...
+ ! CALL GETARG(0,PROGRAM)
+ ! CALL GET_COMMAND_ARGUMENT(0,PROGRAM)
+ !... so using the old saviour from ifsaux/support/cargs.c:
+ CALL GETARG_C(0,PROGRAM)
+
+ CALL GET_ENVIRONMENT_VARIABLE("HUGETLB_DEFAULT_PAGE_SIZE",VAL)
+ I=INDEX(VAL,"M")
+ IF(I > 0) THEN
+ READ(VAL(1:I-1),*) PAGESIZE
+ PAGESIZE=PAGESIZE*1024
+ ELSE
+ PAGESIZE=0
+ ENDIF
+
+ NODEHUGE=0
+
+ IF(PAGESIZE > 0) THEN
+ !WRITE(FILENAME,'(a,i0,a)') "/sys/kernel/mm/hugepages/hugepages-", &
+ ! PAGESIZE,"kB/nr_hugepages"
+ FILENAME='/proc/sys/vm/nr_hugepages' ! more generic; contents the same as in /sys/kernel/mm/hugepages/hugepages-2048kB/nr_hugepages
+ INQUIRE(FILE=FILENAME, EXIST=FILE_EXISTS)
+ IF( FILE_EXISTS ) THEN
+ OPEN(502,FILE=FILENAME,STATUS="old",ACTION="read",ERR=999)
+ READ(502,*,ERR=998,END=998) NODEHUGE
+998 continue
+ CLOSE(502)
+ ENDIF
+999 continue
+ ENDIF
+
+ NODEHUGE=NODEHUGE*PAGESIZE
+ NODEHUGE=NODEHUGE/1024
+ NODEHUGE_CACHED = NODEHUGE
+ENDIF
+
+NODEHUGE=NODEHUGE_CACHED
+
+CALL EC_GETHOSTNAME(NODENAME) ! from support/env.c
+
+IF (MAXNUMA == 0) THEN
+ CALL GET_ENVIRONMENT_VARIABLE("EC_MAXNUMA",VAL) ! Note: *not* export EC_MEMINFO_MAXNUMA=<value>, but EC_MAXNUMA=<value>
+ IF (VAL /= "") READ(VAL,*) MAXNUMA
+ IF (MAXNUMA < 1) MAXNUMA = MAXNUMA_DEF
+ ALLOCATE(SMALLPAGE(0:MAXNUMA-1))
+ ALLOCATE(HUGEPAGE(0:MAXNUMA-1))
+ ALLOCATE(NODE(0:MAXCOLS-1,0:MAXNUMA-1))
+ ALLOCATE(BUCKET(0:MAXCOLS-1,0:MAXNUMA-1))
+ ALLOCATE(SENDBUF(7+2*MAXNUMA))
+ ALLOCATE(RECVBUF(7+2*MAXNUMA))
+ENDIF
+
+IF (MYPROC == 0) THEN
+!
+! Use already open file for output or $EC_MEMINFO_TMPDIR/meminfo
+! We do not use $TMPDIR as it may have been inherited from mother superiour (MOMS) node
+!
+ IF(KU == -1) THEN
+ CALL GET_ENVIRONMENT_VARIABLE('EC_MEMINFO_TMPDIR',TMPDIR)
+ IF (TMPDIR == ' ') TMPDIR = '.'
+ ! write(0,*) '## EC_MEMINFO: KCOMM=',KCOMM
+ ! CALL LINUX_TRBK()
+ KULOUT=501
+ OPEN(UNIT=KULOUT,FILE=TRIM(TMPDIR)//"/"//"meminfo.txt",STATUS='unknown', &
+ ACTION='write',POSITION='append')
+ ELSE
+ KULOUT=KU
+ ENDIF
+ENDIF
+
+IF (LLFIRST_TIME .and. .not. LLNOCOMM) THEN
+! Fetch affinities (over OpenMP threads)
+! Note: I/O-tasks may now have different number of threads than on computational tasks
+ ALLOCATE(COREIDS(0:MAXTH-1))
+#ifdef _OPENMP
+!$OMP PARALLEL NUM_THREADS(MAXTH) SHARED(COREIDS) PRIVATE(MYTH)
+#endif
+ MYTH = OMP_GET_THREAD_NUM()
+ CALL EC_COREID(COREIDS(MYTH))
+#ifdef _OPENMP
+!$OMP END PARALLEL
+#endif
+
+! Store the communicator we are in upon entering EC_MEMINFO for the first time -- to be used in the EC_MPI_FINALIZE
+ NCOMM_MEMINFO = KCOMM
+! Fetch node names & numbers per task
+ IORANK = 0
+ IF (KIOTASK > 0) IORANK = 1
+ IF (MYPROC == 0) THEN
+ CALL SLASH_PROC
+ ALLOCATE(RN(0:NPROC-1))
+ DO I=0,NPROC-1
+ RN(I)%NODENUM = -1
+ IF (I > 0) THEN ! Receive in the MPI-rank order of KCOMM (i.e. may not be the same as MPI_COMM_WORLD -order)
+ CALL MPI_RECV(LASTNODE,LEN(LASTNODE),MPI_BYTE,I,ITAG,KCOMM,IRECV_STATUS,ERROR)
+ CALL CHECK_ERROR("from MPI_RECV(LASTNODE)",__FILE__,__LINE__)
+ CALL MPI_RECV(IORANK,1,MPI_INTEGER4,I,ITAG+1,KCOMM,IRECV_STATUS,ERROR)
+ CALL CHECK_ERROR("from MPI_RECV(IORANK)",__FILE__,__LINE__)
+ CALL MPI_RECV(K,1,MPI_INTEGER4,I,ITAG+2,KCOMM,IRECV_STATUS,ERROR)
+ CALL CHECK_ERROR("from MPI_RECV(RANK_WORLD)",__FILE__,__LINE__)
+ CALL MPI_RECV(NUMTH,1,MPI_INTEGER4,I,ITAG+3,KCOMM,IRECV_STATUS,ERROR)
+ CALL CHECK_ERROR("from MPI_RECV(NUMTH)",__FILE__,__LINE__)
+ CALL MPI_RECV(CLSTR,LEN(CLSTR),MPI_BYTE,I,ITAG+4,KCOMM,IRECV_STATUS,ERROR)
+ CALL CHECK_ERROR("from MPI_RECV(CLSTR)",__FILE__,__LINE__)
+ RN(I)%RANK = I
+ RN(I)%STR = CLSTR
+ ELSE
+ LASTNODE=NODENAME
+ NUMTH = MAXTH
+ CALL MPI_COMM_RANK(MPI_COMM_WORLD,K,ERROR)
+ RN(I)%RANK = 0 ! Itself
+ RN(I)%STR = CDSTRING
+ ENDIF
+ RN(I)%RANK_WORLD = K
+ RN(I)%IORANK = IORANK
+ RN(I)%NODEMASTER = 0
+ RN(I)%NODE = LASTNODE
+ ! Affinities
+ RN(I)%NUMTH = NUMTH
+ ALLOCATE(RN(I)%COREIDS(0:NUMTH-1))
+ IF (I > 0) THEN ! Receive in MPI-rank order
+ CALL MPI_RECV(RN(I)%COREIDS,NUMTH,MPI_INTEGER4,I,ITAG+5,KCOMM,IRECV_STATUS,ERROR)
+ CALL CHECK_ERROR("from MPI_RECV(COREIDS)",__FILE__,__LINE__)
+ ELSE
+ RN(I)%COREIDS = COREIDS
+ ENDIF
+ IF (IORANK == 0) THEN
+ MAXTH_COMP = MAX(MAXTH_COMP,NUMTH)
+ ELSE
+ MAXTH_IO = MAX(MAXTH_IO,NUMTH)
+ ENDIF
+ ENDDO
+
+ CALL RNSORT(KULOUT) ! Output now goes to "meminfo.txt"
+
+ IAM_NODEMASTER = RN(0)%NODEMASTER ! Itself
+ DO I=1,NPROC-1
+ CALL MPI_SEND(RN(I)%NODEMASTER,1,MPI_INTEGER4,I,ITAG+6,KCOMM,ERROR)
+ CALL CHECK_ERROR("from MPI_SEND(IAM_NODEMASTER)",__FILE__,__LINE__)
+ ENDDO
+ ELSE
+ CALL MPI_SEND(NODENAME,LEN(NODENAME),MPI_BYTE,0,ITAG,KCOMM,ERROR)
+ CALL CHECK_ERROR("from MPI_SEND(NODENAME)",__FILE__,__LINE__)
+ CALL MPI_SEND(IORANK,1,MPI_INTEGER4,0,ITAG+1,KCOMM,ERROR)
+ CALL CHECK_ERROR("from MPI_SEND(IORANK)",__FILE__,__LINE__)
+ CALL MPI_COMM_RANK(MPI_COMM_WORLD,K,ERROR)
+ CALL MPI_SEND(K,1,MPI_INTEGER4,0,ITAG+2,KCOMM,ERROR)
+ CALL CHECK_ERROR("from MPI_SEND(RANK_WORLD)",__FILE__,__LINE__)
+ CALL MPI_SEND(MAXTH,1,MPI_INTEGER4,0,ITAG+3,KCOMM,ERROR)
+ CALL CHECK_ERROR("from MPI_SEND(MAXTH)",__FILE__,__LINE__)
+ CLSTR = CDSTRING
+ CALL MPI_SEND(CLSTR,LEN(CLSTR),MPI_BYTE,0,ITAG+4,KCOMM,ERROR)
+ CALL CHECK_ERROR("from MPI_SEND(CLSTR)",__FILE__,__LINE__)
+ CALL MPI_SEND(COREIDS,MAXTH,MPI_INTEGER4,0,ITAG+5,KCOMM,ERROR)
+ CALL CHECK_ERROR("from MPI_SEND(COREIDS)",__FILE__,__LINE__)
+ CALL MPI_RECV(IAM_NODEMASTER,1,MPI_INTEGER4,0,ITAG+6,KCOMM,IRECV_STATUS,ERROR)
+ CALL CHECK_ERROR("from MPI_RECV(IAM_NODEMASTER)",__FILE__,__LINE__)
+ ENDIF
+ DEALLOCATE(COREIDS)
+ LLFIRST_TIME = .FALSE.
+ CALL CONDBARR()
+ CALL CHECK_ERROR("from MPI_BARRIER near LLFIRST_TIME=.FALSE.",__FILE__,__LINE__)
+ENDIF
+
+IF (MYPROC == 0 .or. IAM_NODEMASTER == 1) CALL SLASH_PROC
+
+HEAP_SIZE=GETMAXHWM()/ONEMEGA
+TASKSMALL=GETMAXRSS()/ONEMEGA
+
+IF (MYPROC == 0) THEN
+ CALL DATE_AND_TIME(CLDATEOD,CLTIMEOD,CLZONEOD,IVALUES)
+ READ(CLDATEOD(5:6),'(I2)') IMON
+ IF (.not.LLNOCOMM .AND. KCALL /= 1) CALL PRT_DETAIL(KULOUT)
+ IF (.not.LLNOHDR) CALL PRT_HDR(KULOUT)
+ IF(KU == -1) THEN
+ IF (KCALL /= 1) CALL PRT_DETAIL(0)
+ CALL PRT_HDR(0)
+ ENDIF
+
+ ! Note: MYPROC == 0 is always at the RN(0) i.e. at the first NODENUM
+ TOT_ENERGY = ENERGY
+ MAXPOWER = POWER
+ AVGPOWER = POWER
+ CLMAXNODE = NODENAME
+ LASTNODE = NODENAME
+
+ NN = NUMNODES
+ IF (LLNOCOMM) NN=1
+
+ IF (NPROC > 1) THEN
+ ALLOCATE(DONE(1:NPROC-1))
+ DONE(:) = .FALSE.
+ ENDIF
+
+ DO NODENUM=1,NN
+ JID = 0
+ DO II=1,NPROC-1
+ IF (.NOT.DONE(II)) THEN
+ J = II ! Used to be REF(II) -- don't know why ?!
+ IF (RN(J)%NODENUM == NODENUM) THEN
+ I = RN(J)%RANK
+ IF (RN(J)%NODEMASTER == 1) THEN ! Always the first task on particular NODENUM
+ LASTNODE = RN(J)%NODE
+ NRECV = SIZE(RECVBUF)
+ JID = J ! Always >= 1
+ ELSE
+ NRECV = 2
+ ENDIF
+ CALL MPI_RECV(RECVBUF,NRECV,MPI_INTEGER8,I,ITAG+5,KCOMM,IRECV_STATUS,ERROR)
+ CALL CHECK_ERROR("from MPI_RECV(RECVBUF)",__FILE__,__LINE__)
+ IF (NRECV > 2) THEN
+ HEAP_SIZE=RECVBUF(1)
+ TASKSMALL=RECVBUF(2)
+ ENERGY=RECVBUF(3)
+ POWER=RECVBUF(4)
+ NODEHUGE=RECVBUF(5)
+ MEMFREE=RECVBUF(6)
+ CACHED=RECVBUF(7)
+ DO K=0,MAXNUMA-1
+ SMALLPAGE(K) = RECVBUF(7+2*K+1)
+ HUGEPAGE(K) = RECVBUF(7+2*K+2)
+ ENDDO
+ TOT_ENERGY = TOT_ENERGY + ENERGY
+ IF (POWER > MAXPOWER) THEN
+ MAXPOWER = POWER
+ CLMAXNODE = LASTNODE
+ ENDIF
+ AVGPOWER = AVGPOWER + POWER
+ ELSE
+ HEAP_SIZE=HEAP_SIZE+RECVBUF(1)
+ TASKSMALL=TASKSMALL+RECVBUF(2)
+ ENDIF
+ DONE(II) = .TRUE.
+ ENDIF
+ ENDIF
+ ENDDO
+
+ PERCENT_USED(2) = 0
+ IF (NODEHUGE == 0 .or. HEAP_SIZE >= NODEHUGE) THEN
+ ! running with small pages
+ IF (TASKSMALL+NODEHUGE+MEMFREE+CACHED > 0) THEN
+ PERCENT_USED(1) = 100.0*(TASKSMALL+NODEHUGE)/(TASKSMALL+NODEHUGE+MEMFREE+CACHED)
+ ELSE
+ PERCENT_USED(1) = 0
+ ENDIF
+ CSTAR = " Sm/p"
+ ELSE
+ ! running with huge pages
+ PERCENT_USED(1) = 100.0*(HEAP_SIZE+TASKSMALL)/(TASKSMALL+NODEHUGE+MEMFREE+CACHED)
+ NFREE = 0
+ IF (NNUMA > 0) NFREE = SUM(HUGEPAGE(0:NNUMA-1))
+ PERCENT_USED(2) = (100.0*(NODEHUGE - NFREE))/NODEHUGE
+ IF (PERCENT_USED(2) < 0) PERCENT_USED(2) = 0
+ IF (PERCENT_USED(2) > 100) PERCENT_USED(2) = 100
+ CSTAR = " Hg/p"
+ ENDIF
+
+ IF (LLNOCOMM) THEN
+ ID_STRING = CSTAR
+ ELSE IF (KCALL == 0 .AND. JID > 0) THEN
+ ! This should signify the compute & I/O nodes (if they are separate)
+ CLSTR = RN(JID)%STR
+ ID_STRING = CSTAR//":"//TRIM(CLSTR)
+ ELSE
+ ID_STRING = CSTAR//":"//CDSTRING
+ ENDIF
+
+ CALL PRT_DATA(KULOUT)
+ IF (KU == -1) THEN
+ CALL PRT_DATA(0)
+ IF (NODENUM == NN) THEN
+ AVGPOWER = NINT(REAL(AVGPOWER)/REAL(NN))
+ CALL PRT_TOTAL_ENERGIES(0)
+ CALL PRT_TOTAL_ENERGIES(KULOUT)
+ IF (KCALL == 1) THEN
+ CALL DATE_AND_TIME(CLDATEOD,CLTIMEOD,CLZONEOD,IVALUES)
+ READ(CLDATEOD(5:6),'(I2)') IMON
+ CALL PRT_DETAIL(0)
+ CALL PRT_DETAIL(KULOUT)
+ ENDIF
+ CALL PRT_EMPTY(KULOUT,1)
+ CLOSE(KULOUT)
+ ENDIF
+ ENDIF
+ ENDDO ! DO NODENUM=1,NN
+ IF (ALLOCATED(DONE)) DEALLOCATE(DONE)
+ELSE
+ SENDBUF(1)=HEAP_SIZE
+ SENDBUF(2)=TASKSMALL
+ IF (IAM_NODEMASTER == 1) THEN
+ SENDBUF(3)=ENERGY
+ SENDBUF(4)=POWER
+ SENDBUF(5)=NODEHUGE
+ SENDBUF(6)=MEMFREE
+ SENDBUF(7)=CACHED
+ DO K=0,MAXNUMA-1
+ SENDBUF(7+2*K+1)=SMALLPAGE(K)
+ SENDBUF(7+2*K+2)=HUGEPAGE(K)
+ ENDDO
+ NSEND = SIZE(SENDBUF)
+ ELSE
+ NSEND = 2
+ ENDIF
+ CALL MPI_SEND(SENDBUF,NSEND,MPI_INTEGER8,0,ITAG+5,KCOMM,ERROR)
+ CALL CHECK_ERROR("from MPI_SEND(SENDBUF)",__FILE__,__LINE__)
+ENDIF
+
+IF (.not.LLNOCOMM) THEN
+ CALL CONDBARR()
+ CALL CHECK_ERROR("from MPI_BARRIER(at end)",__FILE__,__LINE__)
+ENDIF
+
+CONTAINS
+
+SUBROUTINE SLASH_PROC
+ IMPLICIT NONE
+ CALL EC_PMON(ENERGY,POWER)
+
+ N18 = 0 ! number of buddy columns (up to MAXCOLS)
+ NNUMA = 0 ! number of NUMA-nodes (up to MAXNUMA)
+
+ OPEN(FILE="/proc/buddyinfo",UNIT=502,STATUS="old",ACTION="read",ERR=97)
+
+ READ(502,'(a)',END=99) LINE
+ READ(502,'(a)',END=99) LINE
+ READ(502,'(a)',END=99) LINE
+ NODE(:,0)=-1
+ READ(LINE(22:),*,END=98) NODE(:,0)
+98 CONTINUE
+ N18 = COUNT(NODE(:,0) >= 0)
+ NNUMA = 1
+ DO K=1,MAXNUMA-1
+ NODE(:,K)=0
+ READ(502,'(a)',END=99) LINE
+ READ(LINE(22:),*) NODE(0:N18-1,K)
+ NNUMA = NNUMA + 1
+ ENDDO
+
+99 CONTINUE
+ CLOSE(502)
+97 CONTINUE
+
+ SMALLPAGE(:) = 0
+ HUGEPAGE(:) = 0
+ DO K=0,NNUMA-1
+ BUCKET(:,K) = 0
+ DO J=0,N18-1
+ BUCKET(J,K) = 4096_JPIB * NODE(J,K) * (2_JPIB ** J)
+ ENDDO
+ SMALLPAGE(K) = SUM(BUCKET(0:8,K))/ONEMEGA
+ HUGEPAGE(K) = SUM(BUCKET(9:N18-1,K))/ONEMEGA
+ ENDDO
+
+ MEMFREE = 0
+ CACHED = 0
+
+ INQUIRE(FILE="/proc/meminfo", EXIST=FILE_EXISTS)
+ IF( FILE_EXISTS ) THEN
+ OPEN(FILE="/proc/meminfo",UNIT=502,STATUS="old",ACTION="read",ERR=977)
+ DO I=1,10
+ READ(502,'(a)',ERR=988,END=988) LINE
+ IF(LINE(1:7) == "MemFree") THEN
+ READ(LINE(9:80),*) MEMFREE
+ ELSEIF(LINE(1:6) == "Cached") THEN
+ READ(LINE(8:80),*) CACHED
+ ENDIF
+ ENDDO
+988 continue
+ CLOSE(502)
+977 continue
+
+ MEMFREE=MEMFREE/1024
+ CACHED=CACHED/1024
+ ENDIF
+
+END SUBROUTINE SLASH_PROC
+
+SUBROUTINE PRT_EMPTY(KUN,KOUNT)
+IMPLICIT NONE
+INTEGER(KIND=JPIM), INTENT(IN) :: KUN,KOUNT
+INTEGER(KIND=JPIM) :: JJ
+DO JJ=1,KOUNT
+ WRITE(KUN,'(a)') CLPFX(1:IPFXLEN)//"## EC_MEMINFO "
+ENDDO
+END SUBROUTINE PRT_EMPTY
+
+FUNCTION KWH(JOULES)
+IMPLICIT NONE
+INTEGER(KIND=JPIB), INTENT(IN) :: JOULES
+REAL(KIND=JPRD) KWH
+KWH = REAL(JOULES,JPRD) / 3600000.0_JPRD
+END FUNCTION KWH
+
+SUBROUTINE PRT_TOTAL_ENERGIES(KUN)
+IMPLICIT NONE
+INTEGER(KIND=JPIM), INTENT(IN) :: KUN
+IF (KCALL == 1) THEN ! last call
+ WT = UTIL_WALLTIME() - WT0
+ CALL PRT_EMPTY(KUN,2)
+ WRITE(KUN,'(a,a,f12.3,a,i0,a)') CLPFX(1:IPFXLEN)//"## EC_MEMINFO ",&
+ & " Total energy consumed : ",KWH(TOT_ENERGY), " kWh (",TOT_ENERGY," J)"
+!-- Peak power below is misleading since based on values at sample points
+! WRITE(KUN,'(a,a,i0,a)') CLPFX(1:IPFXLEN)//"## EC_MEMINFO ",&
+! & " Peak power : ",MAXPOWER," W (node "//trim(CLMAXNODE)//")"
+!-- Avg power must be calculated based on total Joules divided by wall time and num nodes
+ AVGPOWER = TOT_ENERGY / WT / NUMNODES
+ WRITE(KUN,'(a,a,i0,a,i0,a)') CLPFX(1:IPFXLEN)//"## EC_MEMINFO ",&
+ & " Avg. power / node : ",AVGPOWER," W across ",NUMNODES," nodes"
+ CALL PRT_EMPTY(KUN,1)
+ENDIF
+END SUBROUTINE PRT_TOTAL_ENERGIES
+
+SUBROUTINE PRT_DETAIL(KUN)
+IMPLICIT NONE
+INTEGER(KIND=JPIM), INTENT(IN) :: KUN
+CHARACTER(LEN=128) :: JOBNAME
+CHARACTER(LEN=128) :: JOBID
+CALL GET_ENVIRONMENT_VARIABLE('EC_JOB_NAME',JOBNAME)
+IF (JOBNAME == '') CALL GET_ENVIRONMENT_VARIABLE('PBS_JOBNAME',JOBNAME)
+IF (JOBNAME == '') CALL GET_ENVIRONMENT_VARIABLE('SLURM_JOB_NAME',JOBNAME)
+IF (JOBNAME == '') CALL GET_ENVIRONMENT_VARIABLE('EC_MEMINFO_JOBNAME',JOBNAME)
+CALL GET_ENVIRONMENT_VARIABLE('PBS_JOBID',JOBID)
+IF (JOBID == '') CALL GET_ENVIRONMENT_VARIABLE('SLURM_JOB_ID',JOBID)
+IF (JOBID == '') CALL GET_ENVIRONMENT_VARIABLE('EC_MEMINFO_JOBID',JOBID)
+CALL PRT_EMPTY(KUN,1)
+WT = UTIL_WALLTIME() - WT0
+WRITE(KUN,'(4a,f10.3,a)') CLPFX(1:IPFXLEN)//"## EC_MEMINFO Detailed memory information ", &
+ "for program ",TRIM(PROGRAM)," -- wall-time : ",WT,"s"
+WRITE(KUN,'(a,i0,a,i0,a,i0,a,i0,a,i0,a,i0,a,a,":",a,":",a,a,a,"-",a,"-",a)') &
+ CLPFX(1:IPFXLEN)//"## EC_MEMINFO Running on ",NUMNODES," nodes (",NNUMA,&
+ "-numa) with ",NPROC-IOTASKS, &
+ " compute + ",IOTASKS," I/O-tasks and ", MAXTH_COMP, "+", MAXTH_IO, " threads at ", &
+ CLTIMEOD(1:2),CLTIMEOD(3:4),CLTIMEOD(5:10), &
+ " on ",CLDATEOD(7:8),CLMON(IMON),CLDATEOD(1:4)
+WRITE(KUN,'(4a)') CLPFX(1:IPFXLEN)//"## EC_MEMINFO The Job Name is ",TRIM(JOBNAME), &
+ " and the Job ID is ",TRIM(JOBID)
+CALL PRT_EMPTY(KUN,1)
+END SUBROUTINE PRT_DETAIL
+
+SUBROUTINE PRT_HDR(KUN)
+IMPLICIT NONE
+INTEGER(KIND=JPIM), INTENT(IN) :: KUN
+INTEGER(KIND=JPIM) :: INUMA, ILEN
+CHARACTER(LEN=4096) :: CLBUF
+INUMA = NNUMA
+
+ILEN = 0
+WRITE(CLBUF(ILEN+1:),'(A)') &
+ CLPFX(1:IPFXLEN)//"## EC_MEMINFO | TC | MEMORY USED(MB) "
+ILEN = LEN_TRIM(CLBUF)
+DO K=0,INUMA-1
+ IF (K == 0) THEN
+ WRITE(CLBUF(ILEN+1:),'(A)') " | MEMORY FREE(MB)"
+ ILEN = LEN_TRIM(CLBUF)
+ ELSE
+ WRITE(CLBUF(ILEN+1:),'(A)') " ------------- "
+ ILEN = LEN_TRIM(CLBUF) + 2
+ ENDIF
+ENDDO
+IF (NNUMA > 0) THEN
+ WRITE(CLBUF(ILEN+1:),'(A)') " INCLUDING CACHED| %USED %HUGE | Energy Power"
+ELSE
+ WRITE(CLBUF(ILEN+1:),'(A)') " MEMORY FREE(MB) | %USED %HUGE | Energy Power"
+ENDIF
+WRITE(KUN,'(A)') TRIM(CLBUF)
+
+ILEN=0
+WRITE(CLBUF(ILEN+1:),'(A)') &
+ CLPFX(1:IPFXLEN)//"## EC_MEMINFO | Malloc| Inc Heap |"
+ILEN = LEN_TRIM(CLBUF)
+DO K=0,INUMA-1
+ WRITE(CLBUF(ILEN+1:),'(A,I2,A)') " Numa region ",K," |"
+ ILEN = LEN_TRIM(CLBUF)
+ENDDO
+WRITE(CLBUF(ILEN+1:),'(A)') " | | (J) (W)"
+WRITE(KUN,'(A)') TRIM(CLBUF)
+
+ILEN=0
+WRITE(CLBUF(ILEN+1:),'(A)') &
+ CLPFX(1:IPFXLEN)//"## EC_MEMINFO Node Name | Heap | RSS("//zum//") |"
+ILEN = LEN_TRIM(CLBUF)
+DO K=0,INUMA-1
+ WRITE(CLBUF(ILEN+1:),'(A)') " Small Huge or |"
+ ILEN = LEN_TRIM(CLBUF)
+ENDDO
+WRITE(CLBUF(ILEN+1:),'(A)') " Total |"
+WRITE(KUN,'(A)') TRIM(CLBUF)
+
+ILEN=0
+WRITE(CLBUF(ILEN+1:),'(A)') &
+ CLPFX(1:IPFXLEN)//"## EC_MEMINFO | (sum) | Small Huge |"
+ILEN = LEN_TRIM(CLBUF)
+DO K=0,INUMA-1
+ WRITE(CLBUF(ILEN+1:),'(A)') " Only Small |"
+ ILEN = LEN_TRIM(CLBUF)
+ENDDO
+WRITE(CLBUF(ILEN+1:),'(A)') " Memfree+Cached |"
+WRITE(KUN,'(A)') TRIM(CLBUF)
+END SUBROUTINE PRT_HDR
+
+SUBROUTINE PRT_DATA(KUN)
+IMPLICIT NONE
+INTEGER(KIND=JPIM), INTENT(IN) :: KUN
+INTEGER(KIND=JPIM) :: INUMA,ILEN
+CHARACTER(LEN=4096) :: CLBUF
+INUMA = NNUMA
+
+ILEN=0
+WRITE(CLBUF(ILEN+1:),'(a,i4,1x,a,3i8,1x)') &
+ CLPFX(1:IPFXLEN)//"## EC_MEMINFO ", &
+ NODENUM-1,LASTNODE,HEAP_SIZE,TASKSMALL,NODEHUGE
+ILEN = LEN_TRIM(CLBUF) + 1
+DO K=0,INUMA-1
+ WRITE(CLBUF(ILEN+1:),'(1x,2i8)') SMALLPAGE(K),HUGEPAGE(K)
+ ILEN = LEN_TRIM(CLBUF)
+ENDDO
+WRITE(CLBUF(ILEN+1:),'(2x,2i8,3x,2f6.1,1x,i9,1x,i6,1x,a)') &
+ MEMFREE,CACHED, &
+ PERCENT_USED,&
+ ENERGY,POWER,&
+ trim(ID_STRING)
+WRITE(KUN,'(A)') TRIM(CLBUF)
+END SUBROUTINE PRT_DATA
+
+SUBROUTINE CONDBARR()
+IF (NPROC > 1 .and. KBARR /= 0) THEN
+ CALL MPI_BARRIER(KCOMM,ERROR)
+ELSE
+ ERROR = 0
+ENDIF
+END SUBROUTINE CONDBARR
+
+SUBROUTINE CHECK_ERROR(CLWHAT,SRCFILE,SRCLINE)
+IMPLICIT NONE
+CHARACTER(LEN=*), INTENT(IN) :: CLWHAT, SRCFILE
+INTEGER(KIND=JPIM), INTENT(IN) :: SRCLINE
+IF (ERROR /= 0) THEN
+ WRITE(0,'(A,I0,1X,A,1X,"(",A,":",I0,")")') &
+ & CLPFX(1:IPFXLEN)//"## EC_MEMINFO error code =",ERROR,CLWHAT,SRCFILE,SRCLINE
+ CALL MPI_ABORT(KCOMM,-1,ERROR)
+ENDIF
+ERROR = 0
+END SUBROUTINE CHECK_ERROR
+
+SUBROUTINE RNSORT(KUN)
+IMPLICIT NONE
+INTEGER(KIND=JPIM), INTENT(IN) :: KUN
+INTEGER(KIND=JPIM) :: ILEN
+CHARACTER(LEN=1) :: CLAST
+CHARACTER(LEN=4) :: CLMASTER
+CHARACTER(LEN=4096) :: CLBUF
+INTEGER(KIND=JPIM) :: impi_vers, impi_subvers, ilibrary_version_len
+INTEGER(KIND=JPIM) :: iomp_vers, iomp_subvers, iopenmp
+CHARACTER(LEN=4096) :: clibrary_version
+LOGICAL :: LLDONE(0:NPROC-1)
+INTEGER(KIND=JPIM) :: REF(0:NPROC-1) ! Keep list of the order tasks been added
+LLDONE(:) = .FALSE.
+IOTASKS = 0
+K = 0
+NODENUM = 0
+DO I=0,NPROC-1
+ IF (RN(I)%NODENUM == -1) THEN
+ IF (RN(I)%IORANK == 1) THEN
+ IOTASKS = IOTASKS + 1
+ RN(I)%IORANK = IOTASKS
+ ELSE
+ RN(I)%IORANK = 0
+ ENDIF
+ NODENUM = NODENUM + 1
+ RN(I)%NODENUM = NODENUM
+ RN(I)%NODEMASTER = 1
+ LLDONE(I) = .TRUE.
+ ! NB: Adjacent REF-elements allow us to operate with particular node's tasks that follow their the node-master
+ REF(K) = I
+ K = K + 1
+ LASTNODE = RN(I)%NODE
+! DO J=I+1,NPROC-1 ! not valid anymore since ranks might have been reordered -- need to run through the whole list -- LLNODE speeds up
+ DO J=0,NPROC-1
+ IF (.NOT.LLDONE(J)) THEN
+ IF (RN(J)%NODENUM == -1) THEN
+ IF (RN(J)%NODE == LASTNODE) THEN
+ RN(J)%NODENUM = NODENUM
+ IF (RN(J)%IORANK == 1) THEN
+ IOTASKS = IOTASKS + 1
+ RN(J)%IORANK = IOTASKS
+ ELSE
+ RN(J)%IORANK = 0
+ ENDIF
+ RN(J)%NODEMASTER = 0
+ LLDONE(J) = .TRUE.
+ REF(K) = J
+ K = K + 1
+ ENDIF
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+ENDDO
+NUMNODES = NODENUM
+CALL ecmpi_version(impi_vers, impi_subvers, clibrary_version, ilibrary_version_len)
+call ecomp_version(iomp_vers, iomp_subvers, iopenmp)
+CALL PRT_EMPTY(KUN,1)
+WRITE(KUN,'(a,i0,".",i0)') &
+ & CLPFX(1:IPFXLEN)//&
+ & "## EC_MEMINFO : MPI-version ",impi_vers, impi_subvers
+WRITE(KUN,'(a)') &
+ & CLPFX(1:IPFXLEN)//&
+ & "## EC_MEMINFO : Start of MPI-library version"
+WRITE(KUN,'(a)') trim(clibrary_version) ! This is could be a multiline, very long string
+WRITE(KUN,'(a)') &
+ & CLPFX(1:IPFXLEN)//&
+ & "## EC_MEMINFO : End of MPI-library version"
+WRITE(KUN,'(a,i0,".",i0,".",i6.6)') &
+ & CLPFX(1:IPFXLEN)//&
+ & "## EC_MEMINFO : OpenMP-version ",iomp_vers, iomp_subvers, iopenmp
+CALL PRT_EMPTY(KUN,2)
+WRITE(KUN,1003) &
+ & CLPFX(1:IPFXLEN)//&
+ &"## EC_MEMINFO ********************************************************************************",&
+ & CLPFX(1:IPFXLEN)//&
+ &"## EC_MEMINFO *** Mapping of MPI & I/O-tasks to nodes and tasks' thread-to-core affinities ***", &
+ & CLPFX(1:IPFXLEN)//&
+ &"## EC_MEMINFO ********************************************************************************"
+1003 FORMAT((A))
+CALL PRT_EMPTY(KUN,1)
+WRITE(KUN,'(a,i0,a,i0,a,i0,a,i0,a,i0,a,i0,a)') &
+ & CLPFX(1:IPFXLEN)//"## EC_MEMINFO Running on ",NUMNODES," nodes (",NNUMA,&
+ & "-numa) with ",NPROC-IOTASKS, &
+ & " compute + ",IOTASKS," I/O-tasks and ", MAXTH_COMP, "+", MAXTH_IO, " threads"
+CALL PRT_EMPTY(KUN,1)
+WRITE(KUN,1000) CLPFX(1:IPFXLEN)//"## EC_MEMINFO ",&
+ & "#","NODE#","NODENAME","MPI#","WORLD#","I/O#","MASTER","REF#","OMP#","Core affinities"
+WRITE(KUN,1000) CLPFX(1:IPFXLEN)//"## EC_MEMINFO ",&
+ & "=","=====","========","====","======","====","======","====","====","==============="
+1000 FORMAT(A,2(1X,A5),1X,A20,6(1X,A6),2X,A)
+CALL PRT_EMPTY(KUN,1)
+DO K=0,NPROC-1 ! Loop over the task as they have been added (see few lines earlier how REF(K) has been getting its values I or J)
+ ILEN = 0
+ ! A formidable trick ? No need for a nested loop over 0:NPROC-1 to keep tasks within the same node together in the output
+ I = REF(K)
+ NUMTH = RN(I)%NUMTH
+ CLMASTER = '[No]'
+ IF (RN(I)%NODEMASTER == 1) CLMASTER = ' Yes'
+ IF (RN(I)%IORANK > 0) THEN
+ WRITE(CLBUF(ILEN+1:),1001) &
+ & CLPFX(1:IPFXLEN)//"## EC_MEMINFO ",&
+ & K,RN(I)%NODENUM-1,TRIM(ADJUSTL(RN(I)%NODE)),RN(I)%RANK,RN(I)%RANK_WORLD,RN(I)%IORANK-1,&
+ & CLMASTER,I,NUMTH,"{"
+1001 FORMAT(A,2(1X,I5),1X,A20,3(1X,I6),1X,A6,2(1X,I6),2X,A)
+ ELSE
+ WRITE(CLBUF(ILEN+1:),1002) &
+ & CLPFX(1:IPFXLEN)//"## EC_MEMINFO ",&
+ & K,RN(I)%NODENUM-1,TRIM(ADJUSTL(RN(I)%NODE)),RN(I)%RANK,RN(I)%RANK_WORLD,"[No]",&
+ & CLMASTER,I,NUMTH,"{"
+1002 FORMAT(A,2(1X,I5),1X,A20,2(1X,I6),2(1X,A6),2(1X,I6),2X,A)
+ ENDIF
+ ILEN = LEN_TRIM(CLBUF)
+ CLAST = ','
+ DO J=0,NUMTH-1
+ IF (J == NUMTH-1) CLAST = '}'
+ WRITE(CLBUF(ILEN+1:),'(I0,A1)') RN(I)%COREIDS(J),CLAST
+ ILEN = LEN_TRIM(CLBUF)
+ ENDDO
+ WRITE(KUN,'(A,1X)') TRIM(CLBUF)
+ENDDO
+CALL PRT_EMPTY(KUN,1)
+CALL FLUSH(KUN)
+END SUBROUTINE RNSORT
+
+END SUBROUTINE EC_MEMINFO
+
+END MODULE EC_MEMINFO_MOD
+
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/ec_mmpi_finalize_mnh_mod.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/ec_mmpi_finalize_mnh_mod.F90
new file mode 100644
index 0000000000000000000000000000000000000000..cabdf80c9ea53134a797d2cd60b2cb9f758d2856
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/ec_mmpi_finalize_mnh_mod.F90
@@ -0,0 +1,149 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+MODULE EC_MPI_FINALIZE_MOD
+
+CONTAINS
+
+SUBROUTINE MEMINFO(KOUT,KSTEP)
+USE PARKIND1, ONLY : JPIM, JPIB
+USE EC_MEMINFO_MOD
+
+IMPLICIT NONE
+INTEGER(KIND=JPIM), INTENT(IN) :: KOUT, KSTEP
+CHARACTER(LEN=32) CLSTEP
+CHARACTER(LEN=160) :: LINE
+CHARACTER(LEN=20) :: NODENAME
+INTEGER(KIND=JPIB) :: NODE(0:17), ISMALL, IHUGE, ITOTAL
+INTEGER(KIND=JPIM) :: I,INUMA,ICOMM
+!#include "ec_meminfo.intfb.h"
+WRITE(CLSTEP,'(11X,"STEP",I5," :")') KSTEP
+ICOMM = -2 ! No headers from EC_MEMINFO by default
+IF (KSTEP == 0) ICOMM = -1 ! Do print headers, too
+CALL EC_MEMINFO(KOUT,TRIM(CLSTEP),ICOMM,KBARR=0,KIOTASK=-1,KCALL=-1)
+CALL FLUSH(KOUT)
+RETURN ! For now
+#if 0
+CALL EC_GETHOSTNAME(NODENAME) ! from support/env.c
+OPEN(FILE="/proc/buddyinfo",UNIT=502,ERR=98,STATUS="old",ACTION="read")
+READ(502,'(a)',END=99) LINE
+READ(502,'(a)',END=99) LINE
+DO INUMA=0,1
+ NODE(:)=0
+ READ(502,'(a)',END=99) LINE
+ READ(LINE(22:160),*,ERR=99,END=99) NODE
+ ISMALL = 0
+ DO I=0,8
+ ISMALL = ISMALL + NODE(I) * (2**I)
+ ENDDO
+ ! Pages >= 2M
+ IHUGE = 0
+ DO I=9,SIZE(NODE)-1
+ IHUGE = IHUGE + NODE(I) * (2**I)
+ ENDDO
+ ITOTAL = ISMALL + IHUGE
+ ISMALL = (ISMALL * 4096)/ONEMEGA
+ IHUGE = (IHUGE * 4096)/ONEMEGA
+ ITOTAL = (ITOTAL * 4096)/ONEMEGA
+ WRITE(KOUT,'(" MEMINFO: STEP=",I0," ",A," NUMA# ",I0," : Free Total = SMALL + HUGEPAGES in MB: ",I0," = ",I0," + ",I0)') &
+ & KSTEP, NODENAME, INUMA, ITOTAL, ISMALL, IHUGE
+ WRITE(KOUT,'(" BUDDYINFO: STEP=",I0," ",A," NUMA# ",I0," : Count of free 2^(0..",I0,")*4096B blocks: ",A)') &
+ & KSTEP, NODENAME, INUMA, SIZE(NODE)-1, LINE(22:160)
+ENDDO
+99 CONTINUE
+CLOSE(502)
+98 CONTINUE
+CALL FLUSH(KOUT)
+#endif
+END SUBROUTINE MEMINFO
+
+SUBROUTINE EC_MPI_FINALIZE(KERROR,LDCALLFINITO,LDMEMINFO,CALLER)
+USE PARKIND1, ONLY : JPIM
+USE MPL_MPIF
+USE EC_MEMINFO_MOD
+
+IMPLICIT NONE
+INTEGER(KIND=JPIM), INTENT(OUT) :: KERROR
+LOGICAL, INTENT(IN) :: LDCALLFINITO
+LOGICAL, INTENT(IN) :: LDMEMINFO
+CHARACTER(LEN=*), INTENT(IN) :: CALLER
+LOGICAL :: LLINIT, LLFIN, LLNOTMPIWORLD
+INTEGER(KIND=JPIM) :: IERR, ICOMM
+INTEGER(KIND=JPIM) :: NCOMM_MEMINFO
+COMMON /cmn_meminfo/ NCOMM_MEMINFO
+!#include "ec_meminfo.intfb.h"
+KERROR = 0
+IF (LDCALLFINITO) THEN !*** common MPI_Finalize()
+ CALL MPI_INITIALIZED(LLINIT,IERR)
+ IF (LLINIT .AND. IERR == 0) THEN
+ CALL MPI_FINALIZED(LLFIN,IERR)
+ IF (.NOT.LLFIN .AND. IERR == 0) THEN
+ LLNOTMPIWORLD = (NCOMM_MEMINFO /= 0 .and. NCOMM_MEMINFO /= MPI_COMM_WORLD)
+ IF (LLNOTMPIWORLD) THEN
+ ICOMM = NCOMM_MEMINFO
+ ELSE
+ ICOMM = MPI_COMM_WORLD
+ ENDIF
+ IF( LDMEMINFO ) CALL EC_MEMINFO(-1,"ec_mpi_finalize:"//caller,ICOMM,KBARR=1,KIOTASK=-1,KCALL=1)
+ CALL c_drhook_prof() ! ifsaux/support/drhook.c : Make sure DrHook output is produced before MPI_Finalize (in case it fails)
+ CALL MPI_BARRIER(ICOMM,IERR)
+ IF (LLNOTMPIWORLD) THEN
+ ! CALL MPI_COMM_FREE(NCOMM_MEMINFO,IERR)
+ NCOMM_MEMINFO = 0
+ ENDIF
+ CALL MPI_FINALIZE(KERROR)
+ ENDIF
+ ENDIF
+ENDIF
+END SUBROUTINE EC_MPI_FINALIZE
+
+SUBROUTINE EC_PMON(ENERGY,POWER)
+USE PARKIND1, ONLY : JPIM, JPIB
+IMPLICIT NONE
+INTEGER(KIND=JPIB),INTENT(OUT) :: ENERGY,POWER
+INTEGER(KIND=JPIB),SAVE :: ENERGY_START = 0
+INTEGER(KIND=JPIM),SAVE :: MONINIT = 0
+INTEGER(KIND=JPIM) :: ISTAT
+CHARACTER(LEN=1) :: CLEC_PMON
+ENERGY = 0
+IF (MONINIT >= 0) THEN
+ IF (MONINIT == 0) THEN ! The very first time only
+ CALL GET_ENVIRONMENT_VARIABLE('EC_PMON',CLEC_PMON)
+ IF (CLEC_PMON == '0') MONINIT = -2 ! Never try again
+ ENDIF
+ IF (MONINIT >= 0) THEN
+ OPEN(503,FILE='/sys/cray/pm_counters/energy',IOSTAT=ISTAT,STATUS='old',ACTION='read')
+ IF (ISTAT == 0) THEN
+ READ(503,*,IOSTAT=ISTAT) ENERGY
+ CLOSE(503)
+ IF (ISTAT == 0) THEN
+ IF (MONINIT == 0) THEN
+ ENERGY_START = ENERGY
+ MONINIT = 1 ! Ok
+ ENDIF
+ ENERGY = ENERGY - ENERGY_START
+ ENDIF
+ ENDIF
+ IF (ISTAT /= 0) THEN
+ MONINIT = -1 ! Never try again
+ ENERGY = 0
+ ENDIF
+ ENDIF
+ENDIF
+POWER = 0
+IF (MONINIT > 0) THEN
+ OPEN(504,FILE='/sys/cray/pm_counters/power',IOSTAT=ISTAT,STATUS='old',ACTION='read')
+ IF (ISTAT == 0) THEN
+ READ(504,*,IOSTAT=ISTAT) POWER
+ CLOSE(504)
+ ENDIF
+ IF (ISTAT /= 0) POWER = 0
+ENDIF
+END SUBROUTINE EC_PMON
+
+END MODULE EC_MPI_FINALIZE_MOD
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/get_proc_id.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/get_proc_id.F90
new file mode 100644
index 0000000000000000000000000000000000000000..8549036011f3e52e474acef26ad8141c098d4ff2
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/get_proc_id.F90
@@ -0,0 +1,19 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+FUNCTION GET_PROC_ID() RESULT(PID)
+
+USE PARKIND1 ,ONLY : JPIM
+!USE MPL_MODULE, ONLY : MPL_RANK
+USE MPL_INIT_MOD
+IMPLICIT NONE
+INTEGER(KIND=JPIM) :: PID
+PID = MPL_RANK
+
+END FUNCTION GET_PROC_ID
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/getheapstat.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/getheapstat.F90
new file mode 100644
index 0000000000000000000000000000000000000000..2b2cf8357ef8b130f566c0c252f26ff52bc5d7a7
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/getheapstat.F90
@@ -0,0 +1,97 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+SUBROUTINE GETHEAPSTAT(KOUT, CDLABEL)
+
+USE PARKIND1 ,ONLY : JPIM ,JPRB ,JPIB
+
+!USE MPL_MODULE
+USE MPL_MYRANK_MOD
+USE MPL_NPROC_MOD
+USE MPL_GATHERV_MOD
+
+#ifdef NAG
+USE F90_UNIX_ENV, ONLY: GETENV
+#endif
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM), INTENT(IN) :: KOUT
+CHARACTER(LEN=*), INTENT(IN) :: CDLABEL
+INTEGER(KIND=JPIM) :: I, IMYPROC, INPROC, IRET, IOFFSET, II
+INTEGER(KIND=JPIM), PARAMETER :: JP_NPROFILE = 9 ! pls. consult ifsaux/utilities/getcurheap.c
+INTEGER(KIND=JPIM), PARAMETER :: ISIZE = JP_NPROFILE+1
+INTEGER(KIND=JPIB) ILIMIT(ISIZE)
+INTEGER(KIND=JPIB) ICNT(ISIZE)
+REAL(KIND=JPRB), ALLOCATABLE :: ZSEND(:), ZRECV(:)
+INTEGER(KIND=JPIM), ALLOCATABLE :: ICOUNTS(:)
+CHARACTER(LEN=1) CLENV
+CHARACTER(LEN=80) CLTEXT(0:4)
+
+CALL GET_ENVIRONMENT_VARIABLE("EC_PROFILE_HEAP", CLENV) ! turn OFF by export EC_PROFILE_HEAP=0
+
+IF (KOUT >= 0 .AND. CLENV /= '0') THEN
+ IMYPROC = MPL_MYRANK()
+ INPROC = MPL_NPROC()
+
+ DO I=1,ISIZE
+ ILIMIT(I) = I ! power of 10's ; pls. consult ifsaux/utilities/getcurheap.c
+ ENDDO
+
+ ALLOCATE(ZSEND(ISIZE))
+ ALLOCATE(ZRECV(ISIZE * INPROC))
+ ALLOCATE(ICOUNTS(INPROC))
+
+ CLTEXT(0) = "free()/DEALLOCATE -hits per byte range"
+ CLTEXT(1) = "malloc()/ALLOCATE -hits per byte range"
+ CLTEXT(2) = "Outstanding malloc()/ALLOCATE -hits per byte range"
+ CLTEXT(3) = "Outstanding amount of malloc()/ALLOCATE -bytes per byte range"
+ CLTEXT(4) = "Average amount of outstanding malloc()/ALLOCATE -bytes per byte range"
+
+ DO II=0,4
+ ICNT(:) = 0
+ CALL PROFILE_HEAP_GET(ICNT, ISIZE, II, IRET)
+
+ ZSEND(:) = 0
+ DO I=1,IRET
+ ZSEND(I) = ICNT(I)
+ ENDDO
+ ZRECV(:) = -1
+
+ ICOUNTS(:) = ISIZE
+ CALL MPL_GATHERV(ZSEND(:), KROOT=1, KRECVCOUNTS=ICOUNTS(:), &
+ &PRECVBUF=ZRECV, CDSTRING='GETHEAPSTAT:')
+
+ IF (IMYPROC == 1) THEN
+! Not more than 132 columns, please :-)
+ WRITE(KOUT,9000) TRIM(CLTEXT(II)),TRIM(CDLABEL), "Node", &
+ & (ILIMIT(I),I=1,MIN(JP_NPROFILE,9)), "Larger"
+9000 FORMAT(/,"Heap Utilization Profile (",A,"): ",A,&
+ &/,126("="),&
+ &//,(A4,2X,9(:,2X,4X,"< 10^",I1),:,2X,A10))
+ WRITE(KOUT,9001)
+9001 FORMAT(4("="),2X,10(2X,10("="))/)
+ IOFFSET = 0
+ DO I=1,INPROC
+ ICNT(:) = ZRECV(IOFFSET+1:IOFFSET+ISIZE)
+ WRITE(KOUT,'(i4,2x,(10(:,2x,i10)))') I,ICNT(:)
+ IOFFSET = IOFFSET + ISIZE
+ ENDDO
+ ENDIF
+ ENDDO
+
+ IF (IMYPROC == 1) THEN
+ WRITE(KOUT,'(/,a,/)') 'End of Heap Utilization Profile'
+ ENDIF
+
+ DEALLOCATE(ZSEND)
+ DEALLOCATE(ZRECV)
+ DEALLOCATE(ICOUNTS)
+ENDIF
+END SUBROUTINE GETHEAPSTAT
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/getmemstat.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/getmemstat.F90
new file mode 100644
index 0000000000000000000000000000000000000000..c866925d7e3f3a27aeac4e8adc6ecfee23123167
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/getmemstat.F90
@@ -0,0 +1,75 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+SUBROUTINE GETMEMSTAT(KOUT, CDLABEL)
+
+USE PARKIND1 ,ONLY : JPIM ,JPRB ,JPIB
+
+! USE MPL_MODULE
+USE MPL_MYRANK_MOD
+USE MPL_NPROC_MOD
+USE MPL_GATHERV_MOD
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM), INTENT(IN) :: KOUT
+CHARACTER(LEN=*), INTENT(IN) :: CDLABEL
+INTEGER(KIND=JPIM) :: I, IMYPROC, INPROC, IOFFSET
+INTEGER(KIND=JPIM), PARAMETER :: JP_MEMKEYS = 5 ! pls. consult ifsaux/utilities/getmemvals.F90
+INTEGER(KIND=JPIM) IMEMKEYS(JP_MEMKEYS)
+INTEGER(KIND=JPIB) IMEMVALS(JP_MEMKEYS)
+REAL(KIND=JPRB), ALLOCATABLE :: ZSEND(:), ZRECV(:)
+INTEGER(KIND=JPIM), ALLOCATABLE :: ICOUNTS(:)
+CHARACTER(LEN=1) CLENV
+
+CALL GET_ENVIRONMENT_VARIABLE("EC_PROFILE_MEM", CLENV) ! turn OFF by export EC_PROFILE_MEM=0
+
+IF (KOUT >= 0 .AND. CLENV /= '0') THEN
+ IMYPROC = MPL_MYRANK()
+ INPROC = MPL_NPROC()
+
+ ALLOCATE(ZSEND(JP_MEMKEYS))
+ ALLOCATE(ZRECV(JP_MEMKEYS * INPROC))
+ ALLOCATE(ICOUNTS(INPROC))
+
+! 1=MAXHEAP, 2=MAXRSS, 3=CURRENTHEAP, 5=MAXSTACK, 6=PAGING
+ IMEMKEYS(:) = (/1, 2, 3, 5, 6/)
+ CALL GETMEMVALS(JP_MEMKEYS, IMEMKEYS, IMEMVALS)
+
+ ZSEND(:) = 0
+ DO I=1,JP_MEMKEYS
+ ZSEND(I) = IMEMVALS(I)
+ ENDDO
+ ZRECV(:) = -1
+
+ ICOUNTS(:) = JP_MEMKEYS
+ CALL MPL_GATHERV(ZSEND(:), KROOT=1, KRECVCOUNTS=ICOUNTS(:), &
+ &PRECVBUF=ZRECV, CDSTRING='GETMEMSTAT:')
+
+ IF (IMYPROC == 1) THEN
+ WRITE(KOUT,9000) TRIM(CDLABEL)
+9000 FORMAT(/,"Memory Utilization Information (in bytes) : ",a,/,79("="),//,&
+ & "Node Max heapsize Max resident Current heap Max stack I/O-paging #",/,&
+ & "==== ============ ============ ============ ============ ============",//)
+ IOFFSET = 0
+ DO I=1,INPROC
+ IMEMVALS(:) = ZRECV(IOFFSET+1:IOFFSET+JP_MEMKEYS)
+ WRITE(KOUT,'(I4,5(3X,I12))') I,IMEMVALS(:)
+ IOFFSET = IOFFSET + JP_MEMKEYS
+ ENDDO
+ WRITE(KOUT,'(/,a,/)') 'End of Memory Utilization Information'
+ ENDIF
+
+ DEALLOCATE(ZSEND)
+ DEALLOCATE(ZRECV)
+ DEALLOCATE(ICOUNTS)
+
+ CALL GETHEAPSTAT(KOUT, CDLABEL)
+ENDIF
+END SUBROUTINE GETMEMSTAT
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/mpl_barrier_mod.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/mpl_barrier_mod.F90
new file mode 100644
index 0000000000000000000000000000000000000000..c3ea263afe886c7cc63730a80dd26064d509ee2f
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/mpl_barrier_mod.F90
@@ -0,0 +1,110 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+MODULE MPL_BARRIER_MOD
+
+
+
+!**** MPL_BARRIER - Barrier synchronisation
+
+! Purpose.
+! --------
+! Blocks the caller until all group members have called it.
+
+!** Interface.
+! ----------
+! CALL MPL_BARRIER
+
+! Input required arguments :
+! -------------------------
+! none
+
+! Input optional arguments :
+! -------------------------
+! KCOMM - Communicator number if different from MPI_COMM_WORLD
+! or from that established as the default
+! by an MPL communicator routine
+! CDSTRING - Character string for ABORT messages
+! used when KERROR is not provided
+
+! Output required arguments :
+! -------------------------
+! none
+
+! Output optional arguments :
+! -------------------------
+! KERROR - return error code. If not supplied,
+! MPL_BARRIER aborts when an error is detected.
+! Author.
+! -------
+! D.Dent, M.Hamrud ECMWF
+
+! Modifications.
+! --------------
+! Original: 2000-09-01
+! Threadsafe: 2004-12-15, J.Hague
+
+! ------------------------------------------------------------------
+
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+
+USE MPL_DATA_MODULE
+USE MPL_MESSAGE_MOD
+
+IMPLICIT NONE
+
+
+PRIVATE
+
+LOGICAL :: LLABORT=.TRUE.
+
+PUBLIC MPL_BARRIER
+
+CONTAINS
+
+SUBROUTINE MPL_BARRIER(KCOMM,CDSTRING,KERROR)
+
+
+#ifdef USE_8_BYTE_WORDS
+ USE MPI4TO8, ONLY : &
+ MPI_BARRIER => MPI_BARRIER8
+#endif
+
+
+INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KCOMM
+INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
+CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
+INTEGER :: ICOMM,IERROR,ITID
+IERROR = 0
+ITID = OML_MY_THREAD()
+IF(MPL_NUMPROC < 1) CALL MPL_MESSAGE(CDSTRING=CDSTRING,&
+ & CDMESSAGE='MPL_BARRIER: MPL NOT INITIALISED ',LDABORT=LLABORT)
+
+IF(PRESENT(KCOMM)) THEN
+ ICOMM=KCOMM
+ELSE
+ ICOMM=MPL_COMM_OML(ITID)
+ENDIF
+
+#ifdef VPP
+ CALL VPP_BARRIER
+#else
+ CALL MPI_BARRIER(ICOMM,IERROR)
+#endif
+
+IF(PRESENT(KERROR)) THEN
+ KERROR=IERROR
+ELSE
+ IF(IERROR /= 0 ) CALL MPL_MESSAGE(IERROR,'MPL_BARRIER',CDSTRING,LDABORT=LLABORT)
+ENDIF
+
+RETURN
+END SUBROUTINE MPL_BARRIER
+
+END MODULE MPL_BARRIER_MOD
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/mpl_end_mod.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/mpl_end_mod.F90
new file mode 100644
index 0000000000000000000000000000000000000000..ee3f727560cfbc8d31c8bdb067e68df0a7d309e1
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/mpl_end_mod.F90
@@ -0,0 +1,142 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+MODULE MPL_END_MOD
+
+!**** MPL_END - Terminates the message passing environment
+
+! Purpose.
+! --------
+! Cleans up all of the MPI state.
+! Subsequently, no MPI routine can be called
+
+!** Interface.
+! ----------
+! CALL MPL_END
+
+! Input required arguments :
+! -------------------------
+! none
+
+! Input optional arguments :
+! -------------------------
+! none
+
+! Output required arguments :
+! -------------------------
+! none
+
+! Output optional arguments :
+! -------------------------
+! KERROR - return error code. If not supplied,
+! MPL_END aborts when an error is detected.
+! Author.
+! -------
+! D.Dent, M.Hamrud ECMWF
+
+! Modifications.
+! --------------
+! Original: 2000-09-01
+! P. Towers 3-Jul-2014 Add call to ec_cray_meminfo
+
+! ------------------------------------------------------------------
+
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+
+USE MPL_DATA_MODULE
+USE MPL_MESSAGE_MOD
+USE EC_MPI_FINALIZE_MOD
+
+IMPLICIT NONE
+
+PUBLIC MPL_END
+PRIVATE
+
+INTEGER :: IERROR
+
+CONTAINS
+
+SUBROUTINE MPL_END(KERROR,LDMEMINFO)
+
+
+#ifdef USE_8_BYTE_WORDS
+ USE MPI4TO8, ONLY : &
+ MPI_BUFFER_DETACH => MPI_BUFFER_DETACH8, MPI_FINALIZE => MPI_FINALIZE8
+#endif
+
+
+INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
+LOGICAL ,INTENT(IN), OPTIONAL :: LDMEMINFO
+INTEGER(KIND=JPIM) :: IERROR
+LOGICAL :: LLMEMINFO=.TRUE.
+LOGICAL :: LLABORT=.TRUE.
+
+!#include "ec_mpi_finalize.intfb.h"
+
+IF(MPL_NUMPROC < 1) THEN
+ IF(MPL_NUMPROC == -1) THEN
+ IF (.NOT.LINITMPI_VIA_MPL) THEN
+ ! Neither MPL_INIT_MOD nor MPL_ARG_MOD -modules were called before this
+ CALL MPL_MESSAGE(CDMESSAGE=' MPL_END CALLED BEFORE MPL_INIT ')
+ ENDIF
+!!-- we do not want the following message to appear, since its non-fatal
+!! ELSEIF(MPL_NUMPROC == -2) THEN
+!! CALL MPL_MESSAGE(CDMESSAGE=' MPL_END CALLED MULTIPLE TIMES ')
+ ENDIF
+ IF(PRESENT(KERROR)) THEN
+ IERROR=0
+ KERROR=IERROR
+ ENDIF
+ RETURN
+ENDIF
+
+IF (ALLOCATED(MPL_ATTACHED_BUFFER)) THEN
+ IF( MPI_IS_FINALIZED() ) THEN
+ CALL MPL_MESSAGE(CDMESSAGE='MPL_END -- Cannot call MPI_Buffer_detach() as MPI is already finalized',LDABORT=.FALSE.)
+ ELSE
+ CALL MPI_BUFFER_DETACH(MPL_ATTACHED_BUFFER,MPL_MBX_SIZE,IERROR)
+ IF(PRESENT(KERROR)) THEN
+ KERROR=IERROR
+ ELSE
+ IF( IERROR /= 0 )THEN
+ CALL MPL_MESSAGE(IERROR,'MPL_END ',LDABORT=LLABORT)
+ ENDIF
+ ENDIF
+ ENDIF
+ DEALLOCATE(MPL_ATTACHED_BUFFER)
+ENDIF
+
+IF(PRESENT(LDMEMINFO)) LLMEMINFO=LDMEMINFO
+CALL EC_MPI_FINALIZE(IERROR,LINITMPI_VIA_MPL,LLMEMINFO,"mpl_end")
+
+MPL_NUMPROC = -2
+LINITMPI_VIA_MPL = .FALSE.
+
+IF(PRESENT(KERROR)) THEN
+ KERROR=IERROR
+ENDIF
+
+RETURN
+END SUBROUTINE MPL_END
+
+FUNCTION MPI_IS_FINALIZED()
+ LOGICAL :: MPI_IS_FINALIZED
+ LOGICAL :: LLINIT, LLFIN
+ INTEGER(KIND=JPIM) :: IERR
+ MPI_IS_FINALIZED = .FALSE.
+ CALL MPI_INITIALIZED(LLINIT,IERR)
+ IF (LLINIT .AND. IERR == 0) THEN
+ CALL MPI_FINALIZED(LLFIN,IERR)
+ IF( IERR == 0 ) THEN
+ MPI_IS_FINALIZED = LLFIN
+ ENDIF
+ ENDIF
+END FUNCTION
+
+END MODULE MPL_END_MOD
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/mpl_init_mod.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/mpl_init_mod.F90
new file mode 100644
index 0000000000000000000000000000000000000000..f30ad098b8e16f034d6ab763f4d0411427fe7a2d
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/mpl_init_mod.F90
@@ -0,0 +1,421 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+MODULE MPL_INIT_MOD
+
+!**** MPL_INIT - Initialises the Message passing environment
+
+! Purpose.
+! --------
+! Must be called before any other MPL routine.
+
+!** Interface.
+! ----------
+! CALL MPL_INIT
+
+! Input required arguments :
+! -------------------------
+! none
+
+! Input optional arguments :
+! -------------------------
+! KOUTPUT - Level of printing for MPL routines
+! =0: none
+! =1: intermediate (default)
+! =2: full trace
+! KUNIT - Fortran Unit to receive printed trace
+! LDINFO - = .TRUE. : Print informative msgs from MPL_INIT (default)
+! = .FALSE. : Do not print
+! LDENV - = .TRUE. : Propagate environment variables across participating tasks (default)
+! = .FALSE. : Do not propagate
+!
+
+! Output required arguments :
+! -------------------------
+! none
+
+! Output optional arguments :
+! -------------------------
+! KERROR - return error code. If not supplied,
+! MPL_INIT aborts when an error is detected.
+! KPROCS - Number of processes which have been initialised
+! in the MPI_COMM_WORLD communicator
+! Author.
+! -------
+! D.Dent, M.Hamrud ECMWF
+
+! Modifications.
+! --------------
+! Original: 2000-09-01
+! R. El Khatib 14-May-2007 Do not propagate environment if NECSX
+! S. Saarinen 04-Oct-2009 Reduced output & redefined MPL_COMM_OML(1)
+! P. Marguinaud 01-Jan-2011 Add LDENV argument
+! R. El Khatib 24-May-2011 Make MPI2 the default expectation.
+! P. Towers 3-Jul-2014 Add call to ec_cray_meminfo
+! ------------------------------------------------------------------
+
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+USE OML_MOD, ONLY : OML_INIT, OML_MAX_THREADS
+USE MPL_MPIF
+USE MPL_DATA_MODULE
+USE MPL_MESSAGE_MOD
+USE MPL_BUFFER_METHOD_MOD
+USE MPL_TOUR_TABLE_MOD
+USE MPL_LOCOMM_CREATE_MOD
+USE MPL_ARG_MOD
+
+IMPLICIT NONE
+
+PUBLIC MPL_INIT,MPL_WORLD_RANK, MPL_WORLD_SIZE, MPL_RANK
+
+PRIVATE
+
+CONTAINS
+
+SUBROUTINE MPL_INIT(KOUTPUT,KUNIT,KERROR,KPROCS,LDINFO,LDENV)
+
+#ifdef USE_8_BYTE_WORDS
+ USE MPI4TO8, ONLY : &
+ MPI_INITIALIZED => MPI_INITIALIZED8, MPI_INIT => MPI_INIT8, &
+ MPI_COMM_SIZE => MPI_COMM_SIZE8, MPI_COMM_RANK => MPI_COMM_RANK8, &
+ MPI_BCAST => MPI_BCAST8
+#endif
+
+
+
+INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KOUTPUT,KUNIT
+INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KPROCS
+LOGICAL,INTENT(IN),OPTIONAL :: LDINFO,LDENV
+INTEGER(KIND=JPIM) :: IERROR,IP,ICOMM,IRANK,JNODE,JROC,ISTA
+INTEGER(KIND=JPIM) :: IMAX_THREADS, IRET, IROOT, INUM(2), ICOUNT
+INTEGER(KIND=JPIM) :: IREQUIRED,IPROVIDED
+INTEGER(KIND=JPIM) :: IWORLD_RANK, IWORLD_SIZE
+INTEGER(KIND=JPIM) :: MPL_WORLD_RANK, MPL_WORLD_SIZE, MPL_RANK
+INTEGER(KIND=JPIM) :: IME
+LOGICAL :: LLABORT=.TRUE., LLINFO
+LOGICAL :: LLINIT
+LOGICAL :: LLENV
+CHARACTER(LEN=12) :: CL_MBX_SIZE
+CHARACTER(LEN=12) :: CL_ARCH
+CHARACTER(LEN=12) :: CL_TASKSPERNODE
+CHARACTER(LEN=1024) :: CLENV
+CHARACTER(LEN=20) :: CL_METHOD,CL_HOST
+CHARACTER(LEN=1) :: CL_SET
+
+IF(PRESENT(KOUTPUT)) THEN
+ MPL_OUTPUT=MAX(0,KOUTPUT)
+ELSE
+ MPL_OUTPUT=1
+ENDIF
+
+IF(PRESENT(KUNIT)) THEN
+ MPL_UNIT=MAX(0,KUNIT)
+ELSE
+ MPL_UNIT=6
+ENDIF
+
+IF(PRESENT(LDINFO)) THEN
+ LLINFO = LDINFO
+ELSE
+ LLINFO = .TRUE.
+ENDIF
+
+IF(PRESENT(LDENV)) THEN
+ LLENV = LDENV
+ELSE
+ LLENV = .TRUE.
+ENDIF
+
+IF(MPL_NUMPROC /= -1) THEN
+!! We do not want this extra message
+!! CALL MPL_MESSAGE(CDMESSAGE=' MPL_INIT CALLED MULTIPLE TIMES ')
+ IF(PRESENT(KERROR)) THEN
+ KERROR=0
+ ENDIF
+ IF(PRESENT(KPROCS)) THEN
+ KPROCS=MPL_NUMPROC
+ ENDIF
+ RETURN
+ENDIF
+
+CALL MPI_INITIALIZED(LLINIT, IRET)
+
+IF (.NOT.LLINIT) THEN
+
+ CALL GET_ENVIRONMENT_VARIABLE('ARCH',CL_ARCH)
+
+#ifndef OPS_COMPILE
+#ifdef RS6K
+ IF(CL_ARCH(1:10)=='ibm_power6')THEN
+! write(0,*)'POWER6: CALLING EC_BIND BEFORE MPI_INIT'
+ CALL EC_BIND()
+ ENDIF
+#endif
+#endif
+
+
+#ifndef MPI1
+ IREQUIRED = MPI_THREAD_MULTIPLE
+ IPROVIDED = MPI_THREAD_SINGLE
+ CALL MPI_INIT_THREAD(IREQUIRED,IPROVIDED,IERROR)
+ IF (IERROR /= 0) CALL ABOR1 ('MPL_INIT: MPI_INIT_THREAD FAILED')
+ LTHSAFEMPI = (IPROVIDED >= IREQUIRED)
+#else
+ CALL MPI_INIT(IERROR)
+ IF (IERROR /= 0) CALL ABOR1 ('MPL_INIT: MPI_INIT FAILED')
+ LTHSAFEMPI = .FALSE.
+#endif
+
+CALL MPI_Comm_rank(MPI_COMM_WORLD, IME, IERROR)
+
+! Print out thread safety etc. messages -- must use MPI_Comm_rank since MPL not initialized just yet
+IF (IME == 0) THEN
+ WRITE(0,'(1X,A,4(1X,I0),1(1X,L1))') &
+ & 'MAIN: IREQUIRED, MPI_THREAD_MULTIPLE, MPI_THREAD_SINGLE, IPROVIDED, LTHSAFEMPI =',&
+ & IREQUIRED, MPI_THREAD_MULTIPLE, MPI_THREAD_SINGLE, IPROVIDED, LTHSAFEMPI
+ENDIF
+
+#ifndef OPS_COMPILE
+#ifdef RS6K
+ IF(CL_ARCH(1:10)=='ibm_power4')THEN
+! write(0,*)'POWER5: CALLING EC_BIND AFTER MPI_INIT'
+ CALL EC_BIND()
+ ENDIF
+#endif
+#endif
+
+ LINITMPI_VIA_MPL = .TRUE.
+! CALL ec_mpi_atexit() ! ifsaux/support/endian.c: to make sure MPI_FINALIZE gets called
+
+ELSE
+ IERROR = 0
+ENDIF
+
+IF(PRESENT(KERROR)) THEN
+ KERROR=IERROR
+ELSE
+ IF(IERROR /= 0) THEN
+ CALL MPL_MESSAGE(IERROR,CDMESSAGE=' MPL_INIT ERROR ',LDABORT=LLABORT)
+ ENDIF
+ENDIF
+
+! If LMPLUSERCOMM is not set use MPI_COMM_WORLD
+!mps: Sami Saarinen, 29-Nov-2016
+! Must be set *AFTER* MPI_INIT*() has ben called (or LLINIT is true)
+! Otherwise MPI_COMM_WORLD not defined (at least not in OpenMPI)
+IF(LMPLUSERCOMM) THEN
+ MPL_COMM = MPLUSERCOMM
+ELSE
+ MPL_COMM = MPI_COMM_WORLD
+ENDIF
+
+CALL MPI_COMM_SIZE(MPL_COMM,MPL_NUMPROC,IERROR)
+
+IF(PRESENT(KPROCS)) THEN
+ KPROCS=MPL_NUMPROC
+ENDIF
+
+ALLOCATE (MPL_IDS(MPL_NUMPROC))
+DO IP=1,MPL_NUMPROC
+ MPL_IDS(IP)=IP
+ENDDO
+
+CALL MPI_COMM_RANK(MPL_COMM, IRANK, IERROR)
+MPL_RANK=IRANK+1
+
+LLINFO = LLINFO .AND. (MPL_RANK <= 1)
+
+IF (LLINFO) THEN
+ IF(LMPLUSERCOMM) THEN
+ WRITE(MPL_UNIT,'(A)')'MPL_INIT : LMPLUSERCOMM used'
+ WRITE(MPL_UNIT,'(A,I0)')'Communicator : ',MPL_COMM
+ ELSE
+ WRITE(MPL_UNIT,'(A)')'MPL_INIT : LMPLUSERCOMM not used'
+ WRITE(MPL_UNIT,'(A,I0)')'Communicator : ',MPL_COMM
+ ENDIF
+ENDIF
+
+#ifndef NECSX
+
+!-- Propagate environment variables & argument lists
+! Here we have to be careful and use MPI_BCAST directly (not MPL_BROADCAST) since
+! 1) MPL_BUFFER_METHOD has not been called
+! 2) MPL_COMM_OML has not been initialized since it is possible that only the
+! master proc knows the # of threads (i.e. OMP_NUM_THREADS may be set only for master)
+
+! Do not propagate on nec machine because the environment variables could be mpi-task-specific.
+
+IF (MPL_NUMPROC > 1 .AND. LLENV) THEN
+ IROOT = 0
+ !-- Progate environment variables
+ INUM(1) = 0 ! The number of environment variables
+ INUM(2) = 0 ! Do not (=0) or do (=1) overwrite if particular environment variable already exists (0 = default)
+ IF (MPL_RANK == 1) THEN ! Master proc inquires
+ CALL EC_NUMENV(INUM(1)) ! ../support/env.c
+ CALL EC_OVERWRITE_ENV(INUM(2)) ! ../support/env.c
+ ENDIF
+ ! The following broadcast does not use "mailbox" nor attached buffer, both potentially yet to be allocated
+ CALL MPI_BCAST(INUM(1),2,INT(MPI_INTEGER),IROOT,MPL_COMM,IERROR)
+ ICOUNT = LEN(CLENV)
+ DO IP=1,INUM(1)
+ IF (MPL_RANK == 1) CALL EC_STRENV(IP,CLENV)
+ ! The following broadcast does not use "mailbox" nor attached buffer, both potentially yet to be allocated
+ CALL MPI_BCAST(CLENV,ICOUNT,INT(MPI_BYTE),IROOT,MPL_COMM,IERROR)
+ IF (MPL_RANK > 1) THEN
+ IF (INUM(2) == 1) THEN
+ CALL EC_PUTENV(CLENV) ! ../support/env.c ; Unconditionally overwrite, even if already exists
+ ELSE
+ CALL EC_PUTENV_NOOVERWRITE(CLENV) ! ../support/env.c ; Do not overwrite, if exists
+ ENDIF
+ ENDIF
+ ENDDO
+ !-- Redo some env. variables (see ../utilities/fnecsx.c)
+ CALL EC_ENVREDO()
+ !-- Propagate argument list (all under the bonnet using MPL_ARG_MOD-module)
+ INUM = MPL_IARGC()
+ENDIF
+
+#endif
+
+CALL OML_INIT()
+IMAX_THREADS = OML_MAX_THREADS()
+ALLOCATE(MPL_COMM_OML(IMAX_THREADS))
+
+IF (LMPLUSERCOMM) THEN
+ MPL_COMM_OML(1) = MPLUSERCOMM
+ ISTA = 2
+ELSE
+ ISTA = 1
+ENDIF
+
+DO IP=ISTA,IMAX_THREADS
+ CALL MPL_LOCOMM_CREATE(MPL_NUMPROC,MPL_COMM_OML(IP))
+ENDDO
+MPL_COMM = MPL_COMM_OML(1) ! i.e. not necessary MPI_COMM_WORLD anymore
+
+#ifdef VPP
+MPL_METHOD=JP_BLOCKING_STANDARD
+MPL_MBX_SIZE=4000000
+CL_MBX_SIZE=' '
+CALL GET_ENVIRONMENT_VARIABLE('VPP_MBX_SIZE',CL_MBX_SIZE)
+IF(CL_MBX_SIZE == ' ') THEN
+ CALL GET_ENVIRONMENT_VARIABLE('MPL_MBX_SIZE',CL_MBX_SIZE)
+ENDIF
+IF(CL_MBX_SIZE /= ' ') THEN
+ READ(CL_MBX_SIZE,*) MPL_MBX_SIZE
+ENDIF
+IF (LLINFO) WRITE(MPL_UNIT,'(A)')'MPL_INIT : MPL_METHOD=JP_BLOCKING_STANDARD'
+IF (LLINFO) WRITE(MPL_UNIT,'(A,I0)')'MPL_INIT : MAILBOX SIZE=',MPL_MBX_SIZE
+LUSEHLMPI = .FALSE.
+
+!#elif defined (LINUX)
+!MPL_METHOD=JP_BLOCKING_STANDARD
+!MPL_MBX_SIZE=4000000
+!CL_MBX_SIZE=' '
+!CALL GET_ENVIRONMENT_VARIABLE('VPP_MBX_SIZE',CL_MBX_SIZE)
+!IF(CL_MBX_SIZE == ' ') THEN
+! CALL GET_ENVIRONMENT_VARIABLE('MPL_MBX_SIZE',CL_MBX_SIZE)
+!ENDIF
+!IF(CL_MBX_SIZE /= ' ') THEN
+! READ(CL_MBX_SIZE,*) MPL_MBX_SIZE
+!ENDIF
+!IF (LLINFO) WRITE(MPL_UNIT,'(A)')'MPL_INIT : MPL_METHOD=JP_BLOCKING_STANDARD'
+!IF (LLINFO) WRITE(MPL_UNIT,'(A,I0)')'MPL_INIT : MAILBOX SIZE=',MPL_MBX_SIZE
+!LUSEHLMPI = .FALSE.
+
+#else
+CL_METHOD=' '
+CALL GET_ENVIRONMENT_VARIABLE('MPL_METHOD',CL_METHOD)
+IF (CL_METHOD == 'JP_BLOCKING_STANDARD' ) THEN
+ MPL_METHOD=JP_BLOCKING_STANDARD
+ELSE
+ MPL_METHOD=JP_BLOCKING_BUFFERED
+ENDIF
+MPL_MBX_SIZE=1000000
+CL_MBX_SIZE=' '
+CALL GET_ENVIRONMENT_VARIABLE('MPL_MBX_SIZE',CL_MBX_SIZE)
+IF (CL_MBX_SIZE /= ' ') THEN
+ READ(CL_MBX_SIZE,*) MPL_MBX_SIZE
+ENDIF
+IF (CL_METHOD == 'JP_BLOCKING_STANDARD' ) THEN
+ IF (LLINFO) WRITE(MPL_UNIT,'(A)')'MPL_INIT : MPL_METHOD=JP_BLOCKING_STANDARD'
+ELSE
+ IF (LLINFO) WRITE(MPL_UNIT,'(A)')'MPL_INIT : MPL_METHOD=JP_BLOCKING_BUFFERED'
+ENDIF
+!IF (LLINFO) WRITE(MPL_UNIT,'(A,I0)')'MPL_INIT : MAILBOX SIZE=',MPL_MBX_SIZE
+
+CALL MPL_BUFFER_METHOD(KMP_TYPE=MPL_METHOD,KMBX_SIZE=MPL_MBX_SIZE,LDINFO=LLINFO)
+LUSEHLMPI = .TRUE.
+#endif
+
+CALL MPI_COMM_RANK (MPI_COMM_WORLD, IWORLD_RANK, IERROR)
+CALL MPI_COMM_SIZE (MPI_COMM_WORLD, IWORLD_SIZE, IERROR)
+
+#ifdef LINUX
+CALL LINUX_BIND (IWORLD_RANK, IWORLD_SIZE)
+#endif
+
+!-- World-wide tasks
+MPL_WORLD_RANK = IWORLD_RANK
+MPL_WORLD_SIZE = IWORLD_SIZE
+
+!!!! If you are not at ECMWF this may need changing!!!!
+CALL GET_ENVIRONMENT_VARIABLE('EC_TASKS_PER_NODE',CL_TASKSPERNODE)
+IF (CL_TASKSPERNODE(1:1) == ' ' ) THEN
+ CALL GET_ENVIRONMENT_VARIABLE('HOST',CL_HOST)
+ IF(CL_HOST(1:3) == 'cck') THEN ! KNL
+ MPL_NCPU_PER_NODE=64
+ ELSEIF(CL_HOST(1:3) == 'cct') THEN ! Test-cluster
+ MPL_NCPU_PER_NODE=24
+ ELSEIF(CL_HOST(1:2) == 'cc') THEN ! cca/ccb
+ MPL_NCPU_PER_NODE=36
+ ELSEIF(CL_HOST(1:3) == 'lxg') THEN ! GPU-cluster
+ MPL_NCPU_PER_NODE=24
+ ELSEIF (CL_HOST(1:2) == 'c1') THEN
+ MPL_NCPU_PER_NODE=64
+ ELSEIF(CL_HOST(1:3) == 'hpc') THEN
+ MPL_NCPU_PER_NODE=32
+ ELSE
+ MPL_NCPU_PER_NODE=1
+ IF(LLINFO) WRITE(MPL_UNIT,'(A)')'MPL_INIT CAUTION: MPL_NCPU_PER_NODE=1'
+ ENDIF
+ELSE
+ READ(CL_TASKSPERNODE,*) MPL_NCPU_PER_NODE
+ENDIF
+MPL_MAX_TASK_PER_NODE=MAX(1, MPL_NCPU_PER_NODE/IMAX_THREADS)
+LFULLNODES=MOD(MPL_NUMPROC,MPL_MAX_TASK_PER_NODE) == 0
+MPL_NNODES=(MPL_NUMPROC-1)/MPL_MAX_TASK_PER_NODE+1
+ALLOCATE(MPL_TASK_PER_NODE(MPL_NNODES))
+ALLOCATE(MPL_NODE(MPL_NUMPROC))
+ALLOCATE(MPL_NODE_TASKS(MPL_NNODES,MPL_MAX_TASK_PER_NODE))
+MPL_NODE_TASKS(:,:)=-99
+ICOUNT=0
+DO JNODE=1,MPL_NNODES
+ DO JROC=1,MPL_MAX_TASK_PER_NODE
+ ICOUNT=ICOUNT+1
+ IF (ICOUNT<=MPL_NUMPROC) THEN
+ MPL_NODE(ICOUNT)=JNODE
+ MPL_TASK_PER_NODE(JNODE) = JROC
+ MPL_NODE_TASKS(JNODE,JROC) = ICOUNT
+ ENDIF
+ ENDDO
+ENDDO
+MPL_MYNODE=(MPL_RANK-1)/MPL_MAX_TASK_PER_NODE+1
+!WRITE(MPL_UNIT,*) 'MPL_INIT : NCPU_PER_NODE,MPL_MAX_TASK_PER_NODE,MPL_NNODES,MPL_MYNODE ',&
+! & MPL_NCPU_PER_NODE,MPL_MAX_TASK_PER_NODE,MPL_NNODES,MPL_MYNODE
+!WRITE(MPL_UNIT,*) 'MPL_INIT : MPL_NODE_TASKS(MPL_MYNODE,1:MPL_TASK_PER_NODE(MPL_MYNODE)) ', &
+! & MPL_NODE_TASKS(MPL_MYNODE,1:MPL_TASK_PER_NODE(MPL_MYNODE))
+
+ALLOCATE(MPL_OPPONENT(MPL_NUMPROC+1))
+CALL MPL_TOUR_TABLE(MPL_OPPONENT)
+
+RETURN
+END SUBROUTINE MPL_INIT
+
+END MODULE MPL_INIT_MOD
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/mpl_mpif.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/mpl_mpif.F90
new file mode 100644
index 0000000000000000000000000000000000000000..870bc88513b0b8bffb6bbea3f196affb10a20069
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/mpl_mpif.F90
@@ -0,0 +1,12 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+MODULE MPL_MPIF
+include "mpif.h"
+END MODULE MPL_MPIF
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/driver/test_cloud_generator.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/driver/test_cloud_generator.F90
new file mode 100644
index 0000000000000000000000000000000000000000..bef81aeaa043144b51de23b0a59c01a892f61e41
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/driver/test_cloud_generator.F90
@@ -0,0 +1,68 @@
+! (C) Copyright 2017- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+program test_cloud_generator
+
+ use parkind1, only : jprb
+ use radiation_cloud_generator, only : cloud_generator
+ use radiation_pdf_sampler, only : pdf_sampler_type
+ use radiation_cloud_cover, only : &
+ & IOverlapMaximumRandom, IOverlapExponentialRandom, IOverlapExponential
+
+ implicit none
+
+ integer, parameter :: ncol = 2000
+ integer, parameter :: nlev = 137
+ integer, parameter :: i_overlap_scheme = IOverlapExponential
+ real(jprb), parameter :: scale_height = 8000.0_jprb
+ real(jprb), parameter :: cloud_inhom_decorr_scaling = 0.5_jprb
+ real(jprb), parameter :: frac_threshold = 1.0e-6_jprb
+
+ real(jprb) :: cloud_fraction(nlev), overlap_param(nlev-1), fractional_std(nlev)
+! real(jprb) :: pressure_hl(nlev+1)
+
+! real(jprb) :: decorrelation_length
+
+ real(jprb) :: od_scaling(ncol,nlev)
+ real(jprb) :: total_cloud_cover
+
+ integer :: iseed
+
+ integer :: jcol, jlev
+
+ type(pdf_sampler_type) :: pdf_sampler
+
+ iseed = 1
+ cloud_fraction = 0.0_jprb
+ overlap_param = 0.9_jprb
+ fractional_std = 1.0_jprb ! Value up to 45R1
+
+ ! Insert cloud layers
+ cloud_fraction(115:125) = 0.1_jprb !0.5_jprb
+ cloud_fraction(20:100) = 0.1_jprb !0.75_jprb
+
+ call pdf_sampler%setup('data/mcica_gamma.nc', iverbose=0)
+
+ call cloud_generator(ncol, nlev, i_overlap_scheme, &
+ & iseed, frac_threshold, &
+ & cloud_fraction, overlap_param, &
+ & cloud_inhom_decorr_scaling, &
+ & fractional_std, pdf_sampler, &
+ & od_scaling, total_cloud_cover)
+
+ do jlev = 1,nlev
+ do jcol = 1,ncol
+ ! write(*,'(f5.2,a)','advance','no') od_scaling(jcol,jlev)
+ write(*,*)
+ end do
+ write(*,*)
+ end do
+
+
+end program test_cloud_generator
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/driver/test_solver.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/driver/test_solver.F90
new file mode 100644
index 0000000000000000000000000000000000000000..8becf0ad6389b56d0eb078a207ffd29c45923ef8
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/driver/test_solver.F90
@@ -0,0 +1,114 @@
+! (C) Copyright 2016- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+program test_solver
+
+ use parkind1, only : jprb
+
+ use radiation_config, only : config_type, IGasModelMonochromatic
+ use radiation_single_level, only : single_level_type
+ use radiation_thermodynamics, only : thermodynamics_type
+ use radiation_cloud, only : cloud_type
+ use radiation_flux, only : flux_type
+ use radiation_monochromatic, only : setup_gas_optics
+ use radiation_homogeneous_sw, only : solver_homogeneous_sw
+ use radiation_cloud_optics, only : delta_eddington
+
+ implicit none
+
+ integer, parameter :: nlev = 1
+ integer, parameter :: ncol = 10
+ integer, parameter :: n_g_sw = 1
+
+ integer :: istartcol, iendcol, jcol, jlev, jod
+
+ type(config_type) :: config
+ type(single_level_type) :: single_level
+ type(thermodynamics_type) :: thermodynamics
+ type(cloud_type) :: cloud
+ type(flux_type) :: flux
+
+ real(jprb), dimension(n_g_sw,nlev,ncol) :: od_sw, ssa_sw, g_sw
+ real(jprb), dimension(n_g_sw,nlev,ncol) :: od_sw_cloud, ssa_sw_cloud, &
+ & scat_sw_cloud, g_sw_cloud
+ real(jprb), dimension(n_g_sw,ncol) :: incoming_sw
+
+ real(jprb), dimension(1,ncol) :: albedo_direct, albedo_diffuse
+
+ istartcol = 1
+ iendcol = ncol
+
+ config%i_gas_model = IGasModelMonochromatic
+ call config%consolidate()
+
+ call setup_gas_optics(config, trim(config%directory_name))
+
+ call config%define_sw_albedo_intervals(1, &
+ & [ 0.25], [1], &
+ & do_nearest=.false.)
+
+ call flux%allocate(config, istartcol, iendcol, nlev)
+ call cloud%allocate(ncol, nlev)
+ call thermodynamics%allocate(ncol, nlev)
+ call single_level%allocate(ncol, 1, 1, .false.)
+
+ cloud%fraction = 1.0
+
+ do jcol = 1,ncol
+ single_level%cos_sza(jcol) = cos((jcol-1)*acos(-1.0)/(2.0_jprb*(ncol-1)))
+ incoming_sw(1,jcol) = 1.0_jprb
+ end do
+ write(*,*) 'cos_sza = ', single_level%cos_sza
+ single_level%sw_albedo = 0.08_jprb
+
+ albedo_direct = single_level%sw_albedo
+ albedo_diffuse = single_level%sw_albedo
+
+ incoming_sw(:,:) = 100 ! to fix bugs only, not correct
+
+ do jlev = 1,nlev+1
+ thermodynamics%pressure_hl(:,jlev) = 100000.0_jprb * (jlev-1) / nlev
+ end do
+
+ od_sw = 0.0_jprb
+ ssa_sw = 1.0_jprb
+ g_sw = 0.0_jprb
+
+ do jod = 1,8
+ ssa_sw_cloud = 0.999_jprb
+ g_sw_cloud = 0.85_jprb
+! g_sw_cloud = 0.0_jprb
+
+ if (jod == 1) then
+ od_sw_cloud = 0.0_jprb
+ else
+! od_sw_cloud(1,2:,:) = 10.0**(0.5 * (jod-4)) / (nlev-1)
+ od_sw_cloud(1,:,:) = 10.0**(0.5 * (jod-4)) / nlev
+
+ scat_sw_cloud = od_sw_cloud * ssa_sw_cloud
+ call delta_eddington(od_sw_cloud, scat_sw_cloud, g_sw_cloud)
+ where (od_sw_cloud > 0.0)
+ ssa_sw_cloud = scat_sw_cloud / od_sw_cloud
+ end where
+ end if
+
+ write(*,*) 'Optical depth = ', sum(od_sw_cloud(1,:,1)), ' g=', g_sw_cloud(1,:,1)
+
+
+ ! Compute fluxes using the homogeneous solver
+ call solver_homogeneous_sw(nlev,istartcol,iendcol, &
+ & config, single_level, cloud, &
+ & od_sw, ssa_sw, g_sw, od_sw_cloud, ssa_sw_cloud, g_sw_cloud, &
+ & albedo_direct, albedo_diffuse, incoming_sw, flux)
+
+ write(0,*) flux%sw_up(:,1)
+ end do
+
+
+end program test_solver
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/cloud_overlap_decorr_len.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/cloud_overlap_decorr_len.F90
new file mode 100644
index 0000000000000000000000000000000000000000..225e12784f36d8486458c378f53c657e824535ee
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/cloud_overlap_decorr_len.F90
@@ -0,0 +1,150 @@
+! #################################
+ MODULE MODI_CLOUD_OVERLAP_DECORR_LEN
+! #################################
+INTERFACE
+
+SUBROUTINE CLOUD_OVERLAP_DECORR_LEN &
+ & (KIDIA, KFDIA, KLON, PGEMU, NDECOLAT, &
+ & PDECORR_LEN_EDGES_KM, PDECORR_LEN_WATER_KM, PDECORR_LEN_RATIO)
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA ! Start column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA ! End column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KLON ! Number of columns
+REAL(KIND=JPRB), INTENT(IN) :: PGEMU(KLON) ! Sine of latitude
+INTEGER(KIND=JPIM),INTENT(IN) :: NDECOLAT
+REAL(KIND=JPRB), INTENT(OUT) :: PDECORR_LEN_EDGES_KM(KLON)
+REAL(KIND=JPRB), INTENT(OUT), OPTIONAL :: PDECORR_LEN_WATER_KM(KLON)
+REAL(KIND=JPRB), INTENT(OUT), OPTIONAL :: PDECORR_LEN_RATIO
+
+END SUBROUTINE CLOUD_OVERLAP_DECORR_LEN
+END INTERFACE
+END MODULE MODI_CLOUD_OVERLAP_DECORR_LEN
+
+SUBROUTINE CLOUD_OVERLAP_DECORR_LEN &
+ & (KIDIA, KFDIA, KLON, PGEMU, NDECOLAT, &
+ & PDECORR_LEN_EDGES_KM, PDECORR_LEN_WATER_KM, PDECORR_LEN_RATIO)
+
+! CLOUD_OVERLAP_DECORR_LEN
+!
+! (C) Copyright 2016- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! PURPOSE
+! -------
+! Calculate the cloud overlap decorrelation length as a function of
+! latitude for use in the radiation scheme
+!
+! INTERFACE
+! ---------
+! CLOUD_OVERLAP_DECORR_LEN is called from RADLSWR and RADIATION_SCHEME
+!
+! AUTHOR
+! ------
+! Robin Hogan, ECMWF (using code extracted from radlswr.F90)
+! Original: 2016-02-16
+!
+! MODIFICATIONS
+! 2021-20-04 (Q. Libois) Adaptation to MNH
+! - embed in module with interface
+!
+! -------------------------------------------------------------------
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMCST , ONLY : RPI
+USE MODD_PARAM_ECRAD_N , ONLY : XDECORR_CF,XDECORR_CW
+! -------------------------------------------------------------------
+
+IMPLICIT NONE
+
+! INPUT ARGUMENTS
+
+! *** Array dimensions and ranges
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA ! Start column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA ! End column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KLON ! Number of columns
+
+! *** Configuration variable controlling the overlap scheme
+INTEGER(KIND=JPIM),INTENT(IN) :: NDECOLAT
+
+! *** Single-level variables
+REAL(KIND=JPRB), INTENT(IN) :: PGEMU(KLON) ! Sine of latitude
+
+! OUTPUT ARGUMENTS
+
+! *** Decorrelation lengths for cloud edges and cloud water content,
+! *** in km
+REAL(KIND=JPRB), INTENT(OUT) :: PDECORR_LEN_EDGES_KM(KLON)
+REAL(KIND=JPRB), INTENT(OUT), OPTIONAL :: PDECORR_LEN_WATER_KM(KLON)
+
+! Ratio of water-content to cloud-edge decorrelation lengths
+REAL(KIND=JPRB), INTENT(OUT), OPTIONAL :: PDECORR_LEN_RATIO
+
+! LOCAL VARIABLES
+
+REAL(KIND=JPRB) :: ZRADIANS_TO_DEGREES, ZABS_LAT_DEG, ZCOS_LAT
+
+INTEGER(KIND=JPIM) :: JL
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+! -------------------------------------------------------------------
+
+IF (LHOOK) CALL DR_HOOK('CLOUD_OVERLAP_DECORR_LEN',0,ZHOOK_HANDLE)
+
+! -------------------------------------------------------------------
+
+IF (NDECOLAT == 0) THEN
+
+ ! Decorrelation lengths are constant values
+ PDECORR_LEN_EDGES_KM(KIDIA:KFDIA) = XDECORR_CF
+ IF (PRESENT(PDECORR_LEN_WATER_KM)) THEN
+ PDECORR_LEN_WATER_KM(KIDIA:KFDIA) = XDECORR_CW
+ ENDIF
+ IF (PRESENT(PDECORR_LEN_RATIO)) THEN
+ PDECORR_LEN_RATIO = XDECORR_CW / XDECORR_CF
+ ENDIF
+
+ELSE
+
+ ZRADIANS_TO_DEGREES = 180.0_JPRB / RPI
+
+ IF (NDECOLAT == 1) THEN
+ ! Shonk et al. (2010) Eq. 13 formula
+ DO JL = KIDIA,KFDIA
+ ZABS_LAT_DEG = ABS(ASIN(PGEMU(JL)) * ZRADIANS_TO_DEGREES)
+ PDECORR_LEN_EDGES_KM(JL) = 2.899_JPRB - 0.02759_JPRB * ZABS_LAT_DEG
+ ENDDO
+ ELSE ! NDECOLAT == 2
+ DO JL = KIDIA,KFDIA
+ ! Shonk et al. (2010) but smoothed over the equator
+ ZCOS_LAT = COS(ASIN(PGEMU(JL)))
+ PDECORR_LEN_EDGES_KM(JL) = 0.75_JPRB + 2.149_JPRB * ZCOS_LAT*ZCOS_LAT
+ ENDDO
+ ENDIF
+
+ ! Both NDECOLAT = 1 and 2 assume that the decorrelation length for
+ ! cloud water content is half that for cloud edges
+ IF (PRESENT(PDECORR_LEN_WATER_KM)) THEN
+ PDECORR_LEN_WATER_KM(KIDIA:KFDIA) = PDECORR_LEN_EDGES_KM(KIDIA:KFDIA) * 0.5_JPRB
+ ENDIF
+
+ IF (PRESENT(PDECORR_LEN_RATIO)) THEN
+ PDECORR_LEN_RATIO = 0.5_JPRB
+ ENDIF
+
+ENDIF
+
+! -------------------------------------------------------------------
+
+IF (LHOOK) CALL DR_HOOK('CLOUD_OVERLAP_DECORR_LEN',1,ZHOOK_HANDLE)
+
+END SUBROUTINE CLOUD_OVERLAP_DECORR_LEN
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/cos_sza.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/cos_sza.F90
new file mode 100644
index 0000000000000000000000000000000000000000..0fdf3511e8a13470bdda296d78f8400b535b7227
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/cos_sza.F90
@@ -0,0 +1,360 @@
+SUBROUTINE COS_SZA(KSTART,KEND,KCOL,PGEMU,PGELAM,LDRADIATIONTIMESTEP,PMU0)
+
+!**** *COS_SZA*
+!
+! (C) Copyright 2015- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Purpose.
+! --------
+! Compute the cosine of the solar zenith angle. Note that this
+! is needed for three different things: (1) as input to the
+! radiation scheme in which it is used to compute the path
+! length of the direct solar beam through the atmosphere, (2)
+! every timestep to scale the solar fluxes by the incoming
+! solar radiation at top-of-atmosphere, and (3) to compute the
+! albedo of the ocean. For (1) we ideally want an average
+! value for the duration of a radiation timestep while for (2)
+! we want an average value for the duration of a model
+! timestep.
+
+!** Interface.
+! ----------
+! *CALL* *COS_SZA(...)
+
+! Explicit arguments :
+! ------------------
+! PGEMU - Sine of latitude
+! PGELAM - Geographic longitude in radians
+! LDRadiationTimestep - Is this for a radiation timestep?
+! PMU0 - Output cosine of solar zenith angle
+
+! Implicit arguments :
+! --------------------
+! YRRIP%RWSOVR, RWSOVRM - Solar time for model/radiation timesteps
+! RCODECM, RSIDECM - Sine/cosine of solar declination
+! YRERAD%LAverageSZA - Average solar zenith angle in time interval?
+! YRRIP%TSTEP - Model timestep in seconds
+! YRERAD%NRADFR - Radiation frequency in timesteps
+
+! Method.
+! -------
+! Compute cosine of the solar zenith angle, mu0, from lat, lon
+! and solar time using standard formula. If
+! YRERAD%LAverageSZA=FALSE then this is done at a single time,
+! which is assumed to be the mid-point of either the model or
+! the radiation timestep. If YRERAD%LAverageSZA=TRUE then we
+! compute the average over the model timestep exactly by first
+! computing sunrise/sunset times. For radiation timesteps, mu0
+! is to be used to compute the path length of the direct solar
+! beam through the atmosphere, and the fluxes are subsequently
+! weighted by mu0. Therefore night-time values are not used,
+! so we average mu0 only when the sun is above the horizon.
+
+! Externals.
+! ----------
+
+! Reference.
+! ----------
+! ECMWF Research Department documentation of the IFS
+!
+! See also: Zhou, L., M. Zhang, Q. Bao, and Y. Liu (2015), On
+! the incident solar radiation in CMIP5
+! models. Geophys. Res. Lett., 42, 1930–1935. doi:
+! 10.1002/2015GL063239.
+
+! Author.
+! -------
+! Robin Hogan, ECMWF, May 2015
+
+! Modifications:
+! --------------
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMCST , ONLY : RPI, RDAY
+
+! MNH
+!USE YOMRIP , ONLY : YRRIP
+USE MODD_RADIATIONS_N , ONLY : XCOSDEL, XSINDEL, XZENITH ! no difference between yoerip and yomrip here
+!USE YOERIP , ONLY : YRERIP
+!USE YOERAD , ONLY : YRERAD
+USE MODD_PARAM_ECRAD_N , ONLY : NRADFR, LCENTREDTIMESZA, LAVERAGESZA
+USE MODD_PARAM_RAD_n, ONLY : XDTRAD
+USE MODD_RADIATIONS_n, ONLY : XSINDEL, XCOSDEL, XTSIDER
+USE MODD_TIME_n, ONLY : TDTRAD_FULL
+USE MODD_DYN_n, ONLY : XTSTEP
+! MNH
+
+USE YOMLUN , ONLY : NULOUT
+
+! ------------------------------------------------------------------
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN) :: KSTART ! Start column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KEND ! Last column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KCOL ! Number of columns in arrays
+REAL(KIND=JPRB), INTENT(IN) :: PGEMU(KCOL) ! Sine of latitude
+REAL(KIND=JPRB), INTENT(IN) :: PGELAM(KCOL)! Longitude in radians
+LOGICAL, INTENT(IN) :: LDRADIATIONTIMESTEP ! Is this for a radiation timestep?
+REAL(KIND=JPRB), INTENT(OUT) :: PMU0(KCOL) ! Cosine of solar zenith angle
+
+! Solar time at the start and end of the time interval
+REAL(KIND=JPRB) :: ZSOLARTIMESTART, ZSOLARTIMEEND
+
+! The time of half a model/radiation timestep, in radians
+REAL(KIND=JPRB) :: ZHALFTIMESTEP
+
+! For efficiency we precompute sin(solar declination)*sin(latitude)
+REAL(KIND=JPRB) :: ZSINDECSINLAT(KSTART:KEND)
+!...and cos(solar declination)*cos(latitude)
+REAL(KIND=JPRB) :: ZCOSDECCOSLAT(KSTART:KEND)
+! ...and cosine of latitude
+REAL(KIND=JPRB) :: ZCOSLAT(KSTART:KEND)
+
+! MNH
+REAL(KIND=JPRB) :: ZTIME,ZUT
+REAL(KIND=JPRB) :: ZTUT,ZSOLANG
+! MNH
+
+! Tangent of solar declination
+REAL(KIND=JPRB) :: ZTANDEC
+
+! Hour angles (=local solar time in radians plus pi)
+REAL(KIND=JPRB) :: ZHOURANGLESTART, ZHOURANGLEEND
+REAL(KIND=JPRB) :: ZHOURANGLESUNSET, ZCOSHOURANGLESUNSET
+
+INTEGER(KIND=JPIM) :: JCOL ! Column index
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+! ------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('COS_SZA',0,ZHOOK_HANDLE)
+
+! An average solar zenith angle can only be computed if the solar time
+! is centred on the time interval
+IF (LAVERAGESZA .AND. .NOT. LCENTREDTIMESZA) THEN
+ WRITE(NULOUT,*) 'ERROR IN COS_SZA: LAverageSZA=TRUE but LCentredTimeSZA=FALSE'
+ CALL ABOR1('COS_SZA: ABOR1 CALLED')
+ENDIF
+
+DO JCOL = KSTART,KEND
+ ZCOSLAT(JCOL) = SQRT(1.0_JPRB - PGEMU(JCOL)**2)
+ENDDO
+
+! Computation of solar hour angle from sunposn
+ZTIME = TDTRAD_FULL%XTIME + 0.5*XDTRAD
+ZUT = MOD( 24.0+MOD(ZTIME/3600.,24.0),24.0 )
+ZTUT = ZUT - XTSIDER
+ZSOLANG = (ZTUT-12.0)*15.0*(RPI/180.) ! hour angle in radians
+
+IF (LDRADIATIONTIMESTEP) THEN
+ ! Compute the effective cosine of solar zenith angle for a radiation
+ ! timestep
+
+ ! Precompute quantities that may be used more than once
+ DO JCOL = KSTART,KEND
+ ZSINDECSINLAT(JCOL) = XSINDEL * PGEMU(JCOL)
+ ZCOSDECCOSLAT(JCOL) = XCOSDEL * ZCOSLAT(JCOL)
+ ENDDO
+
+ IF (.NOT. LAVERAGESZA) THEN
+ ! Original method: compute the value at the centre of the
+ ! radiation timestep (assuming that LCentredTimeSZA=TRUE - see
+ ! updtim.F90)
+ DO JCOL = KSTART,KEND
+ ! It would be more efficient to do it like this...
+ ! PMU0(JCOL)=MAX(0.0_JPRB, ZSinDecSinLat(JCOL) &
+ ! & - ZCosDecCosLat(JCOL) * COS(YRERIP%RWSOVRM + PGELAM(JCOL)))
+ ! ...but for bit reproducibility with previous cycle we do it
+ ! like this:
+ PMU0(JCOL) = MAX(0.0_JPRB, ZSINDECSINLAT(JCOL) &
+ & - XCOSDEL*COS(ZSOLANG)*ZCOSLAT(JCOL)*COS(PGELAM(JCOL)) &
+ & + XCOSDEL*SIN(ZSOLANG)*ZCOSLAT(JCOL)*SIN(PGELAM(JCOL)))
+ ENDDO
+
+ ELSE
+ ! Compute the average MU0 for the period of the radiation
+ ! timestep, excluding times when the sun is below the horizon
+
+ ! First compute the sine and cosine of the times of the start and
+ ! end of the radiation timestep
+ ZHALFTIMESTEP = XTSTEP * REAL(NRADFR) * RPI / RDAY
+ ZSOLARTIMESTART = ZSOLANG - ZHALFTIMESTEP
+ ZSOLARTIMEEND = ZSOLANG + ZHALFTIMESTEP
+
+ ! Compute tangent of solar declination, with check in case someone
+ ! simulates a planet completely tipped over
+ ZTANDEC = XSINDEL / MAX(XCOSDEL, 1.0E-12)
+
+ DO JCOL = KSTART,KEND
+ ! Sunrise equation: cos(hour angle at sunset) =
+ ! -tan(declination)*tan(latitude)
+ ZCOSHOURANGLESUNSET = -ZTANDEC * PGEMU(JCOL) &
+ & / MAX(ZCOSLAT(JCOL), 1.0E-12)
+ IF (ZCOSHOURANGLESUNSET > 1.0) THEN
+ ! Perpetual darkness
+ PMU0(JCOL) = 0.0_JPRB
+ ELSE
+ ! Compute hour angle at start and end of time interval,
+ ! ensuring that the hour angle of the centre of the time
+ ! window is in the range -PI to +PI (equivalent to ensuring
+ ! that local solar time = solar time + longitude is in the
+ ! range 0 to 2PI)
+ IF (ZSOLANG + PGELAM(JCOL) < 2.0_JPRB*RPI) THEN
+ ZHOURANGLESTART = ZSOLARTIMESTART + PGELAM(JCOL) - RPI
+ ZHOURANGLEEND = ZSOLARTIMEEND + PGELAM(JCOL) - RPI
+ ELSE
+ ZHOURANGLESTART = ZSOLARTIMESTART + PGELAM(JCOL) - 3.0_JPRB*RPI
+ ZHOURANGLEEND = ZSOLARTIMEEND + PGELAM(JCOL) - 3.0_JPRB*RPI
+ ENDIF
+
+ IF (ZCOSHOURANGLESUNSET >= -1.0) THEN
+ ! Not perpetual daylight or perpetual darkness, so we need
+ ! to check for sunrise or sunset lying within the time
+ ! interval
+ ZHOURANGLESUNSET = ACOS(ZCOSHOURANGLESUNSET)
+ IF (ZHOURANGLEEND <= -ZHOURANGLESUNSET &
+ & .OR. ZHOURANGLESTART >= ZHOURANGLESUNSET) THEN
+ ! The time interval is either completely before sunrise or
+ ! completely after sunset
+ PMU0(JCOL) = 0.0_JPRB
+ CYCLE
+ ENDIF
+
+ ! Bound the start and end hour angles by sunrise and sunset
+ ZHOURANGLESTART = MAX(-ZHOURANGLESUNSET, &
+ & MIN(ZHOURANGLESTART, ZHOURANGLESUNSET))
+ ZHOURANGLEEND = MAX(-ZHOURANGLESUNSET, &
+ & MIN(ZHOURANGLEEND, ZHOURANGLESUNSET))
+ ENDIF
+
+ IF (ZHOURANGLEEND - ZHOURANGLESTART > 1.0E-8) THEN
+ ! Compute average MU0 in the interval ZHourAngleStart to
+ ! ZHourAngleEnd
+ PMU0(JCOL) = ZSINDECSINLAT(JCOL) &
+ & + (ZCOSDECCOSLAT(JCOL) &
+ & * (SIN(ZHOURANGLEEND) - SIN(ZHOURANGLESTART))) &
+ & / (ZHOURANGLEEND - ZHOURANGLESTART)
+
+ ! Just in case...
+ IF (PMU0(JCOL) < 0.0_JPRB) THEN
+ PMU0(JCOL) = 0.0_JPRB
+ ENDIF
+ ELSE
+ ! Too close to sunrise/sunset for a reliable calculation
+ PMU0(JCOL) = 0.0_JPRB
+ ENDIF
+
+ ENDIF
+ ENDDO
+ ENDIF
+
+ELSE
+ ! Compute the cosine of solar zenith angle for a model timestep
+
+ ! Precompute quantities that may be used more than once
+ DO JCOL = KSTART,KEND
+ ZSINDECSINLAT(JCOL) = XSINDEL * PGEMU(JCOL)
+ ZCOSDECCOSLAT(JCOL) = XCOSDEL * ZCOSLAT(JCOL)
+ ENDDO
+
+ IF (.NOT. LAVERAGESZA) THEN
+ ! Original method: compute the value at the centre of the
+ ! model timestep
+ DO JCOL = KSTART,KEND
+ ! It would be more efficient to do it like this...
+ ! PMU0(JCOL) = MAX(0.0_JPRB, ZSinDecSinLat(JCOL) &
+ ! & - ZCosDecCosLat(JCOL)*COS(YRRIP%RWSOVR + PGELAM(JCOL)))
+ ! ...but for bit reproducibility with previous cycle we do it
+ ! like this:
+ PMU0(JCOL) = MAX(0.0_JPRB, ZSINDECSINLAT(JCOL) &
+ & - XCOSDEL*COS(ZSOLANG)*ZCOSLAT(JCOL)*COS(PGELAM(JCOL)) &
+ & + XCOSDEL*SIN(ZSOLANG)*ZCOSLAT(JCOL)*SIN(PGELAM(JCOL)))
+ ENDDO
+
+ ELSE
+ ! Compute the average MU0 for the period of the model timestep
+
+ ! First compute the sine and cosine of the times of the start and
+ ! end of the model timestep
+ ZHALFTIMESTEP = XTSTEP * RPI / RDAY
+ ZSOLARTIMESTART = ZSOLANG - ZHALFTIMESTEP
+ ZSOLARTIMEEND = ZSOLANG + ZHALFTIMESTEP
+
+ ! Compute tangent of solar declination, with check in case someone
+ ! simulates a planet completely tipped over
+ ZTANDEC = XSINDEL / MAX(XCOSDEL, 1.0E-12)
+
+ DO JCOL = KSTART,KEND
+ ! Sunrise equation: cos(hour angle at sunset) =
+ ! -tan(declination)*tan(latitude)
+ ZCOSHOURANGLESUNSET = -ZTANDEC * PGEMU(JCOL) &
+ & / MAX(ZCOSLAT(JCOL), 1.0E-12)
+ IF (ZCOSHOURANGLESUNSET > 1.0) THEN
+ ! Perpetual darkness
+ PMU0(JCOL) = 0.0_JPRB
+ ELSE
+ ! Compute hour angle at start and end of time interval,
+ ! ensuring that the hour angle of the centre of the time
+ ! window is in the range -PI to +PI (equivalent to ensuring
+ ! that local solar time = solar time + longitude is in the
+ ! range 0 to 2PI)
+ IF (ZSOLANG + PGELAM(JCOL) < 2.0_JPRB*RPI) THEN
+ ZHOURANGLESTART = ZSOLARTIMESTART + PGELAM(JCOL) - RPI
+ ZHOURANGLEEND = ZSOLARTIMEEND + PGELAM(JCOL) - RPI
+ ELSE
+ ZHOURANGLESTART = ZSOLARTIMESTART + PGELAM(JCOL) - 3.0_JPRB*RPI
+ ZHOURANGLEEND = ZSOLARTIMEEND + PGELAM(JCOL) - 3.0_JPRB*RPI
+ ENDIF
+
+ IF (ZCOSHOURANGLESUNSET >= -1.0) THEN
+ ! Not perpetual daylight or perpetual darkness, so we need
+ ! to check for sunrise or sunset lying within the time
+ ! interval
+ ZHOURANGLESUNSET = ACOS(ZCOSHOURANGLESUNSET)
+ IF (ZHOURANGLEEND <= -ZHOURANGLESUNSET &
+ & .OR. ZHOURANGLESTART >= ZHOURANGLESUNSET) THEN
+ ! The time interval is either completely before sunrise or
+ ! completely after sunset
+ PMU0(JCOL) = 0.0_JPRB
+ CYCLE
+ ENDIF
+
+ ! Bound the start and end hour angles by sunrise and sunset
+ ZHOURANGLESTART = MAX(-ZHOURANGLESUNSET, &
+ & MIN(ZHOURANGLESTART, ZHOURANGLESUNSET))
+ ZHOURANGLEEND = MAX(-ZHOURANGLESUNSET, &
+ & MIN(ZHOURANGLEEND, ZHOURANGLESUNSET))
+ ENDIF
+
+ ! Compute average MU0 in the model timestep, although the
+ ! numerator considers only the time from ZHourAngleStart to
+ ! ZHourAngleEnd that the sun is above the horizon
+ PMU0(JCOL) = (ZSINDECSINLAT(JCOL) * (ZHOURANGLEEND-ZHOURANGLESTART) &
+ & + ZCOSDECCOSLAT(JCOL)*(SIN(ZHOURANGLEEND)-SIN(ZHOURANGLESTART))) &
+ & / (2.0_JPRB * ZHALFTIMESTEP)
+
+ ! This shouldn't ever result in negative values, but just in
+ ! case
+ IF (PMU0(JCOL) < 0.0_JPRB) THEN
+ PMU0(JCOL) = 0.0_JPRB
+ ENDIF
+
+ ENDIF
+ ENDDO
+ ENDIF
+
+ENDIF
+
+
+! ------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('COS_SZA',1,ZHOOK_HANDLE)
+END SUBROUTINE COS_SZA
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/easy_netcdf_read_mpi.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/easy_netcdf_read_mpi.F90
new file mode 100644
index 0000000000000000000000000000000000000000..d74399ba275d7765b8c4e0f46335f0e3eae8b52b
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/easy_netcdf_read_mpi.F90
@@ -0,0 +1,330 @@
+! easy_netcdf_read_mpi.f90 - Read netcdf file on one task and share with other tasks
+!
+! (C) Copyright 2017- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author: Robin Hogan
+! Email: r.j.hogan@ecmwf.int
+!
+
+module easy_netcdf_read_mpi
+
+ use easy_netcdf, only : netcdf_file_raw => netcdf_file
+ use parkind1, only : jpim, jprb
+ use radiation_io, only : nulout, nulerr, my_abort => radiation_abort
+
+ implicit none
+
+ ! MPI tag for radiation and physics communication
+ integer(kind=jpim), parameter :: mtagrad = 2800
+
+ !---------------------------------------------------------------------
+ ! An object of this type provides convenient read or write access to
+ ! a NetCDF file
+ type netcdf_file
+ type(netcdf_file_raw) :: file
+ logical :: is_master_task = .true.
+ contains
+ procedure :: open => open_netcdf_file
+ procedure :: close => close_netcdf_file
+ procedure :: get_real_scalar
+ procedure :: get_real_vector
+ procedure :: get_real_matrix
+ procedure :: get_real_array3
+ generic :: get => get_real_scalar, get_real_vector, &
+ & get_real_matrix, get_real_array3
+ procedure :: get_global_attribute
+
+ procedure :: set_verbose
+ procedure :: transpose_matrices
+ procedure :: exists
+ end type netcdf_file
+
+contains
+
+ ! --- GENERIC SUBROUTINES ---
+
+ !---------------------------------------------------------------------
+ ! Open a NetCDF file with name "file_name", optionally specifying the
+ ! verbosity level (0-5)
+ subroutine open_netcdf_file(this, file_name, iverbose)
+
+ !USE MPL_MODULE, ONLY : MPL_BROADCAST, MPL_MYRANK
+ USE MPL_BROADCAST_MOD , ONLY : MPL_BROADCAST
+ USE MPL_MYRANK_MOD , ONLY : MPL_MYRANK
+
+ class(netcdf_file) :: this
+ character(len=*), intent(in) :: file_name
+ integer, intent(in), optional :: iverbose
+
+ integer :: istatus
+
+ ! Store verbosity level in object
+ if (present(iverbose)) then
+ this%file%iverbose = iverbose
+ else
+ ! By default announce files being opened and closed, but not
+ ! variables read/written
+ this%file%iverbose = 2
+ end if
+
+ ! By default we don't transpose 2D arrays on read
+ this%file%do_transpose_2d = .false.
+
+ if (MPL_MYRANK() == 1) then
+ this%is_master_task = .true.
+ call this%file%open(file_name, iverbose)
+ else
+ this%is_master_task = .false.
+ end if
+
+ end subroutine open_netcdf_file
+
+
+ !---------------------------------------------------------------------
+ ! Close the NetCDF file
+ subroutine close_netcdf_file(this)
+ class(netcdf_file) :: this
+ integer :: istatus
+
+ if (this%is_master_task) then
+ call this%file%close()
+ end if
+
+ end subroutine close_netcdf_file
+
+
+ !---------------------------------------------------------------------
+ ! Set the verbosity level from 0 to 5, where the codes have the
+ ! following meaning: 0=errors only, 1=warning, 2=info, 3=progress,
+ ! 4=detailed, 5=debug
+ subroutine set_verbose(this, ival)
+ class(netcdf_file) :: this
+ integer, optional :: ival
+
+ if (present(ival)) then
+ this%file%iverbose = ival
+ else
+ this%file%iverbose = 2
+ end if
+
+ end subroutine set_verbose
+
+
+
+ !---------------------------------------------------------------------
+ ! Specify whether 2D arrays should be transposed on read
+ subroutine transpose_matrices(this, do_transpose)
+ class(netcdf_file) :: this
+ logical, optional :: do_transpose
+
+ if (present(do_transpose)) then
+ this%file%do_transpose_2d = do_transpose
+ else
+ this%file%do_transpose_2d = .true.
+ end if
+
+ end subroutine transpose_matrices
+
+
+
+ ! --- READING SUBROUTINES ---
+
+ !---------------------------------------------------------------------
+ ! Return true if the variable is present, false otherwise
+ function exists(this, var_name) result(is_present)
+
+ !USE MPL_MODULE, ONLY : MPL_BROADCAST, MPL_NPROC
+ USE MPL_BROADCAST_MOD , ONLY : MPL_BROADCAST
+ USE MPL_NPROC_MOD , ONLY : MPL_NPROC
+
+ class(netcdf_file) :: this
+ character(len=*), intent(in) :: var_name
+
+ logical :: is_present
+
+ if (this%is_master_task) then
+ is_present = this%file%exists(var_name)
+ end if
+
+ if (MPL_NPROC() > 1) then
+ CALL MPL_BROADCAST(is_present, mtagrad, 1, &
+ & CDSTRING='EASY_NETCDF_READ_MPI:EXISTS')
+ end if
+
+ end function exists
+
+
+ !---------------------------------------------------------------------
+ ! The method "get" will read either a scalar, vector or matrix
+ ! depending on the rank of the output argument. This version reads a
+ ! scalar.
+ subroutine get_real_scalar(this, var_name, scalar)
+
+ !USE MPL_MODULE, ONLY : MPL_BROADCAST, MPL_NPROC
+ USE MPL_BROADCAST_MOD , ONLY : MPL_BROADCAST
+ USE MPL_NPROC_MOD , ONLY : MPL_NPROC
+
+ class(netcdf_file) :: this
+ character(len=*), intent(in) :: var_name
+ real(jprb), intent(out) :: scalar
+
+ if (this%is_master_task) then
+ call this%file%get(var_name, scalar)
+ end if
+
+ if (MPL_NPROC() > 1) then
+ CALL MPL_BROADCAST(scalar, mtagrad, 1, &
+ & CDSTRING='EASY_NETCDF_READ_MPI:GET_REAL_SCALAR')
+ end if
+
+ end subroutine get_real_scalar
+
+
+ !---------------------------------------------------------------------
+ ! Read a 1D array into "vector", which must be allocatable and will
+ ! be reallocated if necessary
+ subroutine get_real_vector(this, var_name, vector)
+
+ !USE MPL_MODULE, ONLY : MPL_BROADCAST, MPL_NPROC
+ USE MPL_BROADCAST_MOD , ONLY : MPL_BROADCAST
+ USE MPL_NPROC_MOD , ONLY : MPL_NPROC
+
+ class(netcdf_file) :: this
+ character(len=*), intent(in) :: var_name
+ real(jprb), allocatable, intent(out) :: vector(:)
+
+ integer :: n ! Length of vector
+
+ n = 0
+
+ if (this%is_master_task) then
+ call this%file%get(var_name, vector)
+ n = size(vector)
+ end if
+
+ if (MPL_NPROC() > 1) then
+ CALL MPL_BROADCAST(n, mtagrad, 1, &
+ & CDSTRING='EASY_NETCDF_READ_MPI:GET_REAL_VECTOR:SIZE')
+
+ if (.not. this%is_master_task) then
+ allocate(vector(n))
+ end if
+
+ CALL MPL_BROADCAST(vector, mtagrad, 1, &
+ & CDSTRING='EASY_NETCDF_READ_MPI:GET_REAL_VECTOR')
+ end if
+
+ end subroutine get_real_vector
+
+
+ !---------------------------------------------------------------------
+ ! Read 2D array into "matrix", which must be allocatable and will be
+ ! reallocated if necessary. Whether to transpose is specifed by the
+ ! final optional argument, but can also be specified by the
+ ! do_transpose_2d class data member.
+ subroutine get_real_matrix(this, var_name, matrix, do_transp)
+
+ !USE MPL_MODULE, ONLY : MPL_BROADCAST, MPL_NPROC
+ USE MPL_BROADCAST_MOD , ONLY : MPL_BROADCAST
+ USE MPL_NPROC_MOD , ONLY : MPL_NPROC
+
+ class(netcdf_file) :: this
+ character(len=*), intent(in) :: var_name
+ real(jprb), allocatable, intent(out) :: matrix(:,:)
+ logical, optional, intent(in):: do_transp ! Transpose data?
+
+ integer :: n(2)
+
+ n = 0
+
+ if (this%is_master_task) then
+ call this%file%get(var_name, matrix, do_transp)
+ n = shape(matrix)
+ end if
+
+ if (MPL_NPROC() > 1) then
+ CALL MPL_BROADCAST(n, mtagrad, 1, &
+ & CDSTRING='EASY_NETCDF_READ_MPI:GET_REAL_MATRIX:SIZE')
+
+ if (.not. this%is_master_task) then
+ allocate(matrix(n(1),n(2)))
+ end if
+
+ CALL MPL_BROADCAST(matrix, mtagrad, 1, &
+ & CDSTRING='EASY_NETCDF_READ_MPI:GET_REAL_MATRIX')
+ end if
+
+ end subroutine get_real_matrix
+
+
+ !---------------------------------------------------------------------
+ ! Read 3D array into "var", which must be allocatable and will be
+ ! reallocated if necessary. Whether to pemute is specifed by the
+ ! final optional argument
+ subroutine get_real_array3(this, var_name, var, ipermute)
+
+ !USE MPL_MODULE, ONLY : MPL_BROADCAST, MPL_NPROC
+ USE MPL_BROADCAST_MOD , ONLY : MPL_BROADCAST
+ USE MPL_NPROC_MOD , ONLY : MPL_NPROC
+
+ class(netcdf_file) :: this
+ character(len=*), intent(in) :: var_name
+ real(jprb), allocatable, intent(out) :: var(:,:,:)
+ integer, optional, intent(in) :: ipermute(3)
+
+ integer :: n(3)
+
+ n = 0
+
+ if (this%is_master_task) then
+ call this%file%get(var_name, var, ipermute)
+ n = shape(var)
+ end if
+
+ if (MPL_NPROC() > 1) then
+ CALL MPL_BROADCAST(n, mtagrad, 1, &
+ & CDSTRING='EASY_NETCDF_READ_MPI:GET_REAL_ARRAY3:SIZE')
+
+ if (.not. this%is_master_task) then
+ allocate(var(n(1),n(2),n(3)))
+ end if
+
+ CALL MPL_BROADCAST(var, mtagrad, 1, &
+ & CDSTRING='EASY_NETCDF_READ_MPI:GET_REAL_ARRAY3')
+ end if
+
+ end subroutine get_real_array3
+
+
+ !---------------------------------------------------------------------
+ ! Get a global attribute as a character string
+ subroutine get_global_attribute(this, attr_name, attr_str)
+
+ !USE MPL_MODULE, ONLY : MPL_BROADCAST, MPL_NPROC
+ USE MPL_BROADCAST_MOD , ONLY : MPL_BROADCAST
+ USE MPL_NPROC_MOD , ONLY : MPL_NPROC
+
+ class(netcdf_file) :: this
+
+ character(len=*), intent(in) :: attr_name
+ character(len=*), intent(inout) :: attr_str
+
+ if (this%is_master_task) then
+ call this%file%get_global_attribute(attr_name, attr_str)
+ end if
+
+ if (MPL_NPROC() > 1) then
+ CALL MPL_BROADCAST(attr_str, mtagrad, 1, &
+ & CDSTRING='EASY_NETCDF_READ_MPI:GET_GLOBAL_ATTRIBUTE')
+ end if
+
+ end subroutine get_global_attribute
+
+end module easy_netcdf_read_mpi
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/ice_effective_radius.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/ice_effective_radius.F90
new file mode 100644
index 0000000000000000000000000000000000000000..bf49064711ac14753db719592bfd774e9a13b063
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/ice_effective_radius.F90
@@ -0,0 +1,213 @@
+! #################################
+ MODULE MODI_ICE_EFFECTIVE_RADIUS
+! #################################
+INTERFACE
+
+SUBROUTINE ICE_EFFECTIVE_RADIUS &
+ & (KIDIA, KFDIA, KLON, KLEV, &
+ & PPRESSURE, PTEMPERATURE, PCLOUD_FRAC, PQ_ICE, PQ_SNOW, PGEMU, &
+ & PRE_UM)
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+! INPUT ARGUMENTS
+
+! *** Array dimensions and ranges
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA ! Start column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA ! End column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KLON ! Number of columns
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV ! Number of levels
+
+! *** Variables on model levels
+REAL(KIND=JPRB), INTENT(IN) :: PPRESSURE(KLON,KLEV) ! (Pa)
+REAL(KIND=JPRB), INTENT(IN) :: PTEMPERATURE(KLON,KLEV) ! (K)
+REAL(KIND=JPRB), INTENT(IN) :: PCLOUD_FRAC(KLON,KLEV) ! (kg/kg)
+REAL(KIND=JPRB), INTENT(IN) :: PQ_ICE(KLON,KLEV) ! (kg/kg)
+REAL(KIND=JPRB), INTENT(IN) :: PQ_SNOW(KLON,KLEV) ! (kg/kg)
+
+! *** Single level variable
+REAL(KIND=JPRB), INTENT(IN) :: PGEMU(KLON) ! Sine of latitude
+
+! OUTPUT ARGUMENT
+! Effective radius
+REAL(KIND=JPRB), INTENT(OUT) :: PRE_UM(KLON,KLEV) ! (microns)
+
+END SUBROUTINE ICE_EFFECTIVE_RADIUS
+END INTERFACE
+END MODULE MODI_ICE_EFFECTIVE_RADIUS
+
+SUBROUTINE ICE_EFFECTIVE_RADIUS &
+ & (KIDIA, KFDIA, KLON, KLEV, &
+ & PPRESSURE, PTEMPERATURE, PCLOUD_FRAC, PQ_ICE, PQ_SNOW, PGEMU, &
+ & PRE_UM)
+
+! ICE_EFFECTIVE_RADIUS
+!
+! (C) Copyright 2016- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! PURPOSE
+! -------
+! Calculate effective radius of ice clouds
+!
+! AUTHOR
+! ------
+! Robin Hogan, ECMWF (using code extracted from radlswr.F90)
+! Original: 2016-02-24
+!
+! MODIFICATIONS
+! 2021-04-20 (Q. Libois) Compatibility with MNH
+! - embed in module with interface
+!
+!
+! -------------------------------------------------------------------
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!USE YOERAD , ONLY : YRERAD
+USE YOM_YGFL , ONLY : YGFL
+!USE YOECLDP , ONLY : YRECLDP
+USE YOERDU , ONLY : REPLOG, REPSCW
+USE YOMLUN , ONLY : NULERR
+USE YOMCST , ONLY : RD, RPI, RTT
+USE MODD_PARAM_ECRAD_n , ONLY : NRADIP, NMINICE, XRE2DE, XRMINICE ! ice optical properties model
+
+! -------------------------------------------------------------------
+
+IMPLICIT NONE
+
+! INPUT ARGUMENTS
+
+! *** Array dimensions and ranges
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA ! Start column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA ! End column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KLON ! Number of columns
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV ! Number of levels
+
+! *** Variables on model levels
+REAL(KIND=JPRB), INTENT(IN) :: PPRESSURE(KLON,KLEV) ! (Pa)
+REAL(KIND=JPRB), INTENT(IN) :: PTEMPERATURE(KLON,KLEV) ! (K)
+REAL(KIND=JPRB), INTENT(IN) :: PCLOUD_FRAC(KLON,KLEV) ! (kg/kg)
+REAL(KIND=JPRB), INTENT(IN) :: PQ_ICE(KLON,KLEV) ! (kg/kg)
+REAL(KIND=JPRB), INTENT(IN) :: PQ_SNOW(KLON,KLEV) ! (kg/kg)
+
+! *** Single level variable
+REAL(KIND=JPRB), INTENT(IN) :: PGEMU(KLON) ! Sine of latitude
+
+! OUTPUT ARGUMENT
+! Effective radius
+REAL(KIND=JPRB), INTENT(OUT) :: PRE_UM(KLON,KLEV) ! (microns)
+
+! LOCAL VARIABLES
+
+REAL(KIND=JPRB) :: ZIWC_INCLOUD_GM3 ! In-cloud ice+snow water content in g m-3
+REAL(KIND=JPRB) :: ZAIR_DENSITY_GM3 ! Air density in g m-3
+
+REAL(KIND=JPRB) :: ZTEMPERATURE_C ! Temperature, degrees Celcius
+REAL(KIND=JPRB) :: ZTEMP_FACTOR ! Temperature, Kelvin minus 83.15
+REAL(KIND=JPRB) :: ZAIWC, ZBIWC ! Factors in empirical relationship
+REAL(KIND=JPRB) :: ZDEFAULT_RE_UM ! Default effective radius in microns
+REAL(KIND=JPRB) :: ZDIAMETER_UM ! Effective diameter in microns
+
+! Min effective diameter in microns; may vary with latitude
+REAL(KIND=JPRB) :: ZMIN_DIAMETER_UM(KLON)
+
+INTEGER :: JL, JK
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+! -------------------------------------------------------------------
+
+#include "abor1.intfb.h"
+
+! -------------------------------------------------------------------
+
+IF (LHOOK) CALL DR_HOOK('ICE_EFFECTIVE_RADIUS',0,ZHOOK_HANDLE)
+
+! -------------------------------------------------------------------
+
+SELECT CASE(NRADIP)
+CASE(0)
+ ! Ice effective radius fixed at 40 microns
+ PRE_UM(KIDIA:KFDIA,:) = 40.0_JPRB
+
+CASE(1,2)
+ ! Ice effective radius from Liou and Ou (1994)
+ DO JK = 1,KLEV
+ DO JL = KIDIA,KFDIA
+ ! Convert Kelvin to Celcius, preventing positive numbers
+ ZTEMPERATURE_C = MIN(PTEMPERATURE(JL,JK) - RTT, -0.1)
+ ! Liou and Ou's empirical formula
+ PRE_UM(JL,JK) = 326.3_JPRB + ZTEMPERATURE_C * (12.42_JPRB &
+ & + ZTEMPERATURE_C * (0.197_JPRB + ZTEMPERATURE_C * 0.0012_JPRB))
+ IF (NRADIP == 1) THEN
+ ! Original Liou and Ou (1994) bounds of 40-130 microns
+ PRE_UM(JL,JK) = MAX(PRE_UM(JL,JK), 40.0_JPRB)
+ PRE_UM(JL,JK) = MIN(PRE_UM(JL,JK),130.0_JPRB)
+ ELSE
+ ! Formulation following Jakob, Klein modifications to ice
+ ! content
+ PRE_UM(JL,JK) = MAX(PRE_UM(JL,JK), 30.0_JPRB)
+ PRE_UM(JL,JK) = MIN(PRE_UM(JL,JK), 60.0_JPRB)
+ ENDIF
+ ENDDO
+ ENDDO
+
+CASE(3)
+ ! Ice effective radius = f(T,IWC) from Sun and Rikus (1999), revised
+ ! by Sun (2001)
+
+ ! Default effective radius is computed from an effective diameter of
+ ! 80 microns; note that multiplying by re2de actually converts from
+ ! effective diameter to effective radius.
+ ZDEFAULT_RE_UM = 80.0_JPRB * XRE2DE
+
+ ! Minimum effective diameter may vary with latitude
+ IF (NMINICE == 0) THEN
+ ! Constant effective diameter
+ ZMIN_DIAMETER_UM(KIDIA:KFDIA) = XRMINICE
+ ELSE
+ ! Ice effective radius varies with latitude, smaller at poles
+ DO JL = KIDIA,KFDIA
+ ZMIN_DIAMETER_UM(JL) = 20.0_JPRB + (XRMINICE - 20.0_JPRB) &
+ & * COS(ASIN(PGEMU(JL)))
+ ENDDO
+ ENDIF
+
+ DO JK = 1,KLEV
+ DO JL = KIDIA,KFDIA
+ IF (PCLOUD_FRAC(JL,JK) > 0.001_JPRB &
+ & .AND. (PQ_ICE(JL,JK)+PQ_SNOW(JL,JK)) > 0.0_JPRB) THEN
+ ZAIR_DENSITY_GM3 = 1000.0_JPRB * PPRESSURE(JL,JK) / (RD*PTEMPERATURE(JL,JK))
+ ZIWC_INCLOUD_GM3 = ZAIR_DENSITY_GM3 * (PQ_ICE(JL,JK) + PQ_SNOW(JL,JK)) &
+ & / PCLOUD_FRAC(JL,JK)
+ ZTEMPERATURE_C = PTEMPERATURE(JL,JK) - RTT
+ ! Sun, 2001 (corrected from Sun & Rikus, 1999)
+ ZAIWC = 45.8966_JPRB * ZIWC_INCLOUD_GM3**0.2214_JPRB
+ ZBIWC = 0.7957_JPRB * ZIWC_INCLOUD_GM3**0.2535_JPRB
+ ZDIAMETER_UM = (1.2351_JPRB + 0.0105_JPRB * ZTEMPERATURE_C) &
+ & * (ZAIWC + ZBIWC*(PTEMPERATURE(JL,JK) - 83.15_JPRB))
+ ZDIAMETER_UM = MIN ( MAX( ZDIAMETER_UM, ZMIN_DIAMETER_UM(JL)), 155.0_JPRB)
+ PRE_UM(JL,JK) = ZDIAMETER_UM * XRE2DE
+ ELSE
+ PRE_UM(JL,JK) = ZDEFAULT_RE_UM
+ ENDIF
+ ENDDO
+ ENDDO
+
+CASE DEFAULT
+ WRITE(NULERR,'(A,I0,A)') 'ICE EFFECTIVE RADIUS OPTION NRADLP=',NRADIP,' NOT AVAILABLE'
+ CALL ABOR1('ERROR IN ICE_EFFECTIVE_RADIUS')
+
+END SELECT
+
+! -------------------------------------------------------------------
+
+IF (LHOOK) CALL DR_HOOK('ICE_EFFECTIVE_RADIUS',1,ZHOOK_HANDLE)
+
+END SUBROUTINE ICE_EFFECTIVE_RADIUS
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/liquid_effective_radius.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/liquid_effective_radius.F90
new file mode 100644
index 0000000000000000000000000000000000000000..0478665d5bf3087112cb96987c4fead9674004b6
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/liquid_effective_radius.F90
@@ -0,0 +1,261 @@
+MODULE MODI_LIQUID_EFFECTIVE_RADIUS
+
+INTERFACE
+
+SUBROUTINE LIQUID_EFFECTIVE_RADIUS &
+ & (KIDIA, KFDIA, KLON, KLEV, &
+ & PPRESSURE, PTEMPERATURE, PCLOUD_FRAC, PQ_LIQ, PQ_RAIN, &
+ & PLAND_FRAC, PCCN_LAND, PCCN_SEA, &
+ & PRE_UM)
+
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+
+
+! INPUT ARGUMENTS
+
+! *** Array dimensions and ranges
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA ! Start column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA ! End column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KLON ! Number of columns
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV ! Number of levels
+
+! *** Variables on model levels
+REAL(KIND=JPRB), INTENT(IN) :: PPRESSURE(KLON,KLEV) ! (Pa)
+REAL(KIND=JPRB), INTENT(IN) :: PTEMPERATURE(KLON,KLEV) ! (K)
+REAL(KIND=JPRB), INTENT(IN) :: PCLOUD_FRAC(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PQ_LIQ(KLON,KLEV) ! (kg/kg)
+REAL(KIND=JPRB), INTENT(IN) :: PQ_RAIN(KLON,KLEV) ! (kg/kg)
+
+! *** Single-level variables
+REAL(KIND=JPRB), INTENT(IN) :: PLAND_FRAC(KLON) ! 1=land, 0=sea
+REAL(KIND=JPRB), INTENT(IN) :: PCCN_LAND(KLON)
+REAL(KIND=JPRB), INTENT(IN) :: PCCN_SEA(KLON)
+
+! OUTPUT ARGUMENT
+
+! Effective radius
+REAL(KIND=JPRB), INTENT(OUT) :: PRE_UM(KLON,KLEV) ! (microns)
+
+END SUBROUTINE LIQUID_EFFECTIVE_RADIUS
+END INTERFACE
+END MODULE MODI_LIQUID_EFFECTIVE_RADIUS
+
+SUBROUTINE LIQUID_EFFECTIVE_RADIUS &
+ & (KIDIA, KFDIA, KLON, KLEV, &
+ & PPRESSURE, PTEMPERATURE, PCLOUD_FRAC, PQ_LIQ, PQ_RAIN, &
+ & PLAND_FRAC, PCCN_LAND, PCCN_SEA, &
+ & PRE_UM)
+
+! LIQUID_EFFECTIVE_RADIUS
+!
+! (C) Copyright 2015- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! PURPOSE
+! -------
+! Calculate effective radius of liquid clouds
+!
+! AUTHOR
+! ------
+! Robin Hogan, ECMWF (using code extracted from radlswr.F90)
+! Original: 2015-09-24
+!
+! MODIFICATIONS
+! 2021-04-20 (Q. Libois) Compatibility with MNH
+! - embed in module with interface
+!
+!
+! -------------------------------------------------------------------
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+! USE YOERAD , ONLY : YRERAD
+USE MODD_PARAM_ECRAD_n , ONLY : NRADLP, NAERMACC, NMCVAR, XCCNSEA, XCCNLND, NAERCLD, &
+ & NACTAERO, LCCNO, LCCNL, XCCNLND, XCCNSEA
+USE YOM_YGFL , ONLY : YGFL
+!USE YOECLDP , ONLY : YRECLDP
+USE YOERDU , ONLY : REPLOG, REPSCW
+USE YOMLUN , ONLY : NULERR
+USE YOMCST , ONLY : RD, RPI
+
+! -------------------------------------------------------------------
+
+IMPLICIT NONE
+
+! INPUT ARGUMENTS
+
+! *** Array dimensions and ranges
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA ! Start column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA ! End column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KLON ! Number of columns
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV ! Number of levels
+
+! *** Variables on model levels
+REAL(KIND=JPRB), INTENT(IN) :: PPRESSURE(KLON,KLEV) ! (Pa)
+REAL(KIND=JPRB), INTENT(IN) :: PTEMPERATURE(KLON,KLEV) ! (K)
+REAL(KIND=JPRB), INTENT(IN) :: PCLOUD_FRAC(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PQ_LIQ(KLON,KLEV) ! (kg/kg)
+REAL(KIND=JPRB), INTENT(IN) :: PQ_RAIN(KLON,KLEV) ! (kg/kg)
+
+! *** Single-level variables
+REAL(KIND=JPRB), INTENT(IN) :: PLAND_FRAC(KLON) ! 1=land, 0=sea
+REAL(KIND=JPRB), INTENT(IN) :: PCCN_LAND(KLON)
+REAL(KIND=JPRB), INTENT(IN) :: PCCN_SEA(KLON)
+
+! OUTPUT ARGUMENT
+
+! Effective radius
+REAL(KIND=JPRB), INTENT(OUT) :: PRE_UM(KLON,KLEV) ! (microns)
+
+! PARAMETERS
+
+! Minimum and maximum effective radius, in microns
+REAL(KIND=JPRB), PARAMETER :: PP_MIN_RE_UM = 4.0_JPRB
+REAL(KIND=JPRB), PARAMETER :: PP_MAX_RE_UM = 30.0_JPRB
+
+! LOCAL VARIABLES
+INTEGER :: IRADLP ! ID of effective radius scheme to use
+INTEGER :: NACTIVE_AEROSOL ! Number of active aerosol
+REAL(KIND=JPRB) :: ZCCN ! CCN concentration (units?)
+
+REAL(KIND=JPRB) :: ZSPECTRAL_DISPERSION
+REAL(KIND=JPRB) :: ZNTOT_CM3 ! Number conc in cm-3
+REAL(KIND=JPRB) :: ZRE_CUBED
+REAL(KIND=JPRB) :: ZLWC_GM3, ZRWC_GM3 ! In-cloud liquid, rain content in g m-3
+REAL(KIND=JPRB) :: ZAIR_DENSITY_GM3 ! Air density in g m-3
+REAL(KIND=JPRB) :: ZRAIN_RATIO ! Ratio of rain to liquid water content
+REAL(KIND=JPRB) :: ZWOOD_FACTOR, ZRATIO
+
+INTEGER :: JL, JK
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+! -------------------------------------------------------------------
+
+#include "abor1.intfb.h"
+
+! -------------------------------------------------------------------
+
+IF (LHOOK) CALL DR_HOOK('LIQUID_EFFECTIVE_RADIUS',0,ZHOOK_HANDLE)
+
+! -------------------------------------------------------------------
+
+! Reproduce logic from RADLSWR
+NACTIVE_AEROSOL = NACTAERO
+IF (NACTAERO == 0 .AND. NAERMACC == 1) NACTIVE_AEROSOL = NMCVAR
+IRADLP = NRADLP
+IF (NACTIVE_AEROSOL >= 12 .AND. NAERCLD > 0 ) IRADLP=3
+
+SELECT CASE(IRADLP)
+CASE(0)
+ ! Very old parameterization as a function of pressure, used in ERA-15
+ PRE_UM(KIDIA:KFDIA,:) = 10.0_JPRB &
+ & + (100000.0_JPRB-PPRESSURE(KIDIA:KFDIA,:))*3.5_JPRB
+
+CASE(1)
+ ! Simple distinction between land (10um) and ocean (13um) by Zhang
+ ! and Rossow
+ DO JL = KIDIA,KFDIA
+ IF (PLAND_FRAC(JL) < 0.5_JPRB) THEN
+ PRE_UM(JL,:) = 13.0_JPRB
+ ELSE
+ PRE_UM(JL,:) = 10.0_JPRB
+ ENDIF
+ ENDDO
+
+CASE(2)
+ ! Martin et al. (JAS 1994)
+ DO JL = KIDIA,KFDIA
+ ! First compute the cloud droplet concentration
+ IF (PLAND_FRAC(JL) < 0.5_JPRB) THEN
+ ! Sea case
+ IF (LCCNO) THEN
+ ZCCN = PCCN_SEA(JL)
+ ELSE
+ ZCCN = XCCNSEA
+ ENDIF
+ ZSPECTRAL_DISPERSION = 0.77_JPRB
+ ! Cloud droplet concentration in cm-3 (activated CCN) over
+ ! ocean
+ ZNTOT_CM3 = -1.15E-03_JPRB*ZCCN*ZCCN + 0.963_JPRB*ZCCN + 5.30_JPRB
+ ELSE
+ ! Land case
+ IF (LCCNL) THEN
+ ZCCN=PCCN_LAND(JL)
+ ELSE
+ ZCCN = XCCNLND
+ ENDIF
+ ZSPECTRAL_DISPERSION = 0.69_JPRB
+ ! Cloud droplet concentration in cm-3 (activated CCN) over
+ ! land
+ ZNTOT_CM3 = -2.10E-04_JPRB*ZCCN*ZCCN + 0.568_JPRB*ZCCN - 27.9_JPRB
+ ENDIF
+
+ ZRATIO = (0.222_JPRB/ZSPECTRAL_DISPERSION)**0.333_JPRB
+
+ DO JK = 1,KLEV
+
+ ! Only consider cloudy regions
+ IF (PCLOUD_FRAC(JL,JK) >= 0.001_JPRB &
+ & .AND. (PQ_LIQ(JL,JK)+PQ_RAIN(JL,JK)) > 0.0_JPRB) THEN
+
+ ! Compute liquid and rain water contents
+ ZAIR_DENSITY_GM3 = 1000.0_JPRB * PPRESSURE(JL,JK) &
+ & / (RD*PTEMPERATURE(JL,JK))
+ ! In-cloud mean water contents found by dividing by cloud
+ ! fraction
+ ZLWC_GM3 = ZAIR_DENSITY_GM3 * PQ_LIQ(JL,JK) / PCLOUD_FRAC(JL,JK)
+ ZRWC_GM3 = ZAIR_DENSITY_GM3 * PQ_RAIN(JL,JK) / PCLOUD_FRAC(JL,JK)
+
+ ! Wood's (2000, eq. 19) adjustment to Martin et al's
+ ! parameterization
+ IF (ZLWC_GM3 > REPSCW) THEN
+ ZRAIN_RATIO = ZRWC_GM3 / ZLWC_GM3
+ ZWOOD_FACTOR = ((1.0_JPRB + ZRAIN_RATIO)**0.666_JPRB) &
+ & / (1.0_JPRB + 0.2_JPRB * ZRATIO*ZRAIN_RATIO)
+ ELSE
+ ZWOOD_FACTOR = 1.0_JPRB
+ ENDIF
+
+ ! g m-3 and cm-3 units cancel out with density of water
+ ! 10^6/(1000*1000); need a factor of 10^6 to convert to
+ ! microns and cubed root is factor of 100 which appears in
+ ! equation below
+ ZRE_CUBED = (3.0_JPRB * (ZLWC_GM3 + ZRWC_GM3)) &
+ & / (4.0_JPRB*RPI*ZNTOT_CM3*ZSPECTRAL_DISPERSION)
+ IF (ZRE_CUBED > REPLOG) THEN
+ PRE_UM(JL,JK) = ZWOOD_FACTOR*100.0_JPRB*EXP(0.333_JPRB*LOG(ZRE_CUBED))
+ ! Make sure effective radius is bounded in range 4-30 microns
+ PRE_UM(JL,JK) = MAX(PP_MIN_RE_UM, MIN(PRE_UM(JL,JK), PP_MAX_RE_UM))
+ ELSE
+ PRE_UM(JL,JK) = PP_MIN_RE_UM
+ ENDIF
+
+ ELSE
+ ! Cloud fraction or liquid+rain water content too low to
+ ! consider this a cloud
+ PRE_UM(JL,JK) = PP_MIN_RE_UM
+
+ ENDIF
+
+ ENDDO
+
+ ENDDO
+
+CASE DEFAULT
+ WRITE(NULERR,'(A,I0,A)') 'LIQUID EFFECTIVE RADIUS OPTION IRADLP=',IRADLP,' NOT AVAILABLE'
+ CALL ABOR1('ERROR IN LIQUID_EFFECTIVE_RADIUS')
+END SELECT
+
+! -------------------------------------------------------------------
+
+IF (LHOOK) CALL DR_HOOK('LIQUID_EFFECTIVE_RADIUS',1,ZHOOK_HANDLE)
+
+END SUBROUTINE LIQUID_EFFECTIVE_RADIUS
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/radiation_scheme.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/radiation_scheme.F90
new file mode 100644
index 0000000000000000000000000000000000000000..06cd9e27126ab46ca69f02066a47b3e6115af03b
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/radiation_scheme.F90
@@ -0,0 +1,663 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/ecmwf_radiation_vers2.f90,v $ $Revision: 1.3.2.4.2.2.2.1 $
+! masdev4_7 BUG1 2007/06/15 17:47:17
+!-----------------------------------------------------------------
+! #################################
+ MODULE MODI_RADIATION_SCHEME
+! #################################
+
+CONTAINS
+
+SUBROUTINE RADIATION_SCHEME &
+ & (KIDIA, KFDIA, KLON, KLEV, KAEROSOL, &
+ & PSOLAR_IRRADIANCE, &
+ & PMU0, PTEMPERATURE_SKIN, PALBEDO_DIF, PALBEDO_DIR, &
+ & PEMIS, PEMIS_WINDOW, &
+ & PCCN_LAND, PCCN_SEA, &
+ & PGELAM, PGEMU, PLAND_SEA_MASK, &
+ & PPRESSURE, PTEMPERATURE, &
+ & PPRESSURE_H, PTEMPERATURE_H, &
+ & PQ, PCO2, PCH4, PN2O, PNO2, PCFC11, PCFC12, PHCFC22, PCCL4, PO3_DP, &
+ & PCLOUD_FRAC, PQ_LIQUID, PQ_ICE, PQ_RAIN, PQ_SNOW, &
+ & PAEROSOL_OLD, PAEROSOL, &
+ & PFLUX_SW, PFLUX_LW, PFLUX_SW_CLEAR, PFLUX_LW_CLEAR, &
+ & PFLUX_SW_SURF, PFLUX_LW_SURF, PFLUX_SW_SURF_CLEAR, PFLUX_LW_SURF_CLEAR, &
+ & PFLUX_DIR_SURF, PFLUX_DIR_SURF_CLEAR, PFLUX_DIR_SURF_INTO_SUN, &
+ & PFLUX_UV, PFLUX_PAR, PFLUX_PAR_CLEAR, &
+ & PFLUX_SW_DN_TOA,PFLUX_SW_UP_TOA,PFLUX_LW_UP_TOA, &
+ & PFLUX_SW_UP_TOA_CLEAR,PFLUX_LW_UP_TOA_CLEAR, &
+ & PFLUX_SW_DN, PFLUX_LW_DN, PFLUX_SW_UP, PFLUX_LW_UP, &
+ & PFLUX_SW_DN_CLEAR, PFLUX_LW_DN_CLEAR, PFLUX_SW_UP_CLEAR, PFLUX_LW_UP_CLEAR, &
+ & PRE_LIQUID_UM, PRE_ICE_UM, &
+ & PEMIS_OUT, PLWDERIVATIVE, &
+ & PSWDIFFUSEBAND, PSWDIRECTBAND)
+
+! RADIATION_SCHEME - Interface to modular radiation scheme
+!
+! (C) Copyright 2015- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! PURPOSE
+! -------
+! The modular radiation scheme is contained in a separate
+! library. This routine puts the the IFS arrays into appropriate
+! objects, computing the additional data that is required, and sends
+! it to the radiation scheme. It returns net fluxes and surface
+! flux components needed by the rest of the model.
+!
+! Lower case is used for variables and types taken from the
+! radiation library
+!
+! INTERFACE
+! ---------
+! RADIATION_SCHEME is called from RADLSWR. The
+! SETUP_RADIATION_SCHEME routine (in the RADIATION_SETUP module)
+! should have been run first.
+!
+! AUTHOR
+! ------
+! Robin Hogan, ECMWF
+! Original: 2015-09-16
+! Modifications by
+!
+! MODIFICATIONS
+! 2021-04-20 (Quentin Libois) Compatibility with Meso-NH
+! - adding extra output variables in RADIATION_SCHEME
+! - adding module container
+! - removing include *.h
+! - loading parameters from appropriate modules
+! - removing unexisting modules
+! - adding spectral dimension for SW fluxes
+! - using MNH saturation vapor pressure function
+!
+! TO DO
+! -----
+!
+!-----------------------------------------------------------------------
+
+! Modules from ifs or ifsaux libraries
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+
+! MNH
+! USE YOERAD , ONLY : YRERAD YRERAD ! does not exist in MNH
+USE MODD_PARAM_ECRAD_n, ONLY : NAERMACC, NDECOLAT, XCLOUD_FRAC_STD, & ! get parameters from module
+ & LAPPROXLWUPDATE, LAPPROXSWUPDATE, &
+ & LSPEC_ALB, LSPEC_EMISS, LRRTM, &
+ & USER_ALB_DIFF, USER_ALB_DIR, USER_EMISS, &
+ & SURF_TYPE
+
+USE MODI_READ_ALBEDO_DATA , ONLY : READ_ALBEDO_DATA
+USE MODI_READ_EMISS_DATA , ONLY : READ_EMISS_DATA
+USE MODD_RADIATIONS_n , ONLY : NSWB_MNH, NLWB_MNH, NSWB_OLD
+USE MODE_THERMO ! , ONLY QSATW_2D
+USE MODD_DYN_n , ONLY : XTSTEP, NSTOP
+USE MODD_TIME , ONLY : TDTEXP
+USE MODD_TIME_n , ONLY : TDTMOD,TDTCUR
+USE MODI_ICE_EFFECTIVE_RADIUS
+USE MODI_LIQUID_EFFECTIVE_RADIUS
+USE MODI_CLOUD_OVERLAP_DECORR_LEN
+USE MODD_LUNIT_n , ONLY : TLUOUT
+! MNH
+
+USE RADIATION_SETUP, ONLY : rad_config, &
+ & NWEIGHT_UV, IBAND_UV, WEIGHT_UV, &
+ & NWEIGHT_PAR, IBAND_PAR, WEIGHT_PAR, &
+ & ITYPE_TROP_BG_AER, TROP_BG_AER_MASS_EXT, &
+ & ITYPE_STRAT_BG_AER, STRAT_BG_AER_MASS_EXT
+
+!USE YOMRIP0 , ONLY : NINDAT ! does not exist in MNH
+!USE YOMCT3 , ONLY : NSTEP ! does not exist in MNH
+!USE YOMRIP , ONLY : YRRIP ! does not exist in MNH
+
+USE YOMCST , ONLY : RSIGMA ! Stefan-Boltzmann constant
+
+! Modules from radiation library
+USE radiation_single_level, ONLY : single_level_type
+USE radiation_thermodynamics, ONLY : thermodynamics_type
+USE radiation_gas
+USE radiation_cloud, ONLY : cloud_type
+USE radiation_aerosol, ONLY : aerosol_type
+USE radiation_flux, ONLY : flux_type
+USE radiation_interface, ONLY : radiation, set_gas_units
+USE radiation_save, ONLY : save_inputs
+
+IMPLICIT NONE
+
+! INPUT ARGUMENTS
+
+! *** Array dimensions and ranges
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA ! Start column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA ! End column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KLON ! Number of columns
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV ! Number of levels
+INTEGER(KIND=JPIM),INTENT(IN) :: KAEROSOL ! Number of aerosol types
+
+! *** Single-level fields
+REAL(KIND=JPRB), INTENT(IN) :: PSOLAR_IRRADIANCE ! (W m-2)
+REAL(KIND=JPRB), INTENT(IN) :: PMU0(KLON) ! Cosine of solar zenith ang
+REAL(KIND=JPRB), INTENT(IN) :: PTEMPERATURE_SKIN(KLON) ! (K)
+! Diffuse and direct components of surface shortwave albedo
+REAL(KIND=JPRB), INTENT(IN) :: PALBEDO_DIF(KLON,NSWB_OLD)
+REAL(KIND=JPRB), INTENT(IN) :: PALBEDO_DIR(KLON,NSWB_OLD)
+! Longwave emissivity outside and inside the window region
+REAL(KIND=JPRB), INTENT(IN) :: PEMIS(KLON)
+REAL(KIND=JPRB), INTENT(IN) :: PEMIS_WINDOW(KLON)
+! Longitude (radians), sine of latitude
+REAL(KIND=JPRB), INTENT(IN) :: PGELAM(KLON)
+REAL(KIND=JPRB), INTENT(IN) :: PGEMU(KLON)
+! Land-sea mask
+REAL(KIND=JPRB), INTENT(IN) :: PLAND_SEA_MASK(KLON)
+
+! *** Variables on full levels
+REAL(KIND=JPRB), INTENT(IN) :: PPRESSURE(KLON,KLEV) ! (Pa)
+REAL(KIND=JPRB), INTENT(IN) :: PTEMPERATURE(KLON,KLEV) ! (K)
+! *** Variables on half levels
+REAL(KIND=JPRB), INTENT(IN) :: PPRESSURE_H(KLON,KLEV+1) ! (Pa)
+REAL(KIND=JPRB), INTENT(IN) :: PTEMPERATURE_H(KLON,KLEV+1) ! (K)
+
+! *** Gas mass mixing ratios on full levels
+REAL(KIND=JPRB), INTENT(IN) :: PQ(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PCO2(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PCH4(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PN2O(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PNO2(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PCFC11(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PCFC12(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PHCFC22(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PCCL4(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PO3_DP(KLON,KLEV) ! (Pa*kg/kg) !
+
+! *** Cloud fraction and hydrometeor mass mixing ratios
+REAL(KIND=JPRB), INTENT(IN) :: PCLOUD_FRAC(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PQ_LIQUID(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PQ_ICE(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PQ_RAIN(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PQ_SNOW(KLON,KLEV)
+
+! *** Aerosol mass mixing ratios
+REAL(KIND=JPRB), INTENT(IN) :: PAEROSOL_OLD(KLON,6,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PAEROSOL(KLON,KLEV,KAEROSOL)
+
+REAL(KIND=JPRB), INTENT(IN) :: PCCN_LAND(KLON)
+REAL(KIND=JPRB), INTENT(IN) :: PCCN_SEA(KLON)
+
+! OUTPUT ARGUMENTS
+
+! *** Net fluxes on half-levels (W m-2)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_SW(KLON,KLEV+1)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_LW(KLON,KLEV+1)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_SW_CLEAR(KLON,KLEV+1)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_LW_CLEAR(KLON,KLEV+1)
+
+! *** Surface flux components (W m-2)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_SW_SURF(KLON,NSWB_MNH)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_LW_SURF(KLON)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_SW_SURF_CLEAR(KLON,NSWB_MNH)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_LW_SURF_CLEAR(KLON)
+! Direct component of surface flux into horizontal plane
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_DIR_SURF(KLON,NSWB_MNH)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_DIR_SURF_CLEAR(KLON,NSWB_MNH)
+! As PFLUX_DIR but into a plane perpendicular to the sun
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_DIR_SURF_INTO_SUN(KLON,NSWB_MNH)
+
+! *** Ultraviolet and photosynthetically active radiation (W m-2)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_UV(KLON)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_PAR(KLON)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_PAR_CLEAR(KLON)
+
+! *** Other single-level diagnostics
+! Top-of-atmosphere fluxes flux (W m-2)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_SW_DN_TOA(KLON)
+
+! MNH
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_SW_UP_TOA(KLON)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_LW_UP_TOA(KLON)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_SW_UP_TOA_CLEAR(KLON)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_LW_UP_TOA_CLEAR(KLON)
+
+! Total fluxes - QL
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_SW_DN(KLON,KLEV+1)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_LW_DN(KLON,KLEV+1)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_SW_DN_CLEAR(KLON,KLEV+1)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_LW_DN_CLEAR(KLON,KLEV+1)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_SW_UP(KLON,KLEV+1)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_LW_UP(KLON,KLEV+1)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_SW_UP_CLEAR(KLON,KLEV+1)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_LW_UP_CLEAR(KLON,KLEV+1)
+
+! Cloud effective radii in microns
+REAL(KIND=JPRB), INTENT(OUT) :: PRE_LIQUID_UM(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(OUT) :: PRE_ICE_UM(KLON,KLEV)
+! MNH
+
+! Diagnosed longwave surface emissivity across the whole spectrum
+REAL(KIND=JPRB), INTENT(OUT) :: PEMIS_OUT(KLON)
+
+! Partial derivative of total-sky longwave upward flux at each level
+! with respect to upward flux at surface, used to correct heating
+! rates at gridpoints/timesteps between calls to the full radiation
+! scheme. Note that this version uses the convention of level index
+! increasing downwards, unlike the local variable ZLwDerivative that
+! is returned from the LW radiation scheme.
+REAL(KIND=JPRB), INTENT(OUT) :: PLWDERIVATIVE(KLON,KLEV+1)
+
+! Surface diffuse and direct downwelling shortwave flux in each
+! shortwave albedo band, used in RADINTG to update the surface fluxes
+! accounting for high-resolution albedo information
+REAL(KIND=JPRB), INTENT(OUT) :: PSWDIFFUSEBAND(KLON,NSWB_MNH)
+REAL(KIND=JPRB), INTENT(OUT) :: PSWDIRECTBAND (KLON,NSWB_MNH)
+
+! LOCAL VARIABLES
+TYPE(single_level_type) :: single_level
+TYPE(thermodynamics_type) :: thermodynamics
+TYPE(gas_type) :: gas
+TYPE(cloud_type) :: cloud
+TYPE(aerosol_type) :: aerosol
+TYPE(flux_type) :: flux
+
+! Mass mixing ratio of ozone (kg/kg)
+REAL(KIND=JPRB) :: ZO3(KLON,KLEV)
+
+! Cloud overlap decorrelation length for cloud boundaries in km
+REAL(KIND=JPRB) :: ZDECORR_LEN_KM(KLON)
+
+! Ratio of cloud overlap decorrelation length for cloud water
+! inhomogeneities to that for cloud boundaries (typically 0.5)
+REAL(KIND=JPRB) :: ZDECORR_LEN_RATIO
+
+! The surface net longwave flux if the surface was a black body, used
+! to compute the effective broadband surface emissivity
+REAL(KIND=JPRB) :: ZBLACK_BODY_NET_LW(KIDIA:KFDIA)
+
+! Layer mass in kg m-2
+REAL(KIND=JPRB) :: ZLAYER_MASS(KIDIA:KFDIA,KLEV)
+
+! Time integers
+INTEGER :: ITIM, IDAY
+
+! Loop indices
+INTEGER :: JLON, JLEV, JBAND, JB_ALBEDO, JAER
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+! Import time functions for iseed calculation
+!#include "fcttim.func.h"
+!#include "liquid_effective_radius.intfb.h"
+!#include "ice_effective_radius.intfb.h"
+!#include "cloud_overlap_decorr_len.intfb.h"
+!#include "satur.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME',0,ZHOOK_HANDLE)
+
+! Allocate memory in radiation objects
+! Albedo and emissivities already on RRTM bands if CRAD="ECRA"
+if (LSPEC_ALB) then
+ CALL single_level%allocate(KLON, 14, NLWB_MNH, &
+ & use_sw_albedo_direct=.TRUE.)
+else
+ CALL single_level%allocate(KLON, 6, NLWB_MNH, &
+ & use_sw_albedo_direct=.TRUE.)
+end if
+
+CALL thermodynamics%allocate(KLON, KLEV, use_h2o_sat=.true.)
+CALL gas%allocate(KLON, KLEV)
+CALL cloud%allocate(KLON, KLEV)
+IF (NAERMACC > 0) THEN
+ CALL aerosol%allocate(KLON, 1, KLEV, KAEROSOL) ! MACC climatology
+ELSE
+ CALL aerosol%allocate(KLON, 1, KLEV, 6) ! Tegen climatology
+ENDIF
+CALL flux%allocate(rad_config, 1, KLON, KLEV)
+
+! Set thermodynamic profiles: simply copy over the half-level
+! pressure and temperature
+thermodynamics%pressure_hl (KIDIA:KFDIA,:) = PPRESSURE_H (KIDIA:KFDIA,:)
+thermodynamics%temperature_hl(KIDIA:KFDIA,:) = PTEMPERATURE_H(KIDIA:KFDIA,:)
+
+! IFS currently sets the half-level temperature at the surface to be
+! equal to the skin temperature. The radiation scheme takes as input
+! only the half-level temperatures and assumes the Planck function to
+! vary linearly in optical depth between half levels. In the lowest
+! atmospheric layer, where the atmospheric temperature can be much
+! cooler than the skin temperature, this can lead to significant
+! differences between the effective temperature of this lowest layer
+! and the true value in the model.
+!
+! We may approximate the temperature profile in the lowest model level
+! as piecewise linear between the top of the layer T[k-1/2], the
+! centre of the layer T[k] and the base of the layer Tskin. The mean
+! temperature of the layer is then 0.25*T[k-1/2] + 0.5*T[k] +
+! 0.25*Tskin, which can be achieved by setting the atmospheric
+! temperature at the half-level corresponding to the surface as
+! follows:
+thermodynamics%temperature_hl(KIDIA:KFDIA,KLEV+1) &
+ & = PTEMPERATURE(KIDIA:KFDIA,KLEV) &
+ & + 0.5_JPRB * (PTEMPERATURE_H(KIDIA:KFDIA,KLEV+1) &
+ & -PTEMPERATURE_H(KIDIA:KFDIA,KLEV))
+
+! Alternatively we respect the model's atmospheric temperature in the
+! lowest model level by setting the temperature at the lowest
+! half-level such that the mean temperature of the layer is correct:
+!thermodynamics%temperature_hl(KIDIA:KFDIA,KLEV+1) &
+! & = 2.0_JPRB * PTEMPERATURE(KIDIA:KFDIA,KLEV) &
+! & - PTEMPERATURE_H(KIDIA:KFDIA,KLEV)
+
+! Compute saturation specific humidity, used to hydrate aerosols. The
+! "2" for the last argument indicates that the routine is not being
+! called from within the convection scheme.
+!JUAN LIKE ecrad-1.0.1 CALL SATUR(KIDIA, KFDIA, KLON, 1, KLEV, &
+!JUAN LIKE ecrad-1.0.1 & PPRESSURE, PTEMPERATURE, thermodynamics%h2o_sat_liq, 2)
+
+!MNH
+thermodynamics%h2o_sat_liq(:,:) = QSAT(REAL(PPRESSURE), REAL(PTEMPERATURE))
+thermodynamics%h2o_sat_liq(:,:) = thermodynamics%h2o_sat_liq(:,:) &
+ & / (1.+thermodynamics%h2o_sat_liq(:,:)) ! mixing ratio => spec humid
+! MNH
+
+! Alternative approximate version using temperature and pressure from
+! the thermodynamics structure
+!CALL thermodynamics%calc_saturation_wrt_liquid(KIDIA, KFDIA)
+
+! Set single-level fileds
+single_level%solar_irradiance = PSOLAR_IRRADIANCE
+single_level%cos_sza(KIDIA:KFDIA) = PMU0(KIDIA:KFDIA)
+single_level%skin_temperature(KIDIA:KFDIA) = PTEMPERATURE_SKIN(KIDIA:KFDIA)
+
+
+! Use albedo from namelist if LSPEC_ALB=T
+if (LSPEC_ALB) then
+ ! Band of input albedo in which to read each ecRad bands
+ ! Last band in ecRad SW is 820-2600 cm-1
+ rad_config%i_albedo_from_band_sw = (/ 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 1 /)
+ ! READ ALBEDO FROM SURF_TYPE
+ CALL READ_ALBEDO_DATA(SURF_TYPE)
+ DO JLON = KIDIA, KFDIA
+ single_level%sw_albedo(JLON,:) = USER_ALB_DIFF(:)
+ single_level%sw_albedo_direct(JLON,:) = USER_ALB_DIR(:)
+ END DO
+else
+ single_level%sw_albedo(KIDIA:KFDIA,:) = PALBEDO_DIF(KIDIA:KFDIA,:)
+ single_level%sw_albedo_direct(KIDIA:KFDIA,:) = PALBEDO_DIR(KIDIA:KFDIA,:)
+end if
+
+if (LSPEC_EMISS) then
+ rad_config%i_emiss_from_band_lw = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16 /)
+ CALL READ_EMISS_DATA(SURF_TYPE)
+ DO JLON = KIDIA, KFDIA
+ single_level%lw_emissivity(JLON,:) = USER_EMISS(:)
+ END DO
+else
+ ! Longwave emissivity is in two bands
+ single_level%lw_emissivity(KIDIA:KFDIA,1) = PEMIS(KIDIA:KFDIA)
+ single_level%lw_emissivity(KIDIA:KFDIA,2) = PEMIS_WINDOW(KIDIA:KFDIA)
+end if
+
+! Create the relevant seed from date and time get the starting day
+! and number of minutes since start
+
+! MNH
+IDAY = TDTEXP%NDAY
+ITIM = NINT(TDTMOD%xtime-TDTCUR%xtime / 60.0_JPRB) ! number of minutes since beginning
+! MNH
+
+DO JLON = KIDIA, KFDIA
+ ! This method gives a unique value for roughly every 1-km square
+ ! on the globe and every minute. ASIN(PGEMU)*60 gives rough
+ ! latitude in degrees, which we multiply by 100 to give a unique
+ ! value for roughly every km. PGELAM*60*100 gives a unique number
+ ! for roughly every km of longitude around the equator, which we
+ ! multiply by 180*100 so there is no overlap with the latitude
+ ! values. The result can be contained in a 32-byte integer (but
+ ! since random numbers are generated with the help of integer
+ ! overflow, it should not matter if the number did overflow).
+ single_level%iseed(JLON) = ITIM + IDAY &
+ & + NINT(PGELAM(JLON)*108000000.0_JPRB &
+ & + ASIN(PGEMU(JLON))*6000.0_JPRB)
+ENDDO
+
+! Set cloud fields
+cloud%q_liq(KIDIA:KFDIA,:) = PQ_LIQUID(KIDIA:KFDIA,:)
+cloud%q_ice(KIDIA:KFDIA,:) = PQ_ICE(KIDIA:KFDIA,:) + PQ_SNOW(KIDIA:KFDIA,:)
+cloud%fraction(KIDIA:KFDIA,:) = PCLOUD_FRAC(KIDIA:KFDIA,:)
+
+! Compute effective radii and convert to metres
+CALL LIQUID_EFFECTIVE_RADIUS(KIDIA, KFDIA, KLON, KLEV, &
+ & PPRESSURE, PTEMPERATURE, PCLOUD_FRAC, PQ_LIQUID, PQ_RAIN, &
+ & PLAND_SEA_MASK, PCCN_LAND, PCCN_SEA, &
+ & PRE_LIQUID_UM)
+cloud%re_liq(KIDIA:KFDIA,:) = PRE_LIQUID_UM(KIDIA:KFDIA,:) * 1.0e-6_JPRB
+
+CALL ICE_EFFECTIVE_RADIUS(KIDIA, KFDIA, KLON, KLEV, &
+ & PPRESSURE, PTEMPERATURE, PCLOUD_FRAC, PQ_ICE, PQ_SNOW, PGEMU, &
+ & PRE_ICE_UM)
+cloud%re_ice(KIDIA:KFDIA,:) = PRE_ICE_UM(KIDIA:KFDIA,:) * 1.0e-6_JPRB
+
+! Get the cloud overlap decorrelation length (for cloud boundaries),
+! in km, according to the parameterization specified by NDECOLAT,
+! and insert into the "cloud" object. Also get the ratio of
+! decorrelation lengths for cloud water content inhomogeneities and
+! cloud boundaries, and set it in the "rad_config" object.
+CALL CLOUD_OVERLAP_DECORR_LEN(KIDIA, KFDIA, KLON, PGEMU, NDECOLAT, &
+ & ZDECORR_LEN_KM, PDECORR_LEN_RATIO=ZDECORR_LEN_RATIO)
+rad_config%cloud_inhom_decorr_scaling = ZDECORR_LEN_RATIO
+DO JLON = KIDIA,KFDIA
+ CALL cloud%set_overlap_param(thermodynamics, &
+ & ZDECORR_LEN_KM(JLON)*1000.0_JPRB, &
+ & istartcol=JLON, iendcol=JLON)
+ENDDO
+
+! Cloud water content fractional standard deviation is configurable
+! from namelist NAERAD but must be globally constant. Before it was
+! hard coded at 1.0.
+CALL cloud%create_fractional_std(KLON, KLEV, XCLOUD_FRAC_STD)
+
+! By default mid and high cloud effective size is 10 km
+CALL cloud%create_inv_cloud_effective_size(KLON,KLEV,1.0_JPRB/10000.0_JPRB)
+! But for boundary clouds (eta > 0.8) we set it to 1 km
+DO JLEV = 1,KLEV
+ DO JLON = KIDIA,KFDIA
+ IF (PPRESSURE(JLON,JLEV) > 0.8_JPRB * PPRESSURE_H(JLON,KLEV+1)) THEN
+ cloud%inv_cloud_effective_size(JLON,JLEV) = 1.0e-3_JPRB
+ ENDIF
+ ENDDO
+ENDDO
+
+
+! Compute the dry mass of each layer neglecting humidity effects, in
+! kg m-2, needed to scale some of the aerosol inputs
+CALL thermodynamics%get_layer_mass(KIDIA, KFDIA, ZLAYER_MASS)
+
+! Copy over aerosol mass mixing ratio
+IF (NAERMACC > 0) THEN
+
+ ! MACC aerosol climatology - this is already in mass mixing ratio
+ ! units with the required array orientation so we can copy it over
+ ! directly
+ aerosol%mixing_ratio(KIDIA:KFDIA,:,:) = PAEROSOL(KIDIA:KFDIA,:,:)
+
+ ! Add the tropospheric and stratospheric backgrounds contained in the
+ ! old Tegen arrays - this is very ugly!
+ IF (TROP_BG_AER_MASS_EXT > 0.0_JPRB) THEN
+ aerosol%mixing_ratio(KIDIA:KFDIA,:,ITYPE_TROP_BG_AER) &
+ & = aerosol%mixing_ratio(KIDIA:KFDIA,:,ITYPE_TROP_BG_AER) &
+ & + PAEROSOL_OLD(KIDIA:KFDIA,1,:) &
+ & / (ZLAYER_MASS * TROP_BG_AER_MASS_EXT)
+ ENDIF
+ IF (STRAT_BG_AER_MASS_EXT > 0.0_JPRB) THEN
+ aerosol%mixing_ratio(KIDIA:KFDIA,:,ITYPE_STRAT_BG_AER) &
+ & = aerosol%mixing_ratio(KIDIA:KFDIA,:,ITYPE_STRAT_BG_AER) &
+ & + PAEROSOL_OLD(KIDIA:KFDIA,6,:) &
+ & / (ZLAYER_MASS * STRAT_BG_AER_MASS_EXT)
+ ENDIF
+
+ELSE
+
+ ! Tegen aerosol climatology - the array PAEROSOL_OLD contains the
+ ! 550-nm optical depth in each layer. The optics data file
+ ! aerosol_ifs_rrtm_tegen.nc does not contain mass extinction
+ ! coefficient, but a scaling factor that the 550-nm optical depth
+ ! should be multiplied by to obtain the optical depth in each
+ ! spectral band. Therefore, in order for the units to work out, we
+ ! need to divide by the layer mass (in kg m-2) to obtain the 550-nm
+ ! cross-section per unit mass of dry air (so in m2 kg-1). We also
+ ! need to permute the array.
+ DO JLEV = 1,KLEV
+ DO JAER = 1,6
+ aerosol%mixing_ratio(KIDIA:KFDIA,JLEV,JAER) &
+ & = PAEROSOL_OLD(KIDIA:KFDIA,JAER,JLEV) &
+ & / ZLAYER_MASS(KIDIA:KFDIA,JLEV)
+ ENDDO
+ ENDDO
+
+ENDIF
+
+
+! Convert ozone Pa*kg/kg to kg/kg
+DO JLEV = 1,KLEV
+ DO JLON = KIDIA,KFDIA
+ ZO3(JLON,JLEV) = PO3_DP(JLON,JLEV) &
+ & / (PPRESSURE_H(JLON,JLEV+1)-PPRESSURE_H(JLON,JLEV))
+ ENDDO
+ENDDO
+
+! Insert gas mixing ratios
+CALL gas%put(IH2O, IMassMixingRatio, PQ)
+CALL gas%put(ICO2, IMassMixingRatio, PCO2)
+CALL gas%put(ICH4, IMassMixingRatio, PCH4)
+CALL gas%put(IN2O, IMassMixingRatio, PN2O)
+CALL gas%put(ICFC11, IMassMixingRatio, PCFC11)
+CALL gas%put(ICFC12, IMassMixingRatio, PCFC12)
+CALL gas%put(IHCFC22, IMassMixingRatio, PHCFC22)
+CALL gas%put(ICCL4, IMassMixingRatio, PCCL4)
+CALL gas%put(IO3, IMassMixingRatio, ZO3)
+CALL gas%put_well_mixed(IO2, IVolumeMixingRatio, 0.20944_JPRB)
+!CALL gas%put_well_mixed(IO2, IVolumeMixingRatio, 0.001_JPRB)
+
+! Ensure the units of the gas mixing ratios are what is required by
+! the gas absorption model
+call set_gas_units(rad_config, gas)
+
+! Call radiation scheme
+CALL radiation(KLON, KLEV, KIDIA, KFDIA, rad_config, &
+ & single_level, thermodynamics, gas, cloud, aerosol, flux)
+
+! Compute required output fluxes
+! First the net fluxes
+PFLUX_SW(KIDIA:KFDIA,:) = flux%sw_dn(KIDIA:KFDIA,:) - flux%sw_up(KIDIA:KFDIA,:)
+PFLUX_LW(KIDIA:KFDIA,:) = flux%lw_dn(KIDIA:KFDIA,:) - flux%lw_up(KIDIA:KFDIA,:)
+PFLUX_SW_CLEAR(KIDIA:KFDIA,:) &
+ & = flux%sw_dn_clear(KIDIA:KFDIA,:) - flux%sw_up_clear(KIDIA:KFDIA,:)
+PFLUX_LW_CLEAR(KIDIA:KFDIA,:) &
+ & = flux%lw_dn_clear(KIDIA:KFDIA,:) - flux%lw_up_clear(KIDIA:KFDIA,:)
+
+! MNH
+
+! Now the surface fluxes
+PFLUX_SW_SURF (KIDIA:KFDIA,:) = TRANSPOSE(flux%sw_dn_surf_band (:,KIDIA:KFDIA))
+PFLUX_LW_SURF (KIDIA:KFDIA) = flux%lw_dn (KIDIA:KFDIA,KLEV+1)
+PFLUX_SW_SURF_CLEAR(KIDIA:KFDIA,:) = TRANSPOSE(flux%sw_dn_surf_clear_band (:,KIDIA:KFDIA))
+PFLUX_LW_SURF_CLEAR(KIDIA:KFDIA) = flux%lw_dn_clear (KIDIA:KFDIA,KLEV+1)
+PFLUX_DIR_SURF (KIDIA:KFDIA,:) = TRANSPOSE(flux%sw_dn_direct_surf_band (:,KIDIA:KFDIA))
+PFLUX_DIR_SURF_CLEAR (KIDIA:KFDIA,:) = TRANSPOSE(flux%sw_dn_direct_surf_clear_band (:,KIDIA:KFDIA))
+
+
+PFLUX_DIR_SURF_INTO_SUN(KIDIA:KFDIA,:) = 0.0_JPRB
+! MNH
+DO JBAND = 1,NSWB_MNH
+ WHERE (PMU0(KIDIA:KFDIA) > EPSILON(1.0_JPRB))
+ PFLUX_DIR_SURF_INTO_SUN(KIDIA:KFDIA, JBAND) = PFLUX_DIR_SURF(KIDIA:KFDIA,JBAND) / PMU0(KIDIA:KFDIA)
+ END WHERE
+END DO
+! Top-of-atmosphere downwelling flux
+PFLUX_SW_DN_TOA(KIDIA:KFDIA) = flux%sw_dn(KIDIA:KFDIA,1)
+
+! Top-of-atmosphere upwelling fluxes - Q.L.
+PFLUX_SW_UP_TOA(KIDIA:KFDIA) = flux%sw_up(KIDIA:KFDIA,1)
+PFLUX_LW_UP_TOA(KIDIA:KFDIA) = flux%lw_up(KIDIA:KFDIA,1)
+PFLUX_SW_UP_TOA_CLEAR(KIDIA:KFDIA) = flux%sw_up_clear(KIDIA:KFDIA,1)
+PFLUX_LW_UP_TOA_CLEAR(KIDIA:KFDIA) = flux%lw_up_clear(KIDIA:KFDIA,1)
+
+! Total fluxes - QL
+! print*,"flux%sw_dn(KIDIA:KFDIA,:)",flux%sw_dn(KIDIA:KFDIA,:)
+
+PFLUX_SW_DN(KIDIA:KFDIA,:) = flux%sw_dn(KIDIA:KFDIA,:)
+PFLUX_SW_UP(KIDIA:KFDIA,:) = flux%sw_up(KIDIA:KFDIA,:)
+PFLUX_LW_DN(KIDIA:KFDIA,:) = flux%lw_dn(KIDIA:KFDIA,:)
+PFLUX_LW_UP(KIDIA:KFDIA,:) = flux%lw_up(KIDIA:KFDIA,:)
+PFLUX_SW_DN_CLEAR(KIDIA:KFDIA,:) = flux%sw_dn_clear(KIDIA:KFDIA,:)
+PFLUX_SW_UP_CLEAR(KIDIA:KFDIA,:) = flux%sw_up_clear(KIDIA:KFDIA,:)
+PFLUX_LW_DN_CLEAR(KIDIA:KFDIA,:) = flux%lw_dn_clear(KIDIA:KFDIA,:)
+PFLUX_LW_UP_CLEAR(KIDIA:KFDIA,:) = flux%lw_up_clear(KIDIA:KFDIA,:)
+
+! Compute UV fluxes as weighted sum of appropriate shortwave bands
+PFLUX_UV (KIDIA:KFDIA) = 0.0_JPRB
+DO JBAND = 1,NWEIGHT_UV
+ PFLUX_UV(KIDIA:KFDIA) = PFLUX_UV(KIDIA:KFDIA) + WEIGHT_UV(JBAND) &
+ & * flux%sw_dn_surf_band(IBAND_UV(JBAND),KIDIA:KFDIA)
+ENDDO
+
+! Compute photosynthetically active radiation similarly
+PFLUX_PAR (KIDIA:KFDIA) = 0.0_JPRB
+PFLUX_PAR_CLEAR(KIDIA:KFDIA) = 0.0_JPRB
+DO JBAND = 1,NWEIGHT_PAR
+ PFLUX_PAR(KIDIA:KFDIA) = PFLUX_PAR(KIDIA:KFDIA) + WEIGHT_PAR(JBAND) &
+ & * flux%sw_dn_surf_band(IBAND_PAR(JBAND),KIDIA:KFDIA)
+ PFLUX_PAR_CLEAR(KIDIA:KFDIA) = PFLUX_PAR_CLEAR(KIDIA:KFDIA) &
+ & + WEIGHT_PAR(JBAND) &
+ & * flux%sw_dn_surf_clear_band(IBAND_PAR(JBAND),KIDIA:KFDIA)
+ENDDO
+
+! Compute effective broadband emissivity
+ZBLACK_BODY_NET_LW = PFLUX_LW_SURF(KIDIA:KFDIA) &
+ & - RSIGMA*PTEMPERATURE_SKIN(KIDIA:KFDIA)**4
+PEMIS_OUT(KIDIA:KFDIA) = PEMIS(KIDIA:KFDIA)
+WHERE (ABS(ZBLACK_BODY_NET_LW) > 1.0E-5)
+ PEMIS_OUT(KIDIA:KFDIA) = PFLUX_LW(KIDIA:KFDIA,KLEV+1) / ZBLACK_BODY_NET_LW
+END WHERE
+
+! Copy longwave derivatives
+IF (LAPPROXLWUPDATE) THEN
+ PLWDERIVATIVE(KIDIA:KFDIA,:) = flux%lw_derivatives(KIDIA:KFDIA,:)
+END IF
+
+! Store the shortwave downwelling fluxes in each albedo band
+IF (LAPPROXSWUPDATE) THEN
+ PSWDIFFUSEBAND(KIDIA:KFDIA,:) = 0.0_JPRB
+ PSWDIRECTBAND (KIDIA:KFDIA,:) = 0.0_JPRB
+ DO JBAND = 1,rad_config%n_bands_sw
+ JB_ALBEDO = rad_config%i_albedo_from_band_sw(JBAND)
+ DO JLON = KIDIA,KFDIA
+ PSWDIFFUSEBAND(JLON,JB_ALBEDO) = PSWDIFFUSEBAND(JLON,JB_ALBEDO) &
+ & + flux%sw_dn_surf_band(JBAND,JLON) &
+ & - flux%sw_dn_direct_surf_band(JBAND,JLON)
+ PSWDIRECTBAND(JLON,JB_ALBEDO) = PSWDIRECTBAND(JLON,JB_ALBEDO) &
+ & + flux%sw_dn_direct_surf_band(JBAND,JLON)
+ ENDDO
+ ENDDO
+ENDIF
+
+CALL single_level%deallocate
+CALL thermodynamics%deallocate
+CALL gas%deallocate
+CALL cloud%deallocate
+CALL aerosol%deallocate
+CALL flux%deallocate
+
+IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME',1,ZHOOK_HANDLE)
+
+END SUBROUTINE RADIATION_SCHEME
+
+END MODULE MODI_RADIATION_SCHEME
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/radiation_setup.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/radiation_setup.F90
new file mode 100644
index 0000000000000000000000000000000000000000..0677d3f94c66fd2ab89ac6efee68a4e993669f38
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/radiation_setup.F90
@@ -0,0 +1,386 @@
+MODULE RADIATION_SETUP
+
+! RADIATION_SETUP - Setting up modular radiation scheme
+!
+! (C) Copyright 2015- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! PURPOSE
+! -------
+! The modular radiation scheme is contained in a separate
+! library. SETUP_RADIATION_SCHEME in this module sets up a small
+! number of global variables needed to store the information for it.
+!
+! Lower case is used for variables and types taken from the
+! radiation library
+!
+! INTERFACE
+! ---------
+! SETUP_RADIATION_SCHEME is called from SUECRAD. The radiation
+! scheme is actually run using the RADIATION_SCHEME routine (not in
+! this module).
+!
+! AUTHOR
+! ------
+! Robin Hogan, ECMWF
+! Original: 2015-09-16
+!
+! MODIFICATIONS
+! -------------
+!
+!-----------------------------------------------------------------------
+
+ USE PARKIND1, ONLY : JPRB
+ USE radiation_config, ONLY : config_type, &
+ & ISolverMcICA, ISolverSpartacus, &
+ & ILiquidModelSlingo, ILiquidModelSOCRATES, &
+ & IIceModelFu, IIceModelBaran, &
+ & IOverlapExponential
+ USE MODD_PARAM_ECRAD_n , ONLY : rad_config
+
+ IMPLICIT NONE
+
+ ! Store configuration information for the radiation scheme in a
+ ! global variable
+ !type(config_type) :: rad_config
+
+ ! Ultraviolet weightings
+ INTEGER :: NWEIGHT_UV
+ INTEGER :: IBAND_UV(100)
+ REAL(KIND=JPRB) :: WEIGHT_UV(100)
+ ! Photosynthetically active radiation weightings
+ INTEGER :: NWEIGHT_PAR
+ INTEGER :: IBAND_PAR(100)
+ REAL(KIND=JPRB) :: WEIGHT_PAR(100)
+
+ ! Background aerosol is specified in an ugly way: using the old
+ ! Tegen fields that are in terms of optical depth, and converted to
+ ! mass mixing ratio via the relevant mass-extinction coefficient
+ INTEGER, PARAMETER :: ITYPE_TROP_BG_AER = 8 ! hydrophobic organic
+ INTEGER, PARAMETER :: ITYPE_STRAT_BG_AER=12 ! non-absorbing sulphate
+ REAL(KIND=JPRB) :: TROP_BG_AER_MASS_EXT
+ REAL(KIND=JPRB) :: STRAT_BG_AER_MASS_EXT
+
+CONTAINS
+
+ ! This routine copies information between the IFS radiation
+ ! configuration (stored in global variables) and the radiation
+ ! configuration of the modular radiation scheme (stored in
+ ! rad_config). The optional input logical LOUTPUT controls whether
+ ! to print lots of information during the setup stage (default is
+ ! no).
+ SUBROUTINE SETUP_RADIATION_SCHEME(LOUTPUT)
+
+ USE YOMHOOK, ONLY : LHOOK, DR_HOOK
+ USE YOMLUN, ONLY : NULNAM, NULOUT, NULERR
+ USE YOESRTWN, ONLY : NMPSRTM
+ !USE YOERAD, ONLY : YRERAD
+
+ ! MNH
+ USE MODD_PARAM_ECRAD_n , ONLY : LAPPROXLWUPDATE, NAERMACC, NLIQOPT, NICEOPT, &
+ & NLWSOLVER, NSWSOLVER, NLWSCATTERING, NOVLP,CDATADIR
+ ! MNH
+
+ USE radiation_interface, ONLY : setup_radiation
+ USE radiation_aerosol_optics, ONLY : dry_aerosol_sw_mass_extinction
+
+!#include "posname.intfb.h"
+
+ ! Whether or not to provide information on the radiation scheme
+ ! configuration
+ LOGICAL, INTENT(IN), OPTIONAL :: LOUTPUT
+
+ ! Verbosity of configuration information 0=none, 1=warning,
+ ! 2=info, 3=progress, 4=detailed, 5=debug
+ INTEGER :: IVERBOSESETUP
+ INTEGER :: ISTAT
+
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+ IF (LHOOK) CALL DR_HOOK('RADIATION_SETUP:SETUP_RADIATION_SCHEME',0,ZHOOK_HANDLE)
+
+ ! *** GENERAL SETUP ***
+
+ ! Configure verbosity of setup of radiation scheme
+ IVERBOSESETUP = 4 ! Provide plenty of information
+ IF (PRESENT(LOUTPUT)) THEN
+ IF (.NOT. LOUTPUT) THEN
+ IVERBOSESETUP = 1 ! Warnings and errors only
+ ENDIF
+ ENDIF
+ rad_config%iverbosesetup = IVERBOSESETUP
+
+ IF (IVERBOSESETUP > 1) THEN
+ WRITE(NULOUT,'(a)') '-------------------------------------------------------------------------------'
+ WRITE(NULOUT,'(a)') 'RADIATION_SETUP'
+ ENDIF
+
+ ! Normal operation of the radiation scheme displays only errors
+ ! and warnings
+ rad_config%iverbose = 1
+
+ ! For the time being, ensure a valid default directory name
+ rad_config%directory_name = CDATADIR
+
+ ! Do we do Hogan and Bozzo (2014) approximate longwave updates?
+ rad_config%do_lw_derivatives = LAPPROXLWUPDATE
+
+ ! Surface spectral fluxes are needed for spectral shortwave albedo
+ ! calculation
+ rad_config%do_surface_sw_spectral_flux = .TRUE.
+
+
+ ! *** SETUP GAS OPTICS ***
+
+ ! Assume IFS has already set-up RRTM, so the setup_radiation
+ ! routine below does not have to
+ rad_config%do_setup_ifsrrtm = .FALSE.
+
+
+ ! *** SETUP CLOUD OPTICS ***
+
+ ! Setup liquid optics
+ IF (NLIQOPT == 2) THEN
+ rad_config%i_liq_model = ILiquidModelSlingo
+ ELSEIF (NLIQOPT == 3) THEN
+ rad_config%i_liq_model = ILiquidModelSOCRATES
+ ELSE
+ WRITE(NULERR,'(a,i0)') 'Unavailable liquid optics model in modular radiation scheme: NLIQOPT=', &
+ & NLIQOPT
+ CALL ABOR1('RADIATION_SETUP: error interpreting NLIQOPT')
+ ENDIF
+
+ ! Setup ice optics
+ IF (NICEOPT == 3) THEN
+ rad_config%i_ice_model = IIceModelFu
+ ELSEIF (NICEOPT == 4) THEN
+ rad_config%i_ice_model = IIceModelBaran
+ ELSE
+ WRITE(NULERR,'(a,i0)') 'Unavailable ice optics model in modular radiation scheme: NICEOPT=', &
+ & NICEOPT
+ CALL ABOR1('RADIATION_SETUP: error interpreting NICEOPT')
+ ENDIF
+
+ ! For consistency with earlier versions of the IFS radiation
+ ! scheme, we perform shortwave delta-Eddington scaling *after* the
+ ! merge of the cloud, aerosol and gas optical properties. Set
+ ! this to "false" to do the scaling on the cloud and aerosol
+ ! properties separately before merging with gases. Note that this
+ ! is not compatible with the SPARTACUS solver.
+ rad_config%do_sw_delta_scaling_with_gases = .TRUE.
+
+ ! Use Exponential-Exponential cloud overlap to match original IFS
+ ! implementation of Raisanen cloud generator
+
+ ! MNH
+ rad_config%i_overlap_scheme = IOverlapExponential
+ rad_config%i_overlap_scheme = NOVLP
+ ! MNH
+
+ ! *** SETUP AEROSOLS ***
+
+ rad_config%use_aerosols = .TRUE.
+
+ IF (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
+
+ ! 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
+ 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)
+
+ ! Background aerosol mass-extinction coefficients are obtained
+ ! after the configuration files have been read - see later in
+ ! this routine.
+
+ ELSE
+ ! Using Tegen climatology
+ rad_config%n_aerosol_types = 6
+ rad_config%i_aerosol_type_map = 0 ! There can be up to 256 types
+ rad_config%i_aerosol_type_map(1:6) = (/ &
+ & 1, & ! Continental background
+ & 2, & ! Maritime
+ & 3, & ! Desert
+ & 4, & ! Urban
+ & 5, & ! Volcanic active
+ & 6 /) ! Stratospheric background
+
+ ! Manually set the aerosol optics file name (the directory will
+ ! be added automatically)
+ rad_config%aerosol_optics_override_file_name = 'aerosol_ifs_rrtm_tegen.nc'
+ ENDIF
+
+ ! *** SETUP SOLVER ***
+
+ ! 3D effects are off by default
+ rad_config%do_3d_effects = .FALSE.
+
+ ! Select longwave solver
+ SELECT CASE (NLWSOLVER)
+ CASE(0)
+ rad_config%i_solver_lw = ISolverMcICA
+ CASE(1)
+ rad_config%i_solver_lw = ISolverSpartacus
+ CASE(2)
+ rad_config%i_solver_lw = ISolverSpartacus
+ rad_config%do_3d_effects = .TRUE.
+ CASE DEFAULT
+ WRITE(NULERR,'(a,i0)') 'Unknown value for NLWSOLVER: ', NLWSOLVER
+ CALL ABOR1('RADIATION_SETUP: error interpreting NLWSOLVER')
+ END SELECT
+
+ ! Select shortwave solver
+ SELECT CASE (NSWSOLVER)
+ CASE(0)
+ rad_config%i_solver_sw = ISolverMcICA
+ CASE(1)
+ rad_config%i_solver_sw = ISolverSpartacus
+ rad_config%do_3d_effects = .FALSE.
+ IF (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 (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: ', NSWSOLVER
+ CALL ABOR1('RADIATION_SETUP: error interpreting NSWSOLVER')
+ END SELECT
+
+ ! SPARTACUS solver requires delta scaling to be done separately
+ ! for clouds & aerosols
+ IF (rad_config%i_solver_sw == ISolverSpartacus) THEN
+ rad_config%do_sw_delta_scaling_with_gases = .FALSE.
+ ENDIF
+
+ ! Do we represent longwave scattering?
+ rad_config%do_lw_cloud_scattering = .FALSE.
+ rad_config%do_lw_aerosol_scattering = .FALSE.
+ SELECT CASE (NLWSCATTERING)
+ CASE(1)
+ rad_config%do_lw_cloud_scattering = .TRUE.
+ CASE(2)
+ rad_config%do_lw_cloud_scattering = .TRUE.
+ IF (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
+ rad_config%do_lw_aerosol_scattering = .TRUE.
+ ENDIF
+ END SELECT
+
+
+ ! *** IMPLEMENT SETTINGS ***
+
+ ! For advanced configuration, the configuration data for the
+ ! "radiation" project can specified directly in the namelist.
+ ! However, the variable naming convention is not consistent with
+ ! the rest of the IFS. For basic configuration there are specific
+ ! variables in the NAERAD namelist available in the YRERAD
+ ! structure.
+
+ ! MNH
+ !CALL POSNAME(NULNAM, 'RADIATION', ISTAT)
+ ISTAT = 1 ! no .nam namelist used, all in NAM_PARAM_ECRAD
+ ! MNH
+
+ SELECT CASE (ISTAT)
+ CASE(0)
+ CALL rad_config%read(unit=NULNAM)
+ CASE(1)
+ WRITE(NULOUT,'(a)') 'Namelist RADIATION not found, using settings from MNH namelist only'
+ CASE DEFAULT
+ CALL ABOR1('RADIATION_SETUP: error reading RADIATION section of namelist file')
+ END SELECT
+
+ ! Print configuration
+ IF (IVERBOSESETUP > 1) THEN
+ WRITE(NULOUT,'(a)') 'Radiation scheme settings:'
+ CALL rad_config%print(IVERBOSE=IVERBOSESETUP)
+ ENDIF
+
+ ! Use configuration data to set-up radiation scheme, including
+ ! reading scattering datafiles
+ CALL setup_radiation(rad_config)
+
+ ! Populate the mapping between the 14 RRTM shortwave bands and the
+ ! 6 albedo inputs. The mapping according to the stated wavelength
+ ! ranges of the 6-band model does not match the hard-wired mapping
+ ! in NMPSRTM, but only the hard-wired values produce sensible
+ ! results...
+ ! Note that NMPSRTM(:)=(/ 6, 6, 5, 5, 5, 5, 5, 4, 4, 3, 2, 2, 1, 6 /)
+ rad_config%i_albedo_from_band_sw = NMPSRTM
+ ! call rad_config%define_sw_albedo_intervals(6, &
+ ! & (/ 0.25e-6_jprb, 0.44e-6_jprb, 1.19e-6_jprb, &
+ ! & 2.38e-6_jprb, 4.00e-6_jprb /), (/ 1,2,3,4,5,6 /))
+
+ ! Likewise between the 16 RRTM longwave bands and the 2 emissivity
+ ! inputs (info taken from rrtm_ecrt_140gp_mcica.F90) representing
+ ! outside and inside the window region of the spectrum
+ ! rad_config%i_emiss_from_band_lw = (/ 1,1,1,1,1,2,2,2,1,1,1,1,1,1,1,1 /)
+ call rad_config%define_lw_emiss_intervals(3, &
+ & (/ 8.0e-6_jprb,13.0e-6_jprb /), (/ 1,2,1 /))
+
+ ! Get spectral weightings for UV and PAR
+ call rad_config%get_sw_weights(0.2e-6_jprb, 0.4415e-6_jprb, &
+ & NWEIGHT_UV, IBAND_UV, WEIGHT_UV, 'ultraviolet')
+ call rad_config%get_sw_weights(0.4e-6_jprb, 0.7e-6_jprb, &
+ & NWEIGHT_PAR, IBAND_PAR, WEIGHT_PAR, &
+ & 'photosynthetically active radiation, PAR')
+
+ IF (NAERMACC > 0) THEN
+ ! With the MACC aerosol climatology we need to add in the
+ ! background aerosol afterwards using the Tegen arrays. In this
+ ! case we first configure the background aerosol mass-extinction
+ ! coefficient at 550 nm, which corresponds to the 10th RRTMG
+ ! shortwave band.
+ TROP_BG_AER_MASS_EXT = dry_aerosol_sw_mass_extinction(rad_config, &
+ & ITYPE_TROP_BG_AER, 10)
+ STRAT_BG_AER_MASS_EXT = dry_aerosol_sw_mass_extinction(rad_config, &
+ & ITYPE_STRAT_BG_AER, 10)
+
+ WRITE(NULOUT,'(a,i0)') 'Tropospheric bacground uses aerosol type ', &
+ & ITYPE_TROP_BG_AER
+ WRITE(NULOUT,'(a,i0)') 'Stratospheric bacground uses aerosol type ', &
+ & ITYPE_STRAT_BG_AER
+ ENDIF
+
+ IF (IVERBOSESETUP > 1) THEN
+ WRITE(NULOUT,'(a)') '-------------------------------------------------------------------------------'
+ ENDIF
+
+ IF (LHOOK) CALL DR_HOOK('RADIATION_SETUP:SETUP_RADIATION_SCHEME',1,ZHOOK_HANDLE)
+
+ END SUBROUTINE SETUP_RADIATION_SCHEME
+
+END MODULE RADIATION_SETUP
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifsaux/parkind1.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsaux/parkind1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..35b7f1225aded4ec78d892bbbdbcd248d5c10925
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsaux/parkind1.F90
@@ -0,0 +1,58 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+MODULE PARKIND1
+!
+! *** Define usual kinds for strong typing ***
+!
+IMPLICIT NONE
+PUBLIC
+SAVE
+!
+! Integer Kinds
+! -------------
+!
+INTEGER, PARAMETER :: JPIT = SELECTED_INT_KIND(2)
+INTEGER, PARAMETER :: JPIS = SELECTED_INT_KIND(4)
+INTEGER :: JINT_DEF
+INTEGER, PARAMETER :: JPIM = KIND(JINT_DEF) ! to ensure standard integer SELECTED_INT_KIND(9)
+INTEGER, PARAMETER :: JPIB = SELECTED_INT_KIND(12)
+
+!Special integer type to be used for sensative adress calculations
+!should be *8 for a machine with 8byte adressing for optimum performance
+#ifdef ADDRESS64
+INTEGER, PARAMETER :: JPIA = JPIB
+#else
+INTEGER, PARAMETER :: JPIA = JPIM
+#endif
+
+!
+! Real Kinds
+! ----------
+!
+INTEGER, PARAMETER :: JPRT = SELECTED_REAL_KIND(2,1)
+INTEGER, PARAMETER :: JPRS = SELECTED_REAL_KIND(4,2)
+INTEGER, PARAMETER :: JPRM = SELECTED_REAL_KIND(6,37)
+! This parameter should always be double precision as a few parts of
+! the radiation code require it
+INTEGER, PARAMETER :: JPRD = SELECTED_REAL_KIND(13,300)
+
+! This parameter governs the precision of most of the code
+#ifdef SINGLE_PRECISION
+INTEGER, PARAMETER :: JPRB = JPRM
+#else
+INTEGER, PARAMETER :: JPRB = JPRD
+#endif
+!
+
+! Logical Kinds for RTTOV....
+
+INTEGER, PARAMETER :: JPLM = JPIM !Standard logical type
+
+END MODULE PARKIND1
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifsaux/yomcst.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsaux/yomcst.F90
new file mode 100644
index 0000000000000000000000000000000000000000..d45f32c335271f2df4e53591991781da1114e00c
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsaux/yomcst.F90
@@ -0,0 +1,41 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+MODULE YOMCST
+
+USE PARKIND1 ,ONLY : JPRB
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+! * RPI : number Pi
+REAL(KIND=JPRB), PARAMETER :: RPI = 3.14159265358979323846_JPRB
+! * RSIGMA : Stefan-Bolzman constant
+REAL(KIND=JPRB), PARAMETER :: RSIGMA = 5.67037321e-8_JPRB ! W m-2 K-4
+! * RG : gravity constant
+REAL(KIND=JPRB), PARAMETER :: RG = 9.80665_JPRB ! m s-2
+! * RD : R_dry (dry air constant)
+REAL(KIND=JPRB), PARAMETER :: RD = 287.058_JPRB! J kg-1 K-1
+! * RMD : dry air molar mass
+REAL(KIND=JPRB), PARAMETER :: RMD = 28.9644_JPRB
+! * RMV : vapour water molar mass
+REAL(KIND=JPRB), PARAMETER :: RMV = 18.0153_JPRB
+! * RMO3 : ozone molar mass
+REAL(KIND=JPRB), PARAMETER :: RMO3 = 47.9942_JPRB
+! * RI0 : solar constant
+REAL(KIND=JPRB), PARAMETER :: RI0 = 1366.0_JPRB
+! * RDAY : day duration in s
+REAL(KIND=JPRB), PARAMETER :: RDAY = 86400_JPRB
+! * RTT : freezing temperature
+REAL(KIND=JPRB), PARAMETER :: RTT=273.16_JPRB
+
+END MODULE YOMCST
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifsaux/yomlun.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsaux/yomlun.F90
new file mode 100644
index 0000000000000000000000000000000000000000..adac0b230969cf6a0041327987c08f1b13450819
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsaux/yomlun.F90
@@ -0,0 +1,26 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+MODULE YOMLUN
+
+USE PARKIND1, ONLY : JPIM
+USE YOMLUN_IFSAUX, ONLY : NULOUT, NULERR
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+INTEGER(KIND=JPIM) :: NULRAD = 25
+
+INTEGER(KIND=JPIM) :: NULNAM = 4
+
+! ------------------------------------------------------------------
+END MODULE YOMLUN
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/rrtm_kgb1.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/rrtm_kgb1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..36c2ecd732b4f8a25220e103a9d9cecd3fe554e7
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/rrtm_kgb1.F90
@@ -0,0 +1,358 @@
+SUBROUTINE RRTM_KGB1(DIRECTORY)
+
+! Originally by Eli J. Mlawer, Atmospheric & Environmental Research.
+! BAND 1: 10-250 cm-1 (low - H2O; high - H2O)
+! Reformatted for F90 by JJMorcrette, ECMWF
+! R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+! G.Mozdzynski March 2011 read constants from files
+! ABozzo May 2013 update to RRTMG v4.85
+! band 1: 10-350 cm-1
+! T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+! ------------------------------------------------------------------
+
+USE PARKIND1 ,ONLY : JPRB
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE YOMLUN ,ONLY : NULRAD
+USE MPL_MODULE,ONLY : MPL_BROADCAST
+USE YOMTAG ,ONLY : MTAGRAD
+USE YOMMP0 , ONLY : NPROC, MYPROC
+
+USE YOERRTO1 , ONLY : KAO ,KBO ,KAO_D,KBO_D,SELFREFO ,FRACREFAO ,&
+ & FRACREFBO ,FORREFO, KAO_MN2, KBO_MN2
+
+! ------------------------------------------------------------------
+
+IMPLICIT NONE
+
+CHARACTER(LEN=*), INTENT(IN) :: DIRECTORY
+
+!CHARACTER(LEN = 80) :: CLZZZ
+CHARACTER(LEN = 255) :: CLF1
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB1',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+ !CALL GETENV("DATA",CLZZZ)
+ !IF(CLZZZ /= " ") THEN
+ ! CLF1=TRIM(CLZZZ) // "/RADRRTM"
+ CLF1 = DIRECTORY // "/RADRRTM"
+ WRITE(0,'(A,A)') 'Reading ',TRIM(CLF1)
+ ! RRTM and SRTM files from ecrad are in big-endian format.
+ ! Here they are read as big-endian at opening because otherwise MNH assumes littel-endian
+ ! No need for complation option export GFORTRAN_CONVERT_UNIT="little_endian;big_endian:145"
+ OPEN(NULRAD,FILE=TRIM(CLF1),FORM="UNFORMATTED",ACTION="READ",access='sequential',ERR=1000,CONVERT="BIG_ENDIAN")
+ !ELSE
+ ! OPEN(NULRAD,FILE='RADRRTM',FORM="UNFORMATTED",ACTION="READ",ERR=1000)
+ !ENDIF
+ READ(NULRAD,ERR=1001) KAO_D,KBO_D
+ ! Convert the data into model actual precision.
+ KAO = REAL(KAO_D,JPRB)
+ KBO = REAL(KBO_D,JPRB)
+ENDIF
+IF( NPROC>1 )THEN
+ CALL MPL_BROADCAST (KAO,MTAGRAD,1,CDSTRING='RRTM_KGB1:')
+ CALL MPL_BROADCAST (KBO,MTAGRAD,1,CDSTRING='RRTM_KGB1:')
+ENDIF
+
+! Planck fraction mapping level: P = 212.7250 mbar, T = 223.06 K
+FRACREFAO(:) = (/ &
+ & 2.1227E-01_JPRB,1.8897E-01_JPRB,1.3934E-01_JPRB,1.1557E-01_JPRB,9.5282E-02_JPRB,8.3359E-02_JPRB, &
+ & 6.5333E-02_JPRB,5.2016E-02_JPRB,3.4272E-02_JPRB,4.0257E-03_JPRB,3.1857E-03_JPRB,2.6014E-03_JPRB, &
+ & 1.9141E-03_JPRB,1.2612E-03_JPRB,5.3169E-04_JPRB,7.6476E-05_JPRB/)
+
+! Planck fraction mapping level: P = 212.7250 mbar, T = 223.06 K
+! These Planck fractions were calculated using lower atmosphere
+! parameters.
+FRACREFBO(:) = (/ &
+ & 2.1227E-01_JPRB,1.8897E-01_JPRB,1.3934E-01_JPRB,1.1557E-01_JPRB,9.5282E-02_JPRB,8.3359E-02_JPRB, &
+ & 6.5333E-02_JPRB,5.2016E-02_JPRB,3.4272E-02_JPRB,4.0257E-03_JPRB,3.1857E-03_JPRB,2.6014E-03_JPRB, &
+ & 1.9141E-03_JPRB,1.2612E-03_JPRB,5.3169E-04_JPRB,7.6476E-05_JPRB/)
+
+! The array FORREFO contains the coefficient of the water vapor
+! foreign-continuum (including the energy term). The first
+! index refers to reference temperature (296,260,224,260) and
+! pressure (970,475,219,3 mbar) levels. The second index
+! runs over the g-channel (1 to 16).
+
+ FORREFO(1,:) = (/ &
+ & 3.6742e-02_JPRB,1.0664e-01_JPRB,2.6132e-01_JPRB,2.7906e-01_JPRB,2.8151e-01_JPRB,2.7465e-01_JPRB, &
+ & 2.8530e-01_JPRB,2.9123e-01_JPRB,3.0697e-01_JPRB,3.1801e-01_JPRB,3.2444e-01_JPRB,2.7746e-01_JPRB, &
+ & 3.1994e-01_JPRB,2.9750e-01_JPRB,2.1226e-01_JPRB,1.2847e-01_JPRB/)
+ FORREFO(2,:) = (/ &
+ & 4.0450e-02_JPRB,1.1085e-01_JPRB,2.9205e-01_JPRB,3.1934e-01_JPRB,3.1739e-01_JPRB,3.1450e-01_JPRB, &
+ & 3.2797e-01_JPRB,3.2223e-01_JPRB,3.3099e-01_JPRB,3.4800e-01_JPRB,3.4046e-01_JPRB,3.5700e-01_JPRB, &
+ & 3.8264e-01_JPRB,3.6679e-01_JPRB,3.3481e-01_JPRB,3.2113e-01_JPRB/)
+ FORREFO(3,:) = (/ &
+ & 4.6952e-02_JPRB,1.1999e-01_JPRB,3.1473e-01_JPRB,3.7015e-01_JPRB,3.6913e-01_JPRB,3.6352e-01_JPRB, &
+ & 3.7754e-01_JPRB,3.7402e-01_JPRB,3.7113e-01_JPRB,3.7720e-01_JPRB,3.8365e-01_JPRB,4.0876e-01_JPRB, &
+ & 4.2968e-01_JPRB,4.4186e-01_JPRB,4.3468e-01_JPRB,4.7083e-01_JPRB/)
+ FORREFO(4,:) = (/ &
+ & 7.0645e-02_JPRB,1.6618e-01_JPRB,2.8516e-01_JPRB,3.1819e-01_JPRB,3.0131e-01_JPRB,2.9552e-01_JPRB, &
+ & 2.8972e-01_JPRB,2.9348e-01_JPRB,2.8668e-01_JPRB,2.8483e-01_JPRB,2.8130e-01_JPRB,2.7757e-01_JPRB, &
+ & 2.9735e-01_JPRB,3.1684e-01_JPRB,3.0681e-01_JPRB,3.6778e-01_JPRB/)
+
+
+! ------------------------------------------------------------------
+
+! The array KAO contains absorption coefs at the 16 chosen g-values
+! for a range of pressure levels > ~100mb and temperatures. The first
+! index in the array, JT, which runs from 1 to 5, corresponds to
+! different temperatures. More specifically, JT = 3 means that the
+! data are for the corresponding TREF for this pressure level,
+! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30,
+! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second
+! index, JP, runs from 1 to 13 and refers to the corresponding
+! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).
+! The third index, IG, goes from 1 to 16, and tells us which
+! g-interval the absorption coefficients are for.
+
+
+
+! The array KBO contains absorption coefs at the 16 chosen g-values
+! for a range of pressure levels < ~100mb and temperatures. The first
+! index in the array, JT, which runs from 1 to 5, corresponds to
+! different temperatures. More specifically, JT = 3 means that the
+! data are for the reference temperature TREF for this pressure
+! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
+! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.
+! The second index, JP, runs from 13 to 59 and refers to the JPth
+! reference pressure level (see taumol.f for the value of these
+! pressure levels in mb). The third index, IG, goes from 1 to 16,
+! and tells us which g-interval the absorption coefficients are for.
+
+
+
+ KAO_MN2(:, 1) = (/ &
+ & 5.12042E-08_JPRB, 5.51239E-08_JPRB, 5.93436E-08_JPRB, 6.38863E-08_JPRB, 6.87767E-08_JPRB, &
+ & 7.40415E-08_JPRB, 7.97093E-08_JPRB, 8.58110E-08_JPRB, 9.23797E-08_JPRB, 9.94513E-08_JPRB, &
+ & 1.07064E-07_JPRB, 1.15260E-07_JPRB, 1.24083E-07_JPRB, 1.33581E-07_JPRB, 1.43807E-07_JPRB, &
+ & 1.54815E-07_JPRB, 1.66666E-07_JPRB, 1.79424E-07_JPRB, 1.93159E-07_JPRB/)
+ KAO_MN2(:, 2) = (/ &
+ & 2.30938E-07_JPRB, 2.41696E-07_JPRB, 2.52955E-07_JPRB, 2.64738E-07_JPRB, 2.77071E-07_JPRB, &
+ & 2.89978E-07_JPRB, 3.03486E-07_JPRB, 3.17623E-07_JPRB, 3.32419E-07_JPRB, 3.47904E-07_JPRB, &
+ & 3.64111E-07_JPRB, 3.81072E-07_JPRB, 3.98824E-07_JPRB, 4.17402E-07_JPRB, 4.36846E-07_JPRB, &
+ & 4.57196E-07_JPRB, 4.78494E-07_JPRB, 5.00784E-07_JPRB, 5.24112E-07_JPRB/)
+ KAO_MN2(:, 3) = (/ &
+ & 6.70458E-07_JPRB, 7.04274E-07_JPRB, 7.39795E-07_JPRB, 7.77109E-07_JPRB, 8.16304E-07_JPRB, &
+ & 8.57476E-07_JPRB, 9.00724E-07_JPRB, 9.46154E-07_JPRB, 9.93876E-07_JPRB, 1.04400E-06_JPRB, &
+ & 1.09666E-06_JPRB, 1.15197E-06_JPRB, 1.21008E-06_JPRB, 1.27111E-06_JPRB, 1.33522E-06_JPRB, &
+ & 1.40256E-06_JPRB, 1.47331E-06_JPRB, 1.54761E-06_JPRB, 1.62567E-06_JPRB/)
+ KAO_MN2(:, 4) = (/ &
+ & 1.84182E-06_JPRB, 1.89203E-06_JPRB, 1.94360E-06_JPRB, 1.99658E-06_JPRB, 2.05101E-06_JPRB, &
+ & 2.10692E-06_JPRB, 2.16435E-06_JPRB, 2.22335E-06_JPRB, 2.28396E-06_JPRB, 2.34622E-06_JPRB, &
+ & 2.41017E-06_JPRB, 2.47587E-06_JPRB, 2.54337E-06_JPRB, 2.61270E-06_JPRB, 2.68392E-06_JPRB, &
+ & 2.75708E-06_JPRB, 2.83224E-06_JPRB, 2.90944E-06_JPRB, 2.98875E-06_JPRB/)
+ KAO_MN2(:, 5) = (/ &
+ & 3.41996E-06_JPRB, 3.32758E-06_JPRB, 3.23770E-06_JPRB, 3.15024E-06_JPRB, 3.06515E-06_JPRB, &
+ & 2.98235E-06_JPRB, 2.90180E-06_JPRB, 2.82341E-06_JPRB, 2.74715E-06_JPRB, 2.67294E-06_JPRB, &
+ & 2.60074E-06_JPRB, 2.53049E-06_JPRB, 2.46214E-06_JPRB, 2.39563E-06_JPRB, 2.33092E-06_JPRB, &
+ & 2.26796E-06_JPRB, 2.20670E-06_JPRB, 2.14709E-06_JPRB, 2.08910E-06_JPRB/)
+ KAO_MN2(:, 6) = (/ &
+ & 3.38746E-06_JPRB, 3.25966E-06_JPRB, 3.13669E-06_JPRB, 3.01836E-06_JPRB, 2.90449E-06_JPRB, &
+ & 2.79491E-06_JPRB, 2.68947E-06_JPRB, 2.58801E-06_JPRB, 2.49037E-06_JPRB, 2.39642E-06_JPRB, &
+ & 2.30601E-06_JPRB, 2.21902E-06_JPRB, 2.13530E-06_JPRB, 2.05475E-06_JPRB, 1.97723E-06_JPRB, &
+ & 1.90264E-06_JPRB, 1.83086E-06_JPRB, 1.76179E-06_JPRB, 1.69532E-06_JPRB/)
+ KAO_MN2(:, 7) = (/ &
+ & 3.17530E-06_JPRB, 3.07196E-06_JPRB, 2.97199E-06_JPRB, 2.87527E-06_JPRB, 2.78170E-06_JPRB, &
+ & 2.69118E-06_JPRB, 2.60360E-06_JPRB, 2.51887E-06_JPRB, 2.43690E-06_JPRB, 2.35759E-06_JPRB, &
+ & 2.28087E-06_JPRB, 2.20664E-06_JPRB, 2.13483E-06_JPRB, 2.06536E-06_JPRB, 1.99814E-06_JPRB, &
+ & 1.93312E-06_JPRB, 1.87021E-06_JPRB, 1.80934E-06_JPRB, 1.75046E-06_JPRB/)
+ KAO_MN2(:, 8) = (/ &
+ & 2.84701E-06_JPRB, 2.77007E-06_JPRB, 2.69521E-06_JPRB, 2.62237E-06_JPRB, 2.55150E-06_JPRB, &
+ & 2.48254E-06_JPRB, 2.41545E-06_JPRB, 2.35017E-06_JPRB, 2.28666E-06_JPRB, 2.22486E-06_JPRB, &
+ & 2.16473E-06_JPRB, 2.10623E-06_JPRB, 2.04930E-06_JPRB, 1.99392E-06_JPRB, 1.94003E-06_JPRB, &
+ & 1.88760E-06_JPRB, 1.83659E-06_JPRB, 1.78695E-06_JPRB, 1.73866E-06_JPRB/)
+ KAO_MN2(:, 9) = (/ &
+ & 2.79917E-06_JPRB, 2.73207E-06_JPRB, 2.66658E-06_JPRB, 2.60266E-06_JPRB, 2.54027E-06_JPRB, &
+ & 2.47937E-06_JPRB, 2.41994E-06_JPRB, 2.36192E-06_JPRB, 2.30530E-06_JPRB, 2.25004E-06_JPRB, &
+ & 2.19610E-06_JPRB, 2.14346E-06_JPRB, 2.09208E-06_JPRB, 2.04193E-06_JPRB, 1.99298E-06_JPRB, &
+ & 1.94520E-06_JPRB, 1.89857E-06_JPRB, 1.85306E-06_JPRB, 1.80864E-06_JPRB/)
+ KAO_MN2(:,10) = (/ &
+ & 2.74910E-06_JPRB, 2.64462E-06_JPRB, 2.54412E-06_JPRB, 2.44743E-06_JPRB, 2.35442E-06_JPRB, &
+ & 2.26495E-06_JPRB, 2.17887E-06_JPRB, 2.09606E-06_JPRB, 2.01641E-06_JPRB, 1.93978E-06_JPRB, &
+ & 1.86606E-06_JPRB, 1.79514E-06_JPRB, 1.72692E-06_JPRB, 1.66129E-06_JPRB, 1.59815E-06_JPRB, &
+ & 1.53742E-06_JPRB, 1.47899E-06_JPRB, 1.42278E-06_JPRB, 1.36871E-06_JPRB/)
+ KAO_MN2(:,11) = (/ &
+ & 2.63952E-06_JPRB, 2.60263E-06_JPRB, 2.56626E-06_JPRB, 2.53039E-06_JPRB, 2.49503E-06_JPRB, &
+ & 2.46016E-06_JPRB, 2.42578E-06_JPRB, 2.39188E-06_JPRB, 2.35845E-06_JPRB, 2.32549E-06_JPRB, &
+ & 2.29299E-06_JPRB, 2.26094E-06_JPRB, 2.22934E-06_JPRB, 2.19819E-06_JPRB, 2.16747E-06_JPRB, &
+ & 2.13717E-06_JPRB, 2.10731E-06_JPRB, 2.07786E-06_JPRB, 2.04882E-06_JPRB/)
+ KAO_MN2(:,12) = (/ &
+ & 2.94106E-06_JPRB, 2.82819E-06_JPRB, 2.71966E-06_JPRB, 2.61528E-06_JPRB, 2.51492E-06_JPRB, &
+ & 2.41841E-06_JPRB, 2.32560E-06_JPRB, 2.23635E-06_JPRB, 2.15053E-06_JPRB, 2.06800E-06_JPRB, &
+ & 1.98863E-06_JPRB, 1.91232E-06_JPRB, 1.83893E-06_JPRB, 1.76836E-06_JPRB, 1.70049E-06_JPRB, &
+ & 1.63524E-06_JPRB, 1.57248E-06_JPRB, 1.51214E-06_JPRB, 1.45411E-06_JPRB/)
+ KAO_MN2(:,13) = (/ &
+ & 2.94607E-06_JPRB, 2.87369E-06_JPRB, 2.80309E-06_JPRB, 2.73422E-06_JPRB, 2.66705E-06_JPRB, &
+ & 2.60152E-06_JPRB, 2.53760E-06_JPRB, 2.47526E-06_JPRB, 2.41445E-06_JPRB, 2.35513E-06_JPRB, &
+ & 2.29726E-06_JPRB, 2.24082E-06_JPRB, 2.18577E-06_JPRB, 2.13207E-06_JPRB, 2.07969E-06_JPRB, &
+ & 2.02859E-06_JPRB, 1.97875E-06_JPRB, 1.93014E-06_JPRB, 1.88272E-06_JPRB/)
+ KAO_MN2(:,14) = (/ &
+ & 2.58051E-06_JPRB, 2.48749E-06_JPRB, 2.39782E-06_JPRB, 2.31139E-06_JPRB, 2.22807E-06_JPRB, &
+ & 2.14775E-06_JPRB, 2.07033E-06_JPRB, 1.99570E-06_JPRB, 1.92376E-06_JPRB, 1.85441E-06_JPRB, &
+ & 1.78756E-06_JPRB, 1.72313E-06_JPRB, 1.66101E-06_JPRB, 1.60114E-06_JPRB, 1.54342E-06_JPRB, &
+ & 1.48778E-06_JPRB, 1.43415E-06_JPRB, 1.38245E-06_JPRB, 1.33262E-06_JPRB/)
+ KAO_MN2(:,15) = (/ &
+ & 3.03447E-06_JPRB, 2.88559E-06_JPRB, 2.74401E-06_JPRB, 2.60938E-06_JPRB, 2.48135E-06_JPRB, &
+ & 2.35961E-06_JPRB, 2.24384E-06_JPRB, 2.13375E-06_JPRB, 2.02906E-06_JPRB, 1.92951E-06_JPRB, &
+ & 1.83484E-06_JPRB, 1.74481E-06_JPRB, 1.65921E-06_JPRB, 1.57780E-06_JPRB, 1.50039E-06_JPRB, &
+ & 1.42677E-06_JPRB, 1.35677E-06_JPRB, 1.29020E-06_JPRB, 1.22690E-06_JPRB/)
+ KAO_MN2(:,16) = (/ &
+ & 1.48655E-06_JPRB, 1.48283E-06_JPRB, 1.47913E-06_JPRB, 1.47543E-06_JPRB, 1.47174E-06_JPRB, &
+ & 1.46806E-06_JPRB, 1.46439E-06_JPRB, 1.46072E-06_JPRB, 1.45707E-06_JPRB, 1.45343E-06_JPRB, &
+ & 1.44979E-06_JPRB, 1.44617E-06_JPRB, 1.44255E-06_JPRB, 1.43894E-06_JPRB, 1.43534E-06_JPRB, &
+ & 1.43176E-06_JPRB, 1.42817E-06_JPRB, 1.42460E-06_JPRB, 1.42104E-06_JPRB/)
+ KBO_MN2(:, 1) = (/ &
+ & 5.12042E-08_JPRB, 5.51239E-08_JPRB, 5.93436E-08_JPRB, 6.38863E-08_JPRB, 6.87767E-08_JPRB, &
+ & 7.40415E-08_JPRB, 7.97093E-08_JPRB, 8.58110E-08_JPRB, 9.23797E-08_JPRB, 9.94513E-08_JPRB, &
+ & 1.07064E-07_JPRB, 1.15260E-07_JPRB, 1.24083E-07_JPRB, 1.33581E-07_JPRB, 1.43807E-07_JPRB, &
+ & 1.54815E-07_JPRB, 1.66666E-07_JPRB, 1.79424E-07_JPRB, 1.93159E-07_JPRB/)
+ KBO_MN2(:, 2) = (/ &
+ & 2.30938E-07_JPRB, 2.41696E-07_JPRB, 2.52955E-07_JPRB, 2.64738E-07_JPRB, 2.77071E-07_JPRB, &
+ & 2.89978E-07_JPRB, 3.03486E-07_JPRB, 3.17623E-07_JPRB, 3.32419E-07_JPRB, 3.47904E-07_JPRB, &
+ & 3.64111E-07_JPRB, 3.81072E-07_JPRB, 3.98824E-07_JPRB, 4.17402E-07_JPRB, 4.36846E-07_JPRB, &
+ & 4.57196E-07_JPRB, 4.78494E-07_JPRB, 5.00784E-07_JPRB, 5.24112E-07_JPRB/)
+ KBO_MN2(:, 3) = (/ &
+ & 6.70458E-07_JPRB, 7.04274E-07_JPRB, 7.39795E-07_JPRB, 7.77109E-07_JPRB, 8.16304E-07_JPRB, &
+ & 8.57476E-07_JPRB, 9.00724E-07_JPRB, 9.46154E-07_JPRB, 9.93876E-07_JPRB, 1.04400E-06_JPRB, &
+ & 1.09666E-06_JPRB, 1.15197E-06_JPRB, 1.21008E-06_JPRB, 1.27111E-06_JPRB, 1.33522E-06_JPRB, &
+ & 1.40256E-06_JPRB, 1.47331E-06_JPRB, 1.54761E-06_JPRB, 1.62567E-06_JPRB/)
+ KBO_MN2(:, 4) = (/ &
+ & 1.84182E-06_JPRB, 1.89203E-06_JPRB, 1.94360E-06_JPRB, 1.99658E-06_JPRB, 2.05101E-06_JPRB, &
+ & 2.10692E-06_JPRB, 2.16435E-06_JPRB, 2.22335E-06_JPRB, 2.28396E-06_JPRB, 2.34622E-06_JPRB, &
+ & 2.41017E-06_JPRB, 2.47587E-06_JPRB, 2.54337E-06_JPRB, 2.61270E-06_JPRB, 2.68392E-06_JPRB, &
+ & 2.75708E-06_JPRB, 2.83224E-06_JPRB, 2.90944E-06_JPRB, 2.98875E-06_JPRB/)
+ KBO_MN2(:, 5) = (/ &
+ & 3.41996E-06_JPRB, 3.32758E-06_JPRB, 3.23770E-06_JPRB, 3.15024E-06_JPRB, 3.06515E-06_JPRB, &
+ & 2.98235E-06_JPRB, 2.90180E-06_JPRB, 2.82341E-06_JPRB, 2.74715E-06_JPRB, 2.67294E-06_JPRB, &
+ & 2.60074E-06_JPRB, 2.53049E-06_JPRB, 2.46214E-06_JPRB, 2.39563E-06_JPRB, 2.33092E-06_JPRB, &
+ & 2.26796E-06_JPRB, 2.20670E-06_JPRB, 2.14709E-06_JPRB, 2.08910E-06_JPRB/)
+ KBO_MN2(:, 6) = (/ &
+ & 3.38746E-06_JPRB, 3.25966E-06_JPRB, 3.13669E-06_JPRB, 3.01836E-06_JPRB, 2.90449E-06_JPRB, &
+ & 2.79491E-06_JPRB, 2.68947E-06_JPRB, 2.58801E-06_JPRB, 2.49037E-06_JPRB, 2.39642E-06_JPRB, &
+ & 2.30601E-06_JPRB, 2.21902E-06_JPRB, 2.13530E-06_JPRB, 2.05475E-06_JPRB, 1.97723E-06_JPRB, &
+ & 1.90264E-06_JPRB, 1.83086E-06_JPRB, 1.76179E-06_JPRB, 1.69532E-06_JPRB/)
+ KBO_MN2(:, 7) = (/ &
+ & 3.17530E-06_JPRB, 3.07196E-06_JPRB, 2.97199E-06_JPRB, 2.87527E-06_JPRB, 2.78170E-06_JPRB, &
+ & 2.69118E-06_JPRB, 2.60360E-06_JPRB, 2.51887E-06_JPRB, 2.43690E-06_JPRB, 2.35759E-06_JPRB, &
+ & 2.28087E-06_JPRB, 2.20664E-06_JPRB, 2.13483E-06_JPRB, 2.06536E-06_JPRB, 1.99814E-06_JPRB, &
+ & 1.93312E-06_JPRB, 1.87021E-06_JPRB, 1.80934E-06_JPRB, 1.75046E-06_JPRB/)
+ KBO_MN2(:, 8) = (/ &
+ & 2.84701E-06_JPRB, 2.77007E-06_JPRB, 2.69521E-06_JPRB, 2.62237E-06_JPRB, 2.55150E-06_JPRB, &
+ & 2.48254E-06_JPRB, 2.41545E-06_JPRB, 2.35017E-06_JPRB, 2.28666E-06_JPRB, 2.22486E-06_JPRB, &
+ & 2.16473E-06_JPRB, 2.10623E-06_JPRB, 2.04930E-06_JPRB, 1.99392E-06_JPRB, 1.94003E-06_JPRB, &
+ & 1.88760E-06_JPRB, 1.83659E-06_JPRB, 1.78695E-06_JPRB, 1.73866E-06_JPRB/)
+ KBO_MN2(:, 9) = (/ &
+ & 2.79917E-06_JPRB, 2.73207E-06_JPRB, 2.66658E-06_JPRB, 2.60266E-06_JPRB, 2.54027E-06_JPRB, &
+ & 2.47937E-06_JPRB, 2.41994E-06_JPRB, 2.36192E-06_JPRB, 2.30530E-06_JPRB, 2.25004E-06_JPRB, &
+ & 2.19610E-06_JPRB, 2.14346E-06_JPRB, 2.09208E-06_JPRB, 2.04193E-06_JPRB, 1.99298E-06_JPRB, &
+ & 1.94520E-06_JPRB, 1.89857E-06_JPRB, 1.85306E-06_JPRB, 1.80864E-06_JPRB/)
+ KBO_MN2(:,10) = (/ &
+ & 2.74910E-06_JPRB, 2.64462E-06_JPRB, 2.54412E-06_JPRB, 2.44743E-06_JPRB, 2.35442E-06_JPRB, &
+ & 2.26495E-06_JPRB, 2.17887E-06_JPRB, 2.09606E-06_JPRB, 2.01641E-06_JPRB, 1.93978E-06_JPRB, &
+ & 1.86606E-06_JPRB, 1.79514E-06_JPRB, 1.72692E-06_JPRB, 1.66129E-06_JPRB, 1.59815E-06_JPRB, &
+ & 1.53742E-06_JPRB, 1.47899E-06_JPRB, 1.42278E-06_JPRB, 1.36871E-06_JPRB/)
+ KBO_MN2(:,11) = (/ &
+ & 2.63952E-06_JPRB, 2.60263E-06_JPRB, 2.56626E-06_JPRB, 2.53039E-06_JPRB, 2.49503E-06_JPRB, &
+ & 2.46016E-06_JPRB, 2.42578E-06_JPRB, 2.39188E-06_JPRB, 2.35845E-06_JPRB, 2.32549E-06_JPRB, &
+ & 2.29299E-06_JPRB, 2.26094E-06_JPRB, 2.22934E-06_JPRB, 2.19819E-06_JPRB, 2.16747E-06_JPRB, &
+ & 2.13717E-06_JPRB, 2.10731E-06_JPRB, 2.07786E-06_JPRB, 2.04882E-06_JPRB/)
+ KBO_MN2(:,12) = (/ &
+ & 2.94106E-06_JPRB, 2.82819E-06_JPRB, 2.71966E-06_JPRB, 2.61528E-06_JPRB, 2.51492E-06_JPRB, &
+ & 2.41841E-06_JPRB, 2.32560E-06_JPRB, 2.23635E-06_JPRB, 2.15053E-06_JPRB, 2.06800E-06_JPRB, &
+ & 1.98863E-06_JPRB, 1.91232E-06_JPRB, 1.83893E-06_JPRB, 1.76836E-06_JPRB, 1.70049E-06_JPRB, &
+ & 1.63524E-06_JPRB, 1.57248E-06_JPRB, 1.51214E-06_JPRB, 1.45411E-06_JPRB/)
+ KBO_MN2(:,13) = (/ &
+ & 2.94607E-06_JPRB, 2.87369E-06_JPRB, 2.80309E-06_JPRB, 2.73422E-06_JPRB, 2.66705E-06_JPRB, &
+ & 2.60152E-06_JPRB, 2.53760E-06_JPRB, 2.47526E-06_JPRB, 2.41445E-06_JPRB, 2.35513E-06_JPRB, &
+ & 2.29726E-06_JPRB, 2.24082E-06_JPRB, 2.18577E-06_JPRB, 2.13207E-06_JPRB, 2.07969E-06_JPRB, &
+ & 2.02859E-06_JPRB, 1.97875E-06_JPRB, 1.93014E-06_JPRB, 1.88272E-06_JPRB/)
+ KBO_MN2(:,14) = (/ &
+ & 2.58051E-06_JPRB, 2.48749E-06_JPRB, 2.39782E-06_JPRB, 2.31139E-06_JPRB, 2.22807E-06_JPRB, &
+ & 2.14775E-06_JPRB, 2.07033E-06_JPRB, 1.99570E-06_JPRB, 1.92376E-06_JPRB, 1.85441E-06_JPRB, &
+ & 1.78756E-06_JPRB, 1.72313E-06_JPRB, 1.66101E-06_JPRB, 1.60114E-06_JPRB, 1.54342E-06_JPRB, &
+ & 1.48778E-06_JPRB, 1.43415E-06_JPRB, 1.38245E-06_JPRB, 1.33262E-06_JPRB/)
+ KBO_MN2(:,15) = (/ &
+ & 3.03447E-06_JPRB, 2.88559E-06_JPRB, 2.74401E-06_JPRB, 2.60938E-06_JPRB, 2.48135E-06_JPRB, &
+ & 2.35961E-06_JPRB, 2.24384E-06_JPRB, 2.13375E-06_JPRB, 2.02906E-06_JPRB, 1.92951E-06_JPRB, &
+ & 1.83484E-06_JPRB, 1.74481E-06_JPRB, 1.65921E-06_JPRB, 1.57780E-06_JPRB, 1.50039E-06_JPRB, &
+ & 1.42677E-06_JPRB, 1.35677E-06_JPRB, 1.29020E-06_JPRB, 1.22690E-06_JPRB/)
+ KBO_MN2(:,16) = (/ &
+ & 1.48655E-06_JPRB, 1.48283E-06_JPRB, 1.47913E-06_JPRB, 1.47543E-06_JPRB, 1.47174E-06_JPRB, &
+ & 1.46806E-06_JPRB, 1.46439E-06_JPRB, 1.46072E-06_JPRB, 1.45707E-06_JPRB, 1.45343E-06_JPRB, &
+ & 1.44979E-06_JPRB, 1.44617E-06_JPRB, 1.44255E-06_JPRB, 1.43894E-06_JPRB, 1.43534E-06_JPRB, &
+ & 1.43176E-06_JPRB, 1.42817E-06_JPRB, 1.42460E-06_JPRB, 1.42104E-06_JPRB/)
+
+
+! The array SELFREFO contains the coefficient of the water vapor
+! self-continuum (including the energy term). The first index
+! refers to temperature in 7.2 degree increments. For instance,
+! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+! etc. The second index runs over the g-channel (1 to 16).
+
+ SELFREFO(:, 1) = (/ &
+ & 2.16803e+00_JPRB, 1.98236e+00_JPRB, 1.81260e+00_JPRB, 1.65737e+00_JPRB, 1.51544e+00_JPRB, &
+ & 1.38567e+00_JPRB, 1.26700e+00_JPRB, 1.15850e+00_JPRB, 1.05929e+00_JPRB, 9.68576e-01_JPRB/)
+ SELFREFO(:, 2) = (/ &
+ & 3.70149e+00_JPRB, 3.43145e+00_JPRB, 3.18110e+00_JPRB, 2.94902e+00_JPRB, 2.73387e+00_JPRB, &
+ & 2.53441e+00_JPRB, 2.34951e+00_JPRB, 2.17810e+00_JPRB, 2.01919e+00_JPRB, 1.87188e+00_JPRB/)
+ SELFREFO(:, 3) = (/ &
+ & 6.17433e+00_JPRB, 5.62207e+00_JPRB, 5.11920e+00_JPRB, 4.66131e+00_JPRB, 4.24438e+00_JPRB, &
+ & 3.86474e+00_JPRB, 3.51906e+00_JPRB, 3.20430e+00_JPRB, 2.91769e+00_JPRB, 2.65672e+00_JPRB/)
+ SELFREFO(:, 4) = (/ &
+ & 6.56459e+00_JPRB, 5.94787e+00_JPRB, 5.38910e+00_JPRB, 4.88282e+00_JPRB, 4.42410e+00_JPRB, &
+ & 4.00848e+00_JPRB, 3.63190e+00_JPRB, 3.29070e+00_JPRB, 2.98155e+00_JPRB, 2.70145e+00_JPRB/)
+ SELFREFO(:, 5) = (/ &
+ & 6.49581e+00_JPRB, 5.91114e+00_JPRB, 5.37910e+00_JPRB, 4.89494e+00_JPRB, 4.45436e+00_JPRB, &
+ & 4.05344e+00_JPRB, 3.68860e+00_JPRB, 3.35660e+00_JPRB, 3.05448e+00_JPRB, 2.77956e+00_JPRB/)
+ SELFREFO(:, 6) = (/ &
+ & 6.50189e+00_JPRB, 5.89381e+00_JPRB, 5.34260e+00_JPRB, 4.84294e+00_JPRB, 4.39001e+00_JPRB, &
+ & 3.97944e+00_JPRB, 3.60727e+00_JPRB, 3.26990e+00_JPRB, 2.96409e+00_JPRB, 2.68687e+00_JPRB/)
+ SELFREFO(:, 7) = (/ &
+ & 6.64768e+00_JPRB, 6.01719e+00_JPRB, 5.44650e+00_JPRB, 4.92993e+00_JPRB, 4.46236e+00_JPRB, &
+ & 4.03914e+00_JPRB, 3.65605e+00_JPRB, 3.30930e+00_JPRB, 2.99543e+00_JPRB, 2.71134e+00_JPRB/)
+ SELFREFO(:, 8) = (/ &
+ & 6.43744e+00_JPRB, 5.87166e+00_JPRB, 5.35560e+00_JPRB, 4.88490e+00_JPRB, 4.45557e+00_JPRB, &
+ & 4.06397e+00_JPRB, 3.70679e+00_JPRB, 3.38100e+00_JPRB, 3.08384e+00_JPRB, 2.81281e+00_JPRB/)
+ SELFREFO(:, 9) = (/ &
+ & 6.55466e+00_JPRB, 5.99777e+00_JPRB, 5.48820e+00_JPRB, 5.02192e+00_JPRB, 4.59525e+00_JPRB, &
+ & 4.20484e+00_JPRB, 3.84759e+00_JPRB, 3.52070e+00_JPRB, 3.22158e+00_JPRB, 2.94787e+00_JPRB/)
+ SELFREFO(:,10) = (/ &
+ & 6.84510e+00_JPRB, 6.26933e+00_JPRB, 5.74200e+00_JPRB, 5.25902e+00_JPRB, 4.81667e+00_JPRB, &
+ & 4.41152e+00_JPRB, 4.04046e+00_JPRB, 3.70060e+00_JPRB, 3.38933e+00_JPRB, 3.10424e+00_JPRB/)
+ SELFREFO(:,11) = (/ &
+ & 6.83128e+00_JPRB, 6.25536e+00_JPRB, 5.72800e+00_JPRB, 5.24510e+00_JPRB, 4.80291e+00_JPRB, &
+ & 4.39799e+00_JPRB, 4.02722e+00_JPRB, 3.68770e+00_JPRB, 3.37681e+00_JPRB, 3.09212e+00_JPRB/)
+ SELFREFO(:,12) = (/ &
+ & 7.35969e+00_JPRB, 6.61719e+00_JPRB, 5.94960e+00_JPRB, 5.34936e+00_JPRB, 4.80968e+00_JPRB, &
+ & 4.32445e+00_JPRB, 3.88817e+00_JPRB, 3.49590e+00_JPRB, 3.14321e+00_JPRB, 2.82610e+00_JPRB/)
+ SELFREFO(:,13) = (/ &
+ & 7.50064e+00_JPRB, 6.80749e+00_JPRB, 6.17840e+00_JPRB, 5.60744e+00_JPRB, 5.08925e+00_JPRB, &
+ & 4.61894e+00_JPRB, 4.19210e+00_JPRB, 3.80470e+00_JPRB, 3.45310e+00_JPRB, 3.13399e+00_JPRB/)
+ SELFREFO(:,14) = (/ &
+ & 7.40801e+00_JPRB, 6.71328e+00_JPRB, 6.08370e+00_JPRB, 5.51316e+00_JPRB, 4.99613e+00_JPRB, &
+ & 4.52759e+00_JPRB, 4.10298e+00_JPRB, 3.71820e+00_JPRB, 3.36950e+00_JPRB, 3.05351e+00_JPRB/)
+ SELFREFO(:,15) = (/ &
+ & 7.51895e+00_JPRB, 6.68846e+00_JPRB, 5.94970e+00_JPRB, 5.29254e+00_JPRB, 4.70796e+00_JPRB, &
+ & 4.18795e+00_JPRB, 3.72538e+00_JPRB, 3.31390e+00_JPRB, 2.94787e+00_JPRB, 2.62227e+00_JPRB/)
+ SELFREFO(:,16) = (/ &
+ & 7.84774e+00_JPRB, 6.80673e+00_JPRB, 5.90380e+00_JPRB, 5.12065e+00_JPRB, 4.44138e+00_JPRB, &
+ & 3.85223e+00_JPRB, 3.34122e+00_JPRB, 2.89800e+00_JPRB, 2.51357e+00_JPRB, 2.18014e+00_JPRB/)
+
+
+
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB1',1,ZHOOK_HANDLE)
+RETURN
+
+1000 CONTINUE
+CALL ABOR1("RRTM_KGB1:ERROR OPENING FILE RADRRTM")
+1001 CONTINUE
+CALL ABOR1("RRTM_KGB1:ERROR READING FILE RADRRTM")
+
+! -----------------------------------------------------------------
+END SUBROUTINE RRTM_KGB1
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/rrtm_rrtm_140gp_mcica.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/rrtm_rrtm_140gp_mcica.F90
new file mode 100644
index 0000000000000000000000000000000000000000..909d48afc107a5a9e8d7b4a2b28c2da6a654b66e
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/rrtm_rrtm_140gp_mcica.F90
@@ -0,0 +1,304 @@
+SUBROUTINE RRTM_RRTM_140GP_MCICA &
+ &( KIDIA , KFDIA , KLON , KLEV, KCOLS, KCLDCOL,&
+ & PAER , PAPH , PAP , PAERTAUL, PAERASYL, PAEROMGL, &
+ & PTS , PTH , PT , &
+ & PEMIS , PEMIW ,&
+ & PQ , PCO2 , PCH4 , PN2O, PNO2 , PC11, PC12, PC22, PCL4, POZN ,&
+ & PCLDF , PTAUCLD, PCLFR,&
+ & PEMIT , PFLUX , PFLUC, &
+ & PLwDerivative)
+
+! *** This program is the driver for the McICA version of RRTM_LW,
+! the AER rapid model.
+
+! For each atmosphere the user wishes to analyze, this routine
+! a) calls ECRTATM to read in the atmospheric profile
+! b) calls SETCOEF to calculate various quantities needed for
+! the radiative transfer algorithm
+! c) calls RTRN to do the radiative transfer calculation for
+! clear or cloudy sky
+! d) writes out the upward, downward, and net flux for each
+! level and the heating rate for each layer
+
+! JJMorcrette 20050110 McICA version revisited (changes in RRTM_ECRT, RRTM_RTRN)
+! NEC 25-Oct-2007 Optimisations
+! JJMorcrette 20080424 3D fields of CO2, CH4, N2O, NO2, CFC11, 12, 22 and CCL4
+! JJMorcrette 20110613 flexible number of g-points
+! P Bechtold 14/05/2012 replace ZHEATF by core constants RG*RDAY/RCPD
+! and put arrays to scalars
+! R Hogan 20/05/2014 pass partial derivatives back to calling function
+!-----------------------------------------------------------------------
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE PARRRTM , ONLY : JPBAND, JPXSEC, JPINPX
+USE YOERRTM , ONLY : JPGPT
+USE YOMCST , ONLY : RG ! , RDAYI, RCPD
+
+IMPLICIT NONE
+
+!------------------------------Arguments--------------------------------
+
+! Input arguments
+
+INTEGER(KIND=JPIM),INTENT(IN) :: KLON! Number of atmospheres (longitudes)
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV! Number of atmospheric layers
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA ! First atmosphere index
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA ! Last atmosphere index
+INTEGER(KIND=JPIM),INTENT(IN) :: KCOLS ! Number of columns on which to perform RT
+ ! should be the same as number of g-points, JPGPT
+INTEGER(KIND=JPIM),INTENT(IN) :: KCLDCOL(KLON) ! cloudy column index: 1=cloud, 0: clear
+
+REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV) ! Aerosol optical thickness
+REAL(KIND=JPRB) ,INTENT(IN) :: PAERTAUL(KLON,KLEV,16), PAERASYL(KLON,KLEV,16), PAEROMGL(KLON,KLEV,16)
+REAL(KIND=JPRB) ,INTENT(IN) :: PAPH(KLON,KLEV+1) ! Interface pressures (Pa)
+REAL(KIND=JPRB) ,INTENT(IN) :: PAP(KLON,KLEV) ! Layer pressures (Pa)
+REAL(KIND=JPRB) ,INTENT(IN) :: PTS(KLON) ! Surface temperature (JK)
+REAL(KIND=JPRB) ,INTENT(IN) :: PTH(KLON,KLEV+1) ! Interface temperatures (JK)
+REAL(KIND=JPRB) ,INTENT(IN) :: PT(KLON,KLEV) ! Layer temperature (JK)
+REAL(KIND=JPRB) ,INTENT(IN) :: PEMIS(KLON) ! Non-window surface emissivity
+REAL(KIND=JPRB) ,INTENT(IN) :: PEMIW(KLON) ! Window surface emissivity
+REAL(KIND=JPRB) ,INTENT(IN) :: PQ(KLON,KLEV) ! H2O specific humidity (mmr)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCO2(KLON,KLEV) ! CO2 mass mixing ratio
+REAL(KIND=JPRB) ,INTENT(IN) :: PCH4(KLON,KLEV) ! CH4 mass mixing ratio
+REAL(KIND=JPRB) ,INTENT(IN) :: PN2O(KLON,KLEV) ! N2O mass mixing ratio
+REAL(KIND=JPRB) ,INTENT(IN) :: PNO2(KLON,KLEV) ! NO2 mass mixing ratio
+REAL(KIND=JPRB) ,INTENT(IN) :: PC11(KLON,KLEV) ! CFC11 mass mixing ratio
+REAL(KIND=JPRB) ,INTENT(IN) :: PC12(KLON,KLEV) ! CFC12 mass mixing ratio
+REAL(KIND=JPRB) ,INTENT(IN) :: PC22(KLON,KLEV) ! CFC22 mass mixing ratio
+REAL(KIND=JPRB) ,INTENT(IN) :: PCL4(KLON,KLEV) ! CCL4 mass mixing ratio
+REAL(KIND=JPRB) ,INTENT(IN) :: POZN(KLON,KLEV) ! O3 mass mixing ratio
+REAL(KIND=JPRB) ,INTENT(IN) :: PCLFR(KLON,KLEV)
+
+REAL(KIND=JPRB) ,INTENT(OUT) :: PEMIT(KLON) ! Surface LW emissivity
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUX(KLON,2,KLEV+1) ! LW total sky flux (1=up, 2=down)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUC(KLON,2,KLEV+1) ! LW clear sky flux (1=up, 2=down)
+
+! Partial derivative of total upward flux at each level with respect
+! to upward flux at surface, used to correct heating rates at
+! gridpoints/timesteps between calls to the full radiation scheme:
+REAL(KIND=JPRB) ,INTENT(OUT) :: PLwDerivative(KLON,KLEV+1)
+
+!-- McICA ----------
+REAL(KIND=JPRB) ,INTENT(IN) :: PCLDF(KLON,KCOLS,KLEV) ! Cloud fraction
+REAL(KIND=JPRB) ,INTENT(IN) :: PTAUCLD(KLON,KLEV,KCOLS) ! Cloud optical depth
+
+REAL(KIND=JPRB) :: ZCLDFRAC(KIDIA:KFDIA,KCOLS,KLEV) ! Cloud fraction
+REAL(KIND=JPRB) :: ZTAUCLD(KIDIA:KFDIA,KLEV,KCOLS) ! Spectral optical thickness
+!-- McICA ----------
+
+REAL(KIND=JPRB) :: ZATR1(KIDIA:KFDIA,JPGPT,KLEV)
+
+REAL(KIND=JPRB) :: ZOD(KIDIA:KFDIA,JPGPT,KLEV)
+
+REAL(KIND=JPRB) :: ZTF1(KIDIA:KFDIA,JPGPT,KLEV)
+
+REAL(KIND=JPRB) :: ZCOLDRY(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZWBRODL(KIDIA:KFDIA,KLEV) !BROADENING GASES,column density (mol/cm2)
+REAL(KIND=JPRB) :: ZCOLBRD(KIDIA:KFDIA,KLEV) !BROADENING GASES, column amount
+REAL(KIND=JPRB) :: ZWKL(KIDIA:KFDIA,JPINPX,KLEV)
+
+REAL(KIND=JPRB) :: ZWX(KIDIA:KFDIA,JPXSEC,KLEV) ! Amount of trace gases
+
+REAL(KIND=JPRB) :: ZTOTDFLUC(KIDIA:KFDIA,0:KLEV)
+REAL(KIND=JPRB) :: ZTOTDFLUX(KIDIA:KFDIA,0:KLEV)
+REAL(KIND=JPRB) :: ZTOTUFLUC(KIDIA:KFDIA,0:KLEV)
+REAL(KIND=JPRB) :: ZTOTUFLUX(KIDIA:KFDIA,0:KLEV)
+
+INTEGER(KIND=JPIM) :: JL, JK
+INTEGER(KIND=JPIM) :: ISTART
+INTEGER(KIND=JPIM) :: IEND
+
+REAL(KIND=JPRB) :: ZFLUXFAC, ZHEATFAC, ZPI
+REAL(KIND=JPRB) :: ZEPSEC
+
+!- from AER
+REAL(KIND=JPRB) :: ZTAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
+
+!- from INTFAC
+REAL(KIND=JPRB) :: ZFAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZFAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZFAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZFAC11(KIDIA:KFDIA,KLEV)
+
+!- from FOR
+REAL(KIND=JPRB) :: ZFORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZFORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM) :: INDFOR(KIDIA:KFDIA,KLEV)
+
+!- from MINOR
+INTEGER(KIND=JPIM) :: INDMINOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZSCALEMINOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZSCALEMINORN2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZMINORFRAC(KIDIA:KFDIA,KLEV)
+
+REAL(KIND=JPRB) :: &
+ & ZRAT_H2OCO2(KIDIA:KFDIA,KLEV),ZRAT_H2OCO2_1(KIDIA:KFDIA,KLEV), &
+ & ZRAT_H2OO3(KIDIA:KFDIA,KLEV) ,ZRAT_H2OO3_1(KIDIA:KFDIA,KLEV), &
+ & ZRAT_H2ON2O(KIDIA:KFDIA,KLEV),ZRAT_H2ON2O_1(KIDIA:KFDIA,KLEV), &
+ & ZRAT_H2OCH4(KIDIA:KFDIA,KLEV),ZRAT_H2OCH4_1(KIDIA:KFDIA,KLEV), &
+ & ZRAT_N2OCO2(KIDIA:KFDIA,KLEV),ZRAT_N2OCO2_1(KIDIA:KFDIA,KLEV), &
+ & ZRAT_O3CO2(KIDIA:KFDIA,KLEV) ,ZRAT_O3CO2_1(KIDIA:KFDIA,KLEV)
+
+!- from INTIND
+INTEGER(KIND=JPIM) :: JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM) :: JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM) :: JT1(KIDIA:KFDIA,KLEV)
+
+!- from PRECISE
+REAL(KIND=JPRB) :: ZONEMINUS
+
+!- from PROFDATA
+REAL(KIND=JPRB) :: ZCOLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZCOLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZCOLO3(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZCOLN2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZCOLCH4(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZCOLO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZCO2MULT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM) :: ILAYTROP(KIDIA:KFDIA)
+INTEGER(KIND=JPIM) :: ILAYSWTCH(KIDIA:KFDIA)
+INTEGER(KIND=JPIM) :: ILAYLOW(KIDIA:KFDIA)
+
+!- from PROFILE
+REAL(KIND=JPRB) :: ZPAVEL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZTAVEL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZPZ(KIDIA:KFDIA,0:KLEV)
+REAL(KIND=JPRB) :: ZTZ(KIDIA:KFDIA,0:KLEV)
+REAL(KIND=JPRB) :: ZTBOUND(KIDIA:KFDIA)
+
+!- from SELF
+REAL(KIND=JPRB) :: ZSELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZSELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM) :: INDSELF(KIDIA:KFDIA,KLEV)
+
+!- from SP
+REAL(KIND=JPRB) :: ZPFRAC(KIDIA:KFDIA,JPGPT,KLEV)
+
+!- from SURFACE
+REAL(KIND=JPRB) :: ZSEMISS(KIDIA:KFDIA,JPBAND)
+REAL(KIND=JPRB) :: ZSEMISLW(KIDIA:KFDIA)
+INTEGER(KIND=JPIM) :: IREFLECT(KIDIA:KFDIA)
+
+! Local variable required in case KFDIA /= KLON
+REAL(KIND=JPRB) :: ZLwDerivative(KIDIA:KFDIA,KLEV+1)
+
+LOGICAL :: LLPRINT
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+!#include "rrtm_ecrt_140gp_mcica.intfb.h"
+#include "rrtm_gasabs1a_140gp.intfb.h"
+!#include "rrtm_rtrn1a_140gp_mcica.intfb.h"
+!#include "rrtm_setcoef_140gp.intfb.h"
+
+! HEATFAC is the factor by which one must multiply delta-flux/
+! delta-pressure, with flux in w/m-2 and pressure in mbar, to get
+! the heating rate in units of degrees/day. It is equal to
+! (g)x(#sec/day)x(1e-5)/(specific heat of air at const. p)
+! = (9.8066)(86400)(1e-5)/(1.004)
+
+IF (LHOOK) CALL DR_HOOK('RRTM_RRTM_140GP_MCICA',0,ZHOOK_HANDLE)
+
+ASSOCIATE(NFLEVG=>KLEV)
+
+ZEPSEC = 1.E-06_JPRB
+ZONEMINUS = 1.0_JPRB - ZEPSEC
+ZPI = 2.0_JPRB*ASIN(1.0_JPRB)
+ZFLUXFAC = ZPI * 2.E+4
+!ZHEATFAC = 8.4391_JPRB
+!ZHEATFAC = RG*RDAYI/RCPD*1.E-2_JPRB
+
+! *** mji ***
+
+! For use with ECRT, this loop is over atmospheres (or longitudes)
+LLPRINT=.TRUE.
+
+! do JK=1,KLEV
+! print 9901,JK,PT(JL,JK),PQ(JL,JK),POZN(JL,JK),PCLDF(JL,JK,1),PTAUCLD(JL,JK,1)
+! enddo
+
+! *** mji ***
+!- Prepare atmospheric profile from ECRT for use in RRTM, and define
+! other RRTM input parameters. Arrays are passed back through the
+! existing RRTM commons and arrays.
+
+ CALL RRTM_ECRT_140GP_MCICA &
+ &( KIDIA, KFDIA, KLON , KLEV, KCOLS , &
+ & PAER , PAPH , PAP , PAERTAUL, PAERASYL, PAEROMGL, &
+ & pts , PTH , PT , &
+ & PEMIS, PEMIW, &
+ & PQ , PCO2 , PCH4, PN2O, PNO2, PC11, PC12, PC22, PCL4, POZN , PCLDF, PTAUCLD, &
+ & ZCLDFRAC, ZTAUCLD, ZCOLDRY, ZWBRODL,ZWKL, ZWX, &
+ & ZTAUAERL, ZPAVEL , ZTAVEL , ZPZ , ZTZ, ZTBOUND, ZSEMISS, IREFLECT)
+
+ ISTART = 1
+ IEND = 16
+
+! Calculate information needed by the radiative transfer routine
+! that is specific to this atmosphere, especially some of the
+! coefficients and indices needed to compute the optical depths
+! by interpolating data from stored reference atmospheres.
+
+ CALL RRTM_SETCOEF_140GP &
+ &( KIDIA , KFDIA , KLEV , ZCOLDRY , ZWBRODL , ZWKL , &
+ & ZFAC00 , ZFAC01 , ZFAC10 , ZFAC11 , ZFORFAC,ZFORFRAC,INDFOR, JP, JT, JT1 , &
+ & ZCOLH2O, ZCOLCO2 , ZCOLO3 , ZCOLN2O, ZCOLCH4, ZCOLO2,ZCO2MULT , ZCOLBRD, &
+ & ILAYTROP,ILAYSWTCH, ILAYLOW, ZPAVEL , ZTAVEL , ZSELFFAC, ZSELFFRAC, INDSELF, &
+ & INDMINOR,ZSCALEMINOR,ZSCALEMINORN2,ZMINORFRAC,&
+ & ZRAT_H2OCO2, ZRAT_H2OCO2_1, ZRAT_H2OO3, ZRAT_H2OO3_1, &
+ & ZRAT_H2ON2O, ZRAT_H2ON2O_1, ZRAT_H2OCH4, ZRAT_H2OCH4_1, &
+ & ZRAT_N2OCO2, ZRAT_N2OCO2_1, ZRAT_O3CO2, ZRAT_O3CO2_1)
+
+ CALL RRTM_GASABS1A_140GP &
+ &( KIDIA , KFDIA , KLEV, ZATR1, ZOD, ZTF1, ZPAVEL, ZCOLDRY, ZCOLBRD, ZWX ,&
+ & ZTAUAERL, ZFAC00 , ZFAC01, ZFAC10 , ZFAC11 , ZFORFAC,ZFORFRAC,INDFOR, JP, JT, JT1, ZONEMINUS ,&
+ & ZCOLH2O , ZCOLCO2, ZCOLO3, ZCOLN2O, ZCOLCH4, ZCOLO2,ZCO2MULT ,&
+ & ILAYTROP, ILAYSWTCH,ILAYLOW, ZSELFFAC, ZSELFFRAC, INDSELF, ZPFRAC, &
+ & INDMINOR,ZSCALEMINOR,ZSCALEMINORN2,ZMINORFRAC,&
+ & ZRAT_H2OCO2, ZRAT_H2OCO2_1, ZRAT_H2OO3, ZRAT_H2OO3_1, &
+ & ZRAT_H2ON2O, ZRAT_H2ON2O_1, ZRAT_H2OCH4, ZRAT_H2OCH4_1, &
+ & ZRAT_N2OCO2, ZRAT_N2OCO2_1, ZRAT_O3CO2, ZRAT_O3CO2_1)
+
+!- Call the radiative transfer routine.
+
+! Clear and cloudy parts of column are treated together in RTRN.
+
+! print 9901,JL,ZTBOUND
+
+ CALL RRTM_RTRN1A_140GP_MCICA &
+ &( KIDIA, KFDIA, KLEV, ISTART, IEND, KCOLS ,&
+ & ZCLDFRAC, ZTAUCLD, ZATR1 ,&
+ & ZOD , ZTF1 , &
+ & ZTOTDFLUC, ZTOTDFLUX, ZTOTUFLUC, ZTOTUFLUX ,&
+ & ZTAVEL, ZTZ, ZTBOUND, ZPFRAC, ZSEMISS, ZSEMISLW ,&
+ & ZLwDerivative )
+
+! *** Pass clear sky and total sky up and down flux profiles to ECRT
+! output arrays (zflux, zfluc). Array indexing from bottom to top
+! is preserved for ECRT.
+! Invert down flux arrays for consistency with ECRT sign conventions.
+
+DO JL = KIDIA,KFDIA
+
+ PEMIT(JL) = ZSEMISLW(JL)
+ DO JK = 0, KLEV
+ PFLUC(JL,1,JK+1) = ZTOTUFLUC(JL,JK)*ZFLUXFAC
+ PFLUC(JL,2,JK+1) = -ZTOTDFLUC(JL,JK)*ZFLUXFAC
+ PFLUX(JL,1,JK+1) = ZTOTUFLUX(JL,JK)*ZFLUXFAC
+ PFLUX(JL,2,JK+1) = -ZTOTDFLUX(JL,JK)*ZFLUXFAC
+ ENDDO
+
+ ! Copy to output array, noting that they may be dimensioned
+ ! differently
+ PLwDerivative(JL,:) = ZLwDerivative(JL,:)
+
+ENDDO
+
+9901 FORMAT(1X,'rrtm:',I4,12E12.5)
+
+!------------------------------------------------------------------------
+END ASSOCIATE
+
+IF (LHOOK) CALL DR_HOOK('RRTM_RRTM_140GP_MCICA',1,ZHOOK_HANDLE)
+END SUBROUTINE RRTM_RRTM_140GP_MCICA
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/srtm_gas_optical_depth.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/srtm_gas_optical_depth.F90
new file mode 100644
index 0000000000000000000000000000000000000000..12ae9c5dce0a46b20127071f59d1b25059435eeb
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/srtm_gas_optical_depth.F90
@@ -0,0 +1,338 @@
+#ifdef RS6K
+@PROCESS HOT(NOVECTOR) NOSTRICT
+#endif
+SUBROUTINE SRTM_GAS_OPTICAL_DEPTH &
+ & ( KIDIA , KFDIA , KLEV , PONEMINUS, &
+ & PRMU0, &
+ & KLAYTROP,&
+ & PCOLCH4 , PCOLCO2 , PCOLH2O , PCOLMOL , PCOLO2 , PCOLO3 ,&
+ & PFORFAC , PFORFRAC , KINDFOR , PSELFFAC, PSELFFRAC, KINDSELF ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 ,&
+ !-- output arrays
+ & POD, PSSA, PINCSOL)
+
+
+!**** *SRTM_GAS_OPTICAL_DEPTH* - SPECTRAL LOOP TO COMPUTE THE SHORTWAVE RADIATION FLUXES.
+
+! PURPOSE.
+! --------
+
+! COMPUTE THE GAS OPTICAL DEPTH AT EACH SHORTWAVE G POINT
+
+!** INTERFACE.
+! ----------
+
+! *SRTM_GAS_OPTICAL_DEPTH* IS CALLED FROM THE NEW RADIATION SCHEME
+
+! IMPLICIT ARGUMENTS :
+! --------------------
+
+! ==== INPUTS ===
+! ==== OUTPUTS ===
+
+! METHOD.
+! -------
+
+! EXTERNALS.
+! ----------
+
+! REFERENCE.
+! ----------
+
+! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
+! DOCUMENTATION
+! AUTHOR.
+! -------
+! ADAPTED FROM SRTM_SPCVRT_MCICA (BY JEAN-JACQUES MORCRETTE) BY
+! ROBIN HOGAN
+!
+! MODIFICATIONS.
+! --------------
+! ORIGINAL : 2015-07-16
+
+! ------------------------------------------------------------------
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE PARSRTM , ONLY : JPB1, JPB2
+USE YOESRTM , ONLY : JPGPT
+USE YOESRTWN , ONLY : NGC
+
+IMPLICIT NONE
+
+! ------------------------------------------------------------------
+
+!* 0.1 ARGUMENTS
+! ---------
+
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA, KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(IN) :: PONEMINUS(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KIDIA:KFDIA)
+INTEGER(KIND=JPIM),INTENT(IN) :: KLAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLCH4(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLMOL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLO3(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KINDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PSELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PSELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KINDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KJP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KJT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KJT1(KIDIA:KFDIA,KLEV)
+
+REAL(KIND=JPRB) ,INTENT(OUT) :: POD(KIDIA:KFDIA,KLEV,JPGPT) ! Optical depth
+REAL(KIND=JPRB) ,INTENT(OUT) :: PSSA(KIDIA:KFDIA,KLEV,JPGPT) ! Single scattering albedo
+REAL(KIND=JPRB) ,INTENT(OUT) :: PINCSOL(KIDIA:KFDIA,JPGPT) ! Incoming solar flux
+
+
+! ------------------------------------------------------------------
+
+INTEGER(KIND=JPIM) :: IB1, IB2, IBM, IGT, IW(KIDIA:KFDIA), JB, JG, JK, JL, IC, ICOUNT
+
+INTEGER(KIND=JPIM) :: IND(KFDIA-KIDIA+1)
+
+
+!-- Output of SRTM_TAUMOLn routines
+REAL(KIND=JPRB) :: ZTAUG(KIDIA:KFDIA,KLEV,16) ! Absorption optical depth
+REAL(KIND=JPRB) :: ZTAUR(KIDIA:KFDIA,KLEV,16) ! Rayleigh optical depth
+REAL(KIND=JPRB) :: ZSFLXZEN(KIDIA:KFDIA,16) ! Incoming solar flux
+
+
+REAL(KIND=JPRB) :: ZTAU, ZPAO, ZPTO
+REAL(KIND=JPRB) :: ZPAOJ(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZPTOJ(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZRMU0D(KIDIA:KFDIA)
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+
+#include "srtm_taumol16.intfb.h"
+#include "srtm_taumol17.intfb.h"
+#include "srtm_taumol18.intfb.h"
+#include "srtm_taumol19.intfb.h"
+#include "srtm_taumol20.intfb.h"
+#include "srtm_taumol21.intfb.h"
+#include "srtm_taumol22.intfb.h"
+#include "srtm_taumol23.intfb.h"
+#include "srtm_taumol24.intfb.h"
+#include "srtm_taumol25.intfb.h"
+#include "srtm_taumol26.intfb.h"
+#include "srtm_taumol27.intfb.h"
+#include "srtm_taumol28.intfb.h"
+#include "srtm_taumol29.intfb.h"
+
+! ------------------------------------------------------------------
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('SRTM_GAS_OPTICAL_DEPTH',0,ZHOOK_HANDLE)
+
+POD = 0.0
+PSSA = 0.0
+PINCSOL = 0.0
+
+IB1=JPB1
+IB2=JPB2
+
+IC=0
+DO JL = KIDIA, KFDIA
+ IF (PRMU0(JL) > 0.0_JPRB) THEN
+ IC=IC+1
+ IND(IC)=JL
+ IW(JL)=0
+ ENDIF
+ENDDO
+ICOUNT=IC
+IF(ICOUNT==0)THEN
+ IF (LHOOK) CALL DR_HOOK('SRTM_SPCVRT_MCICA',1,ZHOOK_HANDLE)
+ RETURN
+ENDIF
+
+JB=IB1-1
+DO JB = IB1, IB2
+ DO IC=1,ICOUNT
+ JL=IND(IC)
+ IBM = JB-15
+ IGT = NGC(IBM)
+ ENDDO
+
+ !-- for each band, computes the gaseous and Rayleigh optical thickness
+ ! for all g-points within the band
+
+ IF (JB == 16) THEN
+ CALL SRTM_TAUMOL16 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS,&
+ & PCOLH2O , PCOLCH4 , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC , PSELFFRAC, KINDSELF, PFORFAC , PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 17) THEN
+ CALL SRTM_TAUMOL17 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLH2O , PCOLCO2 , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 18) THEN
+ CALL SRTM_TAUMOL18 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLH2O , PCOLCH4 , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 19) THEN
+ CALL SRTM_TAUMOL19 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLH2O , PCOLCO2 , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 20) THEN
+ CALL SRTM_TAUMOL20 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 ,&
+ & PCOLH2O , PCOLCH4 , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 21) THEN
+ CALL SRTM_TAUMOL21 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLH2O , PCOLCO2 , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 22) THEN
+ CALL SRTM_TAUMOL22 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLH2O , PCOLMOL , PCOLO2 ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 23) THEN
+ CALL SRTM_TAUMOL23 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 ,&
+ & PCOLH2O , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 24) THEN
+ CALL SRTM_TAUMOL24 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLH2O , PCOLMOL , PCOLO2 , PCOLO3 ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 25) THEN
+ !--- visible 16000-22650 cm-1 0.4415 - 0.6250 um
+ CALL SRTM_TAUMOL25 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 ,&
+ & PCOLH2O , PCOLMOL , PCOLO3 ,&
+ & KLAYTROP ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 26) THEN
+ !--- UV-A 22650-29000 cm-1 0.3448 - 0.4415 um
+ CALL SRTM_TAUMOL26 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PCOLMOL ,KLAYTROP,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 27) THEN
+ !--- UV-B 29000-38000 cm-1 0.2632 - 0.3448 um
+ CALL SRTM_TAUMOL27 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 ,&
+ & PCOLMOL , PCOLO3 ,&
+ & KLAYTROP ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 28) THEN
+ !--- UV-C 38000-50000 cm-1 0.2000 - 0.2632 um
+ CALL SRTM_TAUMOL28 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLMOL , PCOLO2 , PCOLO3 ,&
+ & KLAYTROP ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 29) THEN
+ CALL SRTM_TAUMOL29 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 ,&
+ & PCOLH2O , PCOLCO2 , PCOLMOL ,&
+ & KLAYTROP , PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN , ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ENDIF
+
+ DO JG=1,IGT
+ DO IC=1,ICOUNT
+ JL=IND(IC)
+ IW(JL)=IW(JL)+1
+
+ ! Incoming solar flux into plane perp to incoming radiation
+ PINCSOL(JL,IW(JL)) = ZSFLXZEN(JL,JG)
+ ENDDO
+
+ DO JK=1,KLEV
+ DO IC=1,ICOUNT
+ JL=IND(IC)
+ POD (JL,JK,IW(JL)) = ZTAUR(JL,JK,JG) + ZTAUG(JL,JK,JG)
+ PSSA(JL,JK,IW(JL)) = ZTAUR(JL,JK,JG) / POD(JL,JK,IW(JL))
+ ENDDO
+ ENDDO
+
+ ENDDO !-- end loop on JG (g point)
+
+ENDDO !-- end loop on JB (band)
+
+! ------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_GAS_OPTICAL_DEPTH',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE SRTM_GAS_OPTICAL_DEPTH
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/srtm_kgb16.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/srtm_kgb16.F90
new file mode 100644
index 0000000000000000000000000000000000000000..9ee70e54fe5cd55420c38d585b2e6800f5244cbb
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/srtm_kgb16.F90
@@ -0,0 +1,186 @@
+SUBROUTINE SRTM_KGB16(DIRECTORY)
+
+! Originally by J.Delamere, Atmospheric & Environmental Research.
+! Revision: 2.4
+! BAND 16: 2600-3000 cm-1 (low - H2O,CH4; high - nothing)
+! Reformatted for F90 by JJMorcrette, ECMWF
+! R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+! G.Mozdzynski March 2011 read constants from files
+! T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+! ------------------------------------------------------------------
+
+USE PARKIND1 , ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMLUN , ONLY : NULRAD
+USE YOMMP0 , ONLY : NPROC, MYPROC
+USE MPL_MODULE, ONLY : MPL_BROADCAST
+USE YOMTAG , ONLY : MTAGRAD
+USE YOESRTA16 , ONLY : KA, KB, KA_D, KB_D, SELFREF, FORREF, SFLUXREF, RAYL, STRRAT1, LAYREFFR
+
+! ------------------------------------------------------------------
+
+IMPLICIT NONE
+
+CHARACTER(LEN=*), INTENT(IN) :: DIRECTORY
+
+! KURUCZ
+!CHARACTER(LEN = 80) :: CLZZZ
+CHARACTER(LEN = 80) :: CLF1
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB16',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+ !CALL GETENV("DATA",CLZZZ)
+ !IF(CLZZZ /= " ") THEN
+ ! CLF1=TRIM(CLZZZ)//"/RADSRTM"
+ CLF1 = DIRECTORY // "/RADSRTM"
+ WRITE(0,'(A,A)') 'Reading ',TRIM(CLF1)
+ ! RRTM and SRTM files from ecrad are in big-endian format.
+ ! Here they are covnerted into little-endian at opening
+ ! No need for compialtion option export GFORTRAN_CONVERT_UNIT="little_endian;big_endian:145"
+! OPEN(NULRAD,FILE=TRIM(CLF1),FORM="UNFORMATTED",ACTION="READ",access='sequential',ERR=1000,CONVERT='swap')
+
+ OPEN(NULRAD,FILE=TRIM(CLF1),FORM="UNFORMATTED",ACTION="READ",access='sequential',ERR=1000,CONVERT='BIG_ENDIAN')
+ !ELSE
+ ! OPEN(NULRAD,FILE='RADSRTM',FORM="UNFORMATTED",ACTION="READ",ERR=1000)
+ !ENDIF
+ READ(NULRAD,ERR=1001) KA_D,KB_D
+ KA = REAL(KA_D,JPRB)
+ KB = REAL(KB_D,JPRB)
+ENDIF
+IF( NPROC>1 )THEN
+ CALL MPL_BROADCAST (KA,MTAGRAD,1,CDSTRING='SRTM_KGB16:')
+ CALL MPL_BROADCAST (KB,MTAGRAD,1,CDSTRING='SRTM_KGB16:')
+ENDIF
+
+SFLUXREF = (/ &
+ & 1.92269_JPRB , 1.72844_JPRB , 1.64326_JPRB , 1.58451_JPRB &
+ & , 1.44031_JPRB , 1.25108_JPRB , 1.02724_JPRB , 0.776759_JPRB &
+ & , 0.534444_JPRB , 5.87755E-02_JPRB, 4.86706E-02_JPRB, 3.87989E-02_JPRB &
+ & , 2.84532E-02_JPRB, 1.82431E-02_JPRB, 6.92320E-03_JPRB, 9.70770E-04_JPRB /)
+
+! Rayleigh extinction coefficient at v = 2925 cm-1.
+RAYL = 2.91E-10_JPRB
+
+STRRAT1 = 252.131_JPRB
+
+LAYREFFR = 18
+
+! ------------------------------------------------------------------
+
+! The array KA contains absorption coefs at the 16 chosen g-values
+! for a range of pressure levels> ~100mb, temperatures, and binary
+! species parameters (see taumol.f for definition). The first
+! index in the array, JS, runs from 1 to 9, and corresponds to
+! different values of the binary species parameter. For instance,
+! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8,
+! JS = 3 corresponds to the parameter value 2/8, etc. The second index
+! in the array, JT, which runs from 1 to 5, corresponds to different
+! temperatures. More specifically, JT = 3 means that the data are for
+! the reference temperature TREF for this pressure level, JT = 2 refers
+! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
+! is for TREF+30. The third index, JP, runs from 1 to 13 and refers
+! to the JPth reference pressure level (see taumol.f for these levels
+! in mb). The fourth index, IG, goes from 1 to 16, and indicates
+! which g-interval the absorption coefficients are for.
+! -----------------------------------------------------------------
+
+! -----------------------------------------------------------------
+! The array KB contains absorption coefs at the 16 chosen g-values
+! for a range of pressure levels < ~100mb and temperatures. The first
+! index in the array, JT, which runs from 1 to 5, corresponds to
+! different temperatures. More specifically, JT = 3 means that the
+! data are for the reference temperature TREF for this pressure
+! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
+! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.
+! The second index, JP, runs from 13 to 59 and refers to the JPth
+! reference pressure level (see taumol.f for the value of these
+! pressure levels in mb). The third index, IG, goes from 1 to 16,
+! and tells us which g-interval the absorption coefficients are for.
+! -----------------------------------------------------------------
+
+FORREF(:, 1) = (/ 0.525585E-05_JPRB, 0.527618E-05_JPRB, 0.746929E-04_JPRB /)
+FORREF(:, 2) = (/ 0.794660E-05_JPRB, 0.136902E-04_JPRB, 0.849878E-04_JPRB /)
+FORREF(:, 3) = (/ 0.197099E-04_JPRB, 0.733094E-04_JPRB, 0.121687E-03_JPRB /)
+FORREF(:, 4) = (/ 0.148274E-03_JPRB, 0.169776E-03_JPRB, 0.164848E-03_JPRB /)
+FORREF(:, 5) = (/ 0.230296E-03_JPRB, 0.210384E-03_JPRB, 0.182028E-03_JPRB /)
+FORREF(:, 6) = (/ 0.280575E-03_JPRB, 0.259217E-03_JPRB, 0.196080E-03_JPRB /)
+FORREF(:, 7) = (/ 0.329034E-03_JPRB, 0.291575E-03_JPRB, 0.207044E-03_JPRB /)
+FORREF(:, 8) = (/ 0.349989E-03_JPRB, 0.323471E-03_JPRB, 0.225712E-03_JPRB /)
+FORREF(:, 9) = (/ 0.366097E-03_JPRB, 0.321519E-03_JPRB, 0.253150E-03_JPRB /)
+FORREF(:,10) = (/ 0.383589E-03_JPRB, 0.355314E-03_JPRB, 0.262555E-03_JPRB /)
+FORREF(:,11) = (/ 0.375933E-03_JPRB, 0.372443E-03_JPRB, 0.261313E-03_JPRB /)
+FORREF(:,12) = (/ 0.370652E-03_JPRB, 0.382366E-03_JPRB, 0.250070E-03_JPRB /)
+FORREF(:,13) = (/ 0.375092E-03_JPRB, 0.379542E-03_JPRB, 0.265794E-03_JPRB /)
+FORREF(:,14) = (/ 0.389705E-03_JPRB, 0.384274E-03_JPRB, 0.322135E-03_JPRB /)
+FORREF(:,15) = (/ 0.372084E-03_JPRB, 0.390422E-03_JPRB, 0.370035E-03_JPRB /)
+FORREF(:,16) = (/ 0.437802E-03_JPRB, 0.373406E-03_JPRB, 0.373222E-03_JPRB /)
+
+! -----------------------------------------------------------------
+! The array SELFREF contains the coefficient of the water vapor
+! self-continuum (including the energy term). The first index
+! refers to temperature in 7.2 degree increments. For instance,
+! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+! etc. The second index runs over the g-channel (1 to 16).
+
+SELFREF(:, 1) = (/ &
+ & 0.126758E-02_JPRB, 0.105253E-02_JPRB, 0.873963E-03_JPRB, 0.725690E-03_JPRB, 0.602573E-03_JPRB, &
+ & 0.500344E-03_JPRB, 0.415458E-03_JPRB, 0.344973E-03_JPRB, 0.286447E-03_JPRB, 0.237849E-03_JPRB /)
+SELFREF(:, 2) = (/ &
+ & 0.144006E-02_JPRB, 0.118514E-02_JPRB, 0.975351E-03_JPRB, 0.802697E-03_JPRB, 0.660606E-03_JPRB, &
+ & 0.543667E-03_JPRB, 0.447429E-03_JPRB, 0.368226E-03_JPRB, 0.303044E-03_JPRB, 0.249400E-03_JPRB /)
+SELFREF(:, 3) = (/ &
+ & 0.294018E-02_JPRB, 0.227428E-02_JPRB, 0.175920E-02_JPRB, 0.136077E-02_JPRB, 0.105258E-02_JPRB, &
+ & 0.814189E-03_JPRB, 0.629789E-03_JPRB, 0.487153E-03_JPRB, 0.376821E-03_JPRB, 0.291478E-03_JPRB /)
+SELFREF(:, 4) = (/ &
+ & 0.395290E-02_JPRB, 0.348405E-02_JPRB, 0.307081E-02_JPRB, 0.270658E-02_JPRB, 0.238556E-02_JPRB, &
+ & 0.210261E-02_JPRB, 0.185322E-02_JPRB, 0.163341E-02_JPRB, 0.143967E-02_JPRB, 0.126891E-02_JPRB /)
+SELFREF(:, 5) = (/ &
+ & 0.419122E-02_JPRB, 0.385638E-02_JPRB, 0.354829E-02_JPRB, 0.326481E-02_JPRB, 0.300398E-02_JPRB, &
+ & 0.276399E-02_JPRB, 0.254317E-02_JPRB, 0.234000E-02_JPRB, 0.215305E-02_JPRB, 0.198104E-02_JPRB /)
+SELFREF(:, 6) = (/ &
+ & 0.495659E-02_JPRB, 0.456777E-02_JPRB, 0.420945E-02_JPRB, 0.387924E-02_JPRB, 0.357494E-02_JPRB, &
+ & 0.329450E-02_JPRB, 0.303606E-02_JPRB, 0.279790E-02_JPRB, 0.257842E-02_JPRB, 0.237615E-02_JPRB /)
+SELFREF(:, 7) = (/ &
+ & 0.526981E-02_JPRB, 0.490687E-02_JPRB, 0.456893E-02_JPRB, 0.425426E-02_JPRB, 0.396126E-02_JPRB, &
+ & 0.368844E-02_JPRB, 0.343441E-02_JPRB, 0.319788E-02_JPRB, 0.297764E-02_JPRB, 0.277256E-02_JPRB /)
+SELFREF(:, 8) = (/ &
+ & 0.575426E-02_JPRB, 0.531597E-02_JPRB, 0.491106E-02_JPRB, 0.453699E-02_JPRB, 0.419141E-02_JPRB, &
+ & 0.387216E-02_JPRB, 0.357722E-02_JPRB, 0.330475E-02_JPRB, 0.305303E-02_JPRB, 0.282048E-02_JPRB /)
+SELFREF(:, 9) = (/ &
+ & 0.549881E-02_JPRB, 0.514328E-02_JPRB, 0.481074E-02_JPRB, 0.449970E-02_JPRB, 0.420877E-02_JPRB, &
+ & 0.393665E-02_JPRB, 0.368213E-02_JPRB, 0.344406E-02_JPRB, 0.322138E-02_JPRB, 0.301310E-02_JPRB /)
+SELFREF(:,10) = (/ &
+ & 0.605357E-02_JPRB, 0.561246E-02_JPRB, 0.520349E-02_JPRB, 0.482432E-02_JPRB, 0.447278E-02_JPRB, &
+ & 0.414686E-02_JPRB, 0.384469E-02_JPRB, 0.356453E-02_JPRB, 0.330479E-02_JPRB, 0.306398E-02_JPRB /)
+SELFREF(:,11) = (/ &
+ & 0.640504E-02_JPRB, 0.587858E-02_JPRB, 0.539540E-02_JPRB, 0.495194E-02_JPRB, 0.454492E-02_JPRB, &
+ & 0.417136E-02_JPRB, 0.382850E-02_JPRB, 0.351382E-02_JPRB, 0.322501E-02_JPRB, 0.295993E-02_JPRB /)
+SELFREF(:,12) = (/ &
+ & 0.677803E-02_JPRB, 0.615625E-02_JPRB, 0.559152E-02_JPRB, 0.507859E-02_JPRB, 0.461271E-02_JPRB, &
+ & 0.418957E-02_JPRB, 0.380524E-02_JPRB, 0.345617E-02_JPRB, 0.313913E-02_JPRB, 0.285116E-02_JPRB /)
+SELFREF(:,13) = (/ &
+ & 0.690347E-02_JPRB, 0.627003E-02_JPRB, 0.569472E-02_JPRB, 0.517219E-02_JPRB, 0.469761E-02_JPRB, &
+ & 0.426658E-02_JPRB, 0.387509E-02_JPRB, 0.351953E-02_JPRB, 0.319659E-02_JPRB, 0.290328E-02_JPRB /)
+SELFREF(:,14) = (/ &
+ & 0.692680E-02_JPRB, 0.632795E-02_JPRB, 0.578087E-02_JPRB, 0.528109E-02_JPRB, 0.482452E-02_JPRB, &
+ & 0.440742E-02_JPRB, 0.402638E-02_JPRB, 0.367828E-02_JPRB, 0.336028E-02_JPRB, 0.306977E-02_JPRB /)
+SELFREF(:,15) = (/ &
+ & 0.754894E-02_JPRB, 0.681481E-02_JPRB, 0.615207E-02_JPRB, 0.555378E-02_JPRB, 0.501367E-02_JPRB, &
+ & 0.452609E-02_JPRB, 0.408593E-02_JPRB, 0.368857E-02_JPRB, 0.332986E-02_JPRB, 0.300603E-02_JPRB /)
+SELFREF(:,16) = (/ &
+ & 0.760689E-02_JPRB, 0.709755E-02_JPRB, 0.662232E-02_JPRB, 0.617891E-02_JPRB, 0.576519E-02_JPRB, &
+ & 0.537917E-02_JPRB, 0.501899E-02_JPRB, 0.468293E-02_JPRB, 0.436938E-02_JPRB, 0.407682E-02_JPRB /)
+
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB16',1,ZHOOK_HANDLE)
+RETURN
+
+1000 CONTINUE
+CALL ABOR1("SRTM_KGB16:ERROR OPENING FILE RADSRTM")
+1001 CONTINUE
+CALL ABOR1("SRTM_KGB16:ERROR READING FILE RADSRTM")
+
+END SUBROUTINE SRTM_KGB16
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/srtm_spcvrt_mcica.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/srtm_spcvrt_mcica.F90
new file mode 100644
index 0000000000000000000000000000000000000000..98ae7a98649af277c159caf93d7fcf3984ad6bf4
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/srtm_spcvrt_mcica.F90
@@ -0,0 +1,699 @@
+#ifdef RS6K
+@PROCESS HOT(NOVECTOR) NOSTRICT
+#endif
+SUBROUTINE SRTM_SPCVRT_MCICA &
+ & ( KIDIA , KFDIA , KLEV , KSW , KCOLS , PONEMINUS, &
+ & PALBD , PALBP, &
+ & PFRCL , PTAUC , PASYC , POMGC , PTAUA , PASYA , POMGA , PRMU0, &
+ & KLAYTROP,&
+ & PCOLCH4 , PCOLCO2 , PCOLH2O , PCOLMOL , PCOLO2 , PCOLO3 ,&
+ & PFORFAC , PFORFRAC , KINDFOR , PSELFFAC, PSELFFRAC, KINDSELF ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 ,&
+ !-- output arrays
+ & PBBFD , PBBFU , PBBCD, PBBCU, PFUVF, PFUVC, PPARF, PPARCF, PSUDU, &
+ & PBBFDIR , PBBCDIR , PSwDiffuseBand , PSwDirectBand )
+
+
+!**** *SRTM_SPCVRT* - SPECTRAL LOOP TO COMPUTE THE SHORTWAVE RADIATION FLUXES.
+
+! PURPOSE.
+! --------
+
+! THIS ROUTINE COMPUTES THE TWO-STREAM METHOD OF BARKER
+
+!** INTERFACE.
+! ----------
+
+! *SRTM_SPCVRT_MCICA* IS CALLED FROM *SRTM_SRTM_224GP*
+
+! IMPLICIT ARGUMENTS :
+! --------------------
+
+! ==== INPUTS ===
+! ==== OUTPUTS ===
+
+! METHOD.
+! -------
+
+! EXTERNALS.
+! ----------
+
+! *SWVRTQDR*
+
+! REFERENCE.
+! ----------
+
+! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
+! DOCUMENTATION
+! AUTHOR.
+! -------
+! from Howard Barker
+! JEAN-JACQUES MORCRETTE *ECMWF*
+
+! MODIFICATIONS.
+! --------------
+! ORIGINAL : 03-02-27
+! M.Hamrud 01-Oct-2003 CY28 Cleaning
+! JJMorcrette 20050110 McICA version
+! JJMorcrette 20070614 bug-fix for solar duration
+! JJMorcrette 20070831 UV-B surface flux
+! D.Salmond 31-Oct-2007 Vector version in the style of RRTM from Meteo France & NEC
+! JJMorcrette/MJIacono 20080724 Look-up table replacing exponential
+! JJMorcrette 20091201 Total and clear-sky downward direct flux
+! RJHogan 20140627 Store downwelling surface fluxes in each band
+! ------------------------------------------------------------------
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE PARSRTM , ONLY : JPB1, JPB2
+USE YOESRTM , ONLY : JPGPT
+USE YOESRTWN , ONLY : NGC, NMPSRTM
+USE YOERDI , ONLY : REPCLC
+USE YOESRTAB , ONLY : BPADE, TRANS, RODLOW, RTBLINT
+USE YOERAD , ONLY : NSW, LApproxSwUpdate
+
+IMPLICIT NONE
+
+! ------------------------------------------------------------------
+
+!* 0.1 ARGUMENTS
+! ---------
+
+INTEGER(KIND=JPIM),INTENT(IN) :: KSW
+INTEGER(KIND=JPIM),INTENT(IN) :: KCOLS
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA, KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(IN) :: PONEMINUS(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: PALBD(KIDIA:KFDIA,KSW)
+REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(KIDIA:KFDIA,KSW)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFRCL(KIDIA:KFDIA,KCOLS,KLEV) ! bottom to top
+REAL(KIND=JPRB) ,INTENT(IN) :: PTAUC(KIDIA:KFDIA,KLEV,KCOLS) ! bottom to top
+REAL(KIND=JPRB) ,INTENT(IN) :: PASYC(KIDIA:KFDIA,KLEV,KCOLS) ! bottom to top
+REAL(KIND=JPRB) ,INTENT(IN) :: POMGC(KIDIA:KFDIA,KLEV,KCOLS) ! bottom to top
+REAL(KIND=JPRB) ,INTENT(IN) :: PTAUA(KIDIA:KFDIA,KLEV,KSW) ! bottom to top
+REAL(KIND=JPRB) ,INTENT(IN) :: PASYA(KIDIA:KFDIA,KLEV,KSW) ! bottom to top
+REAL(KIND=JPRB) ,INTENT(IN) :: POMGA(KIDIA:KFDIA,KLEV,KSW) ! bottom to top
+REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KIDIA:KFDIA)
+INTEGER(KIND=JPIM),INTENT(IN) :: KLAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLCH4(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLMOL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLO3(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KINDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PSELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PSELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KINDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KJP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KJT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KJT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(INOUT) :: PBBFD(KIDIA:KFDIA,KLEV+1)
+REAL(KIND=JPRB) ,INTENT(INOUT) :: PBBFU(KIDIA:KFDIA,KLEV+1)
+REAL(KIND=JPRB) ,INTENT(INOUT) :: PBBCD(KIDIA:KFDIA,KLEV+1)
+REAL(KIND=JPRB) ,INTENT(INOUT) :: PBBCU(KIDIA:KFDIA,KLEV+1)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFUVF(KIDIA:KFDIA), PFUVC(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PPARF(KIDIA:KFDIA), PPARCF(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PSUDU(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(INOUT) :: PBBFDIR(KIDIA:KFDIA,KLEV+1)
+REAL(KIND=JPRB) ,INTENT(INOUT) :: PBBCDIR(KIDIA:KFDIA,KLEV+1)
+
+! Surface diffuse and direct downwelling shortwave flux in each
+! shortwave albedo band, used in RADINTG to update the surface fluxes
+! accounting for high-resolution albedo information
+REAL(KIND=JPRB) ,INTENT(OUT) :: PSwDiffuseBand(KIDIA:KFDIA,NSW)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PSwDirectBand(KIDIA:KFDIA,NSW)
+
+! ------------------------------------------------------------------
+
+! ------------
+
+LOGICAL :: LLRTCHK(KIDIA:KFDIA,KLEV)
+
+REAL(KIND=JPRB) :: &
+ & ZCLEAR(KIDIA:KFDIA) , ZCLOUD(KIDIA:KFDIA) &
+ & , ZDBT(KIDIA:KFDIA,KLEV+1) &
+ & , ZGCC(KIDIA:KFDIA,KLEV) , ZGCO(KIDIA:KFDIA,KLEV) &
+ & , ZOMCC(KIDIA:KFDIA,KLEV) , ZOMCO(KIDIA:KFDIA,KLEV) &
+ & , ZRDND(KIDIA:KFDIA,KLEV+1), ZRDNDC(KIDIA:KFDIA,KLEV+1)&
+ & , ZREF(KIDIA:KFDIA,KLEV+1) , ZREFC(KIDIA:KFDIA,KLEV+1) , ZREFO(KIDIA:KFDIA,KLEV+1) &
+ & , ZREFD(KIDIA:KFDIA,KLEV+1), ZREFDC(KIDIA:KFDIA,KLEV+1), ZREFDO(KIDIA:KFDIA,KLEV+1) &
+ & , ZRUP(KIDIA:KFDIA,KLEV+1) , ZRUPD(KIDIA:KFDIA,KLEV+1) &
+ & , ZRUPC(KIDIA:KFDIA,KLEV+1), ZRUPDC(KIDIA:KFDIA,KLEV+1)&
+ & , ZTAUC(KIDIA:KFDIA,KLEV) , ZTAUO(KIDIA:KFDIA,KLEV) &
+ & , ZTDBT(KIDIA:KFDIA,KLEV+1) &
+ & , ZTRA(KIDIA:KFDIA,KLEV+1) , ZTRAC(KIDIA:KFDIA,KLEV+1) , ZTRAO(KIDIA:KFDIA,KLEV+1) &
+ & , ZTRAD(KIDIA:KFDIA,KLEV+1), ZTRADC(KIDIA:KFDIA,KLEV+1), ZTRADO(KIDIA:KFDIA,KLEV+1)
+REAL(KIND=JPRB) :: &
+ & ZDBTC(KIDIA:KFDIA,KLEV+1), ZTDBTC(KIDIA:KFDIA,KLEV+1), ZINCFLX(KIDIA:KFDIA,JPGPT) &
+ & , ZINCF14(KIDIA:KFDIA,14) , ZINCTOT(KIDIA:KFDIA)
+
+INTEGER(KIND=JPIM) :: IB1, IB2, IBM, IGT, IKL, IW(KIDIA:KFDIA), JB, JG, JK, I_KMODTS, JL, IC, ICOUNT
+
+! An index for the 6 bands used in the original albedo data rather
+! than the 14 RRTM bands
+INTEGER(KIND=JPIM) :: JB_ALBEDO
+
+INTEGER(KIND=JPIM) :: INDEX(KIDIA:KFDIA)
+
+REAL(KIND=JPRB) :: ZDBTMC(KIDIA:KFDIA), ZDBTMO(KIDIA:KFDIA), ZF(KIDIA:KFDIA)
+! REAL(KIND=JPRB) :: ZARG1(KIDIA:KFDIA), ZARG2(KIDIA:KFDIA)
+REAL(KIND=JPRB) :: ZINCFLUX(KIDIA:KFDIA), ZWF(KIDIA:KFDIA)
+REAL(KIND=JPRB) :: ZCOEFVS
+
+!-- Output of SRTM_TAUMOLn routines
+
+REAL(KIND=JPRB) :: ZTAUG(KIDIA:KFDIA,KLEV,16), ZTAUR(KIDIA:KFDIA,KLEV,16), ZSFLXZEN(KIDIA:KFDIA,16)
+
+!-- Output of SRTM_VRTQDR routine
+REAL(KIND=JPRB) :: &
+ & ZCD(KIDIA:KFDIA,KLEV+1,JPGPT), ZCU(KIDIA:KFDIA,KLEV+1,JPGPT) &
+ & , ZFD(KIDIA:KFDIA,KLEV+1,JPGPT), ZFU(KIDIA:KFDIA,KLEV+1,JPGPT)
+
+REAL(KIND=JPRB) :: ZTAU, ZPAO, ZPTO
+REAL(KIND=JPRB) :: ZPAOJ(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZPTOJ(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZRMU0D(KIDIA:KFDIA)
+
+!-- Use of exponential look-up table
+REAL(KIND=JPRB) :: ZE1, ZE2, ZTBLIND
+INTEGER(KIND=JPIM) :: ITIND
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+
+#include "srtm_taumol16.intfb.h"
+#include "srtm_taumol17.intfb.h"
+#include "srtm_taumol18.intfb.h"
+#include "srtm_taumol19.intfb.h"
+#include "srtm_taumol20.intfb.h"
+#include "srtm_taumol21.intfb.h"
+#include "srtm_taumol22.intfb.h"
+#include "srtm_taumol23.intfb.h"
+#include "srtm_taumol24.intfb.h"
+#include "srtm_taumol25.intfb.h"
+#include "srtm_taumol26.intfb.h"
+#include "srtm_taumol27.intfb.h"
+#include "srtm_taumol28.intfb.h"
+#include "srtm_taumol29.intfb.h"
+!#include "srtm_reftra.intfb.h"
+!#include "srtm_vrtqdr.intfb.h"
+! ------------------------------------------------------------------
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('SRTM_SPCVRT_MCICA',0,ZHOOK_HANDLE)
+
+!-- Two-stream model 1: Eddington, 2: PIFM, Zdunkowski et al., 3: discrete ordinates
+
+IB1=JPB1
+IB2=JPB2
+
+IC=0
+DO JL = KIDIA, KFDIA
+ IF (PRMU0(JL) > 0.0_JPRB) THEN
+ IC=IC+1
+ INDEX(IC)=JL
+ IW(JL)=0
+ ZINCFLUX(JL)=0.0_JPRB
+ ZINCTOT(JL)=0.0_JPRB
+ PFUVF(JL) = 0.0_JPRB
+ PFUVC(JL) = 0.0_JPRB
+ PPARF(JL) = 0.0_JPRB
+ PPARCF(JL)= 0.0_JPRB
+ ENDIF
+ENDDO
+ICOUNT=IC
+IF(ICOUNT==0)THEN
+ IF (LHOOK) CALL DR_HOOK('SRTM_SPCVRT_MCICA',1,ZHOOK_HANDLE)
+ RETURN
+ENDIF
+
+! Since the stored shortwave downwelling fluxes in bands are
+! accumulated over the g-points within that band, they need to be
+! initialized here
+IF (LApproxSwUpdate) THEN
+ DO JB_ALBEDO = 1,NSW
+ DO JL = KIDIA, KFDIA
+ PSwDiffuseBand(JL,JB_ALBEDO) = 0.0_JPRB
+ PSwDirectBand (JL,JB_ALBEDO) = 0.0_JPRB
+ ENDDO
+ ENDDO
+ENDIF
+
+
+!-- fraction of visible (to 0.69 um) in interval 0.6250-0.7782 um
+ZCOEFVS = 0.42425_JPRB
+
+JB=IB1-1
+DO JB = IB1, IB2
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ IBM = JB-15
+ IGT = NGC(IBM)
+ ZINCF14(JL,IBM)=0.0_JPRB
+ ENDDO
+
+ !-- for each band, computes the gaseous and Rayleigh optical thickness
+ ! for all g-points within the band
+
+ IF (JB == 16) THEN
+ CALL SRTM_TAUMOL16 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS,&
+ & PCOLH2O , PCOLCH4 , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC , PSELFFRAC, KINDSELF, PFORFAC , PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 17) THEN
+ CALL SRTM_TAUMOL17 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLH2O , PCOLCO2 , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 18) THEN
+ CALL SRTM_TAUMOL18 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLH2O , PCOLCH4 , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 19) THEN
+ CALL SRTM_TAUMOL19 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLH2O , PCOLCO2 , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 20) THEN
+ CALL SRTM_TAUMOL20 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 ,&
+ & PCOLH2O , PCOLCH4 , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 21) THEN
+ CALL SRTM_TAUMOL21 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLH2O , PCOLCO2 , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 22) THEN
+ CALL SRTM_TAUMOL22 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLH2O , PCOLMOL , PCOLO2 ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 23) THEN
+ CALL SRTM_TAUMOL23 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 ,&
+ & PCOLH2O , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 24) THEN
+ CALL SRTM_TAUMOL24 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLH2O , PCOLMOL , PCOLO2 , PCOLO3 ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 25) THEN
+ !--- visible 16000-22650 cm-1 0.4415 - 0.6250 um
+ CALL SRTM_TAUMOL25 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 ,&
+ & PCOLH2O , PCOLMOL , PCOLO3 ,&
+ & KLAYTROP ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 26) THEN
+ !--- UV-A 22650-29000 cm-1 0.3448 - 0.4415 um
+ CALL SRTM_TAUMOL26 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PCOLMOL ,KLAYTROP,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 27) THEN
+ !--- UV-B 29000-38000 cm-1 0.2632 - 0.3448 um
+ CALL SRTM_TAUMOL27 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 ,&
+ & PCOLMOL , PCOLO3 ,&
+ & KLAYTROP ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 28) THEN
+ !--- UV-C 38000-50000 cm-1 0.2000 - 0.2632 um
+ CALL SRTM_TAUMOL28 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLMOL , PCOLO2 , PCOLO3 ,&
+ & KLAYTROP ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 29) THEN
+ CALL SRTM_TAUMOL29 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 ,&
+ & PCOLH2O , PCOLCO2 , PCOLMOL ,&
+ & KLAYTROP , PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN , ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ENDIF
+
+!J---Start---
+ DO JK=1,KLEV
+ IKL=KLEV+1-JK
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ ZPAOJ(JL,JK) = PASYA(JL,IKL,IBM)*POMGA(JL,IKL,IBM)
+ ZPTOJ(JL,JK) = PTAUA(JL,IKL,IBM)*POMGA(JL,IKL,IBM)
+ ENDDO
+ ENDDO
+!J---End---
+
+ DO JG=1,IGT
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ IW(JL)=IW(JL)+1
+
+ ZINCFLX(JL,IW(JL)) =ZSFLXZEN(JL,JG)*PRMU0(JL)
+ ZINCFLUX(JL) =ZINCFLUX(JL)+ZSFLXZEN(JL,JG)*PRMU0(JL)
+ ZINCTOT(JL) =ZINCTOT(JL)+ZSFLXZEN(JL,JG)
+ ZINCF14(JL,IBM)=ZINCF14(JL,IBM)+ZSFLXZEN(JL,JG)
+
+ !-- CALL to compute layer reflectances and transmittances for direct
+ ! and diffuse sources, first clear then cloudy.
+ ! Use direct/parallel albedo for direct radiation and diffuse albedo
+ ! otherwise.
+
+ ! ZREFC(JK) direct albedo for clear
+ ! ZREFO(JK) direct albedo for cloud
+ ! ZREFDC(JK) diffuse albedo for clear
+ ! ZREFDO(JK) diffuse albedo for cloud
+ ! ZTRAC(JK) direct transmittance for clear
+ ! ZTRAO(JK) direct transmittance for cloudy
+ ! ZTRADC(JK) diffuse transmittance for clear
+ ! ZTRADO(JK) diffuse transmittance for cloudy
+
+ ! ZREF(JK) direct reflectance
+ ! ZREFD(JK) diffuse reflectance
+ ! ZTRA(JK) direct transmittance
+ ! ZTRAD(JK) diffuse transmittance
+
+ ! ZDBTC(JK) clear direct beam transmittance
+ ! ZDBTO(JK) cloudy direct beam transmittance
+ ! ZDBT(JK) layer mean direct beam transmittance
+ ! ZTDBT(JK) total direct beam transmittance at levels
+
+ !-- clear-sky
+ !----- TOA direct beam
+ ZTDBTC(JL,1)=1._JPRB
+ !----- surface values
+ ZDBTC(JL,KLEV+1) =0.0_JPRB
+ ZTRAC(JL,KLEV+1) =0.0_JPRB
+ ZTRADC(JL,KLEV+1)=0.0_JPRB
+ ZREFC(JL,KLEV+1) =PALBP(JL,IBM)
+ ZREFDC(JL,KLEV+1)=PALBD(JL,IBM)
+ ZRUPC(JL,KLEV+1) =PALBP(JL,IBM)
+ ZRUPDC(JL,KLEV+1)=PALBD(JL,IBM)
+
+ !-- total sky
+ !----- TOA direct beam
+ ZTDBT(JL,1)=1._JPRB
+ !----- surface values
+ ZDBT(JL,KLEV+1) =0.0_JPRB
+ ZTRA(JL,KLEV+1) =0.0_JPRB
+ ZTRAD(JL,KLEV+1)=0.0_JPRB
+ ZREF(JL,KLEV+1) =PALBP(JL,IBM)
+ ZREFD(JL,KLEV+1)=PALBD(JL,IBM)
+ ZRUP(JL,KLEV+1) =PALBP(JL,IBM)
+ ZRUPD(JL,KLEV+1)=PALBD(JL,IBM)
+ ENDDO
+
+
+ !-- NB: a two-stream calculations from top to bottom, but RRTM_SW quantities
+ ! are given bottom to top (argh!)
+ ! Inputs for clouds and aerosols are bottom to top as inputs
+
+! DO JK=1,KLEV
+! IKL=KLEV+1-JK
+! WRITE(NULOUT,8001) IBM,JG,IKL,(PTAUA(INDEX(IC),IKL,IBM),IC=1,ICOUNT)
+8001 format(1X,'McICA_SW',3I5,30E12.5)
+! ENDDO
+
+
+
+ DO JK=1,KLEV
+ IKL=KLEV+1-JK
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ !-- clear-sky optical parameters
+ LLRTCHK(JL,JK)=.TRUE.
+ !-- clear-sky optical parameters including aerosols
+!J ZTAUC(JL,JK) = ZTAUR(JL,IKL,JG) + ZTAUG(JL,IKL,JG) + PTAUA(JL,IKL,IBM)
+!J ZOMCC(JL,JK) = ZTAUR(JL,IKL,JG)*1.0_JPRB + PTAUA(JL,IKL,IBM)*POMGA(JL,IKL,IBM)
+!J ZGCC(JL,JK) = PASYA(JL,IKL,IBM)*POMGA(JL,IKL,IBM)*PTAUA(JL,IKL,IBM) / ZOMCC(JL,JK)
+!J ZOMCC(JL,JK) = ZOMCC(JL,JK) / ZTAUC(JL,JK)
+!J ENDDO
+!J ENDDO
+!J DO JK=1,KLEV
+!J IKL=KLEV+1-JK
+!J DO IC=1,ICOUNT
+!J JL=INDEX(IC)
+!J !-- total sky optical parameters
+!J ZTAUO(JL,JK) = ZTAUR(JL,IKL,JG) + ZTAUG(JL,IKL,JG) + PTAUA(JL,IKL,IBM) + PTAUC(JL,IKL,IW(JL))
+!J ZOMCO(JL,JK) = PTAUA(JL,IKL,IBM)*POMGA(JL,IKL,IBM) + PTAUC(JL,IKL,IW(JL))*POMGC(JL,IKL,IW(JL)) &
+!J & + ZTAUR(JL,IKL,JG)*1.0_JPRB
+!J ZGCO(JL,JK) = (PTAUC(JL,IKL,IW(JL))*POMGC(JL,IKL,IW(JL))*PASYC(JL,IKL,IW(JL)) &
+!J & + PTAUA(JL,IKL,IBM)*POMGA(JL,IKL,IBM)*PASYA(JL,IKL,IBM)) &
+!J & / ZOMCO(JL,JK)
+!J ZOMCO(JL,JK) = ZOMCO(JL,JK) / ZTAUO(JL,JK)
+
+ ZTAU = ZTAUR(JL,IKL,JG) + ZTAUG(JL,IKL,JG)
+! ZPAO = PASYA(JL,IKL,IBM)*POMGA(JL,IKL,IBM)
+! ZPTO = PTAUA(JL,IKL,IBM)*POMGA(JL,IKL,IBM)
+ ZPAO = ZPAOJ(JL,JK)
+ ZPTO = ZPTOJ(JL,JK)
+ ZTAUC(JL,JK) = ZTAU + PTAUA(JL,IKL,IBM)
+ ZOMCC(JL,JK) = ZTAUR(JL,IKL,JG) + ZPTO
+ ZGCC(JL,JK) = ZPAO*PTAUA(JL,IKL,IBM) / ZOMCC(JL,JK)
+ ZOMCC(JL,JK) = ZOMCC(JL,JK) / ZTAUC(JL,JK)
+ !-- total sky optical parameters
+ ZTAUO(JL,JK) = ZTAU + PTAUA(JL,IKL,IBM) + PTAUC(JL,IKL,IW(JL))
+ ZOMCO(JL,JK) = ZPTO + PTAUC(JL,IKL,IW(JL))*POMGC(JL,IKL,IW(JL)) + ZTAUR(JL,IKL,JG)
+ ZGCO(JL,JK) = (PTAUC(JL,IKL,IW(JL))*POMGC(JL,IKL,IW(JL))*PASYC(JL,IKL,IW(JL)) &
+ & + PTAUA(JL,IKL,IBM)*ZPAO) / ZOMCO(JL,JK)
+ ZOMCO(JL,JK) = ZOMCO(JL,JK) / ZTAUO(JL,JK)
+ ENDDO
+ ENDDO
+
+ !-- Delta scaling for clear-sky / aerosol optical quantities
+ DO JK=1,KLEV
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ ZF(JL)=ZGCC(JL,JK)*ZGCC(JL,JK)
+ ZWF(JL)=ZOMCC(JL,JK)*ZF(JL)
+ ZTAUC(JL,JK)=(1._JPRB-ZWF(JL))*ZTAUC(JL,JK)
+ ZOMCC(JL,JK)=(ZOMCC(JL,JK)-ZWF(JL))/(1.0_JPRB-ZWF(JL))
+ ZGCC(JL,JK)=(ZGCC(JL,JK)-ZF(JL))/(1.0_JPRB-ZF(JL))
+ ENDDO
+ ENDDO
+
+ CALL SRTM_REFTRA ( KIDIA, KFDIA, KLEV, I_KMODTS ,&
+ & LLRTCHK, ZGCC , PRMU0, ZTAUC , ZOMCC ,&
+ & ZREFC , ZREFDC, ZTRAC, ZTRADC )
+
+ !-- Delta scaling for cloudy quantities
+ DO JK=1,KLEV
+ IKL=KLEV+1-JK
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ LLRTCHK(JL,JK)=.FALSE.
+ ZF(JL)=ZGCO(JL,JK)*ZGCO(JL,JK)
+ ZWF(JL)=ZOMCO(JL,JK)*ZF(JL)
+ ZTAUO(JL,JK)=(1._JPRB-ZWF(JL))*ZTAUO(JL,JK)
+ ZOMCO(JL,JK)=(ZOMCO(JL,JK)-ZWF(JL))/(1._JPRB-ZWF(JL))
+ ZGCO(JL,JK)=(ZGCO(JL,JK)-ZF(JL))/(1._JPRB-ZF(JL))
+ LLRTCHK(JL,JK)=(PFRCL(JL,IW(JL),IKL) > REPCLC)
+ ENDDO
+ ENDDO
+
+ CALL SRTM_REFTRA ( KIDIA, KFDIA, KLEV, I_KMODTS ,&
+ & LLRTCHK, ZGCO , PRMU0, ZTAUO , ZOMCO ,&
+ & ZREFO , ZREFDO, ZTRAO, ZTRADO )
+
+!J---Start---
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ ZRMU0D(JL)=1.0_JPRB/PRMU0(JL)
+ ENDDO
+!J---End---
+
+ DO JK=1,KLEV
+ IKL=KLEV+1-JK
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ !-- combine clear and cloudy contributions for total sky
+
+ ZCLEAR(JL) = 1.0_JPRB - PFRCL(JL,IW(JL),IKL)
+ ZCLOUD(JL) = PFRCL(JL,IW(JL),IKL)
+
+ ZREF(JL,JK) = ZCLEAR(JL)*ZREFC(JL,JK) + ZCLOUD(JL)*ZREFO(JL,JK)
+ ZREFD(JL,JK)= ZCLEAR(JL)*ZREFDC(JL,JK)+ ZCLOUD(JL)*ZREFDO(JL,JK)
+ ZTRA(JL,JK) = ZCLEAR(JL)*ZTRAC(JL,JK) + ZCLOUD(JL)*ZTRAO(JL,JK)
+ ZTRAD(JL,JK)= ZCLEAR(JL)*ZTRADC(JL,JK)+ ZCLOUD(JL)*ZTRADO(JL,JK)
+
+ !-- direct beam transmittance
+! ZARG1(JL) = MIN( 200._JPRB, ZTAUC(JL,JK)/PRMU0(JL) )
+! ZARG2(JL) = MIN( 200._JPRB, ZTAUO(JL,JK)/PRMU0(JL) )
+! ZDBTMC(JL) = EXP(-ZARG1(JL) )
+! ZDBTMO(JL) = EXP(-ZARG2(JL) )
+
+!-- Use exponential look-up table for transmittance, or expansion of exponential for
+! low optical thickness
+!J ZE1 = ZTAUC(JL,JK)/PRMU0(JL)
+ ZE1 = ZTAUC(JL,JK)*ZRMU0D(JL)
+ IF (ZE1 <= RODLOW) THEN
+ ZDBTMC(JL) = 1._JPRB - ZE1 + 0.5_JPRB*ZE1*ZE1
+ ELSE
+ ZTBLIND = ZE1 / (BPADE+ZE1)
+ ITIND = RTBLINT * ZTBLIND + 0.5_JPRB
+ ZDBTMC(JL) = TRANS(ITIND)
+ ENDIF
+
+!J ZE2 = ZTAUO(JL,JK)/PRMU0(JL)
+ ZE2 = ZTAUO(JL,JK)*ZRMU0D(JL)
+ IF (ZE2 <= RODLOW) THEN
+ ZDBTMO(JL) = 1._JPRB - ZE2 + 0.5_JPRB*ZE2*ZE2
+ ELSE
+ ZTBLIND = ZE2 / (BPADE+ZE2)
+ ITIND = RTBLINT * ZTBLIND + 0.5_JPRB
+ ZDBTMO(JL) = TRANS(ITIND)
+ ENDIF
+!---
+
+ ZDBT(JL,JK) = ZCLEAR(JL)*ZDBTMC(JL)+ZCLOUD(JL)*ZDBTMO(JL)
+ ZTDBT(JL,JK+1)= ZDBT(JL,JK)*ZTDBT(JL,JK)
+
+ !-- clear-sky
+ ZDBTC(JL,JK) =ZDBTMC(JL)
+ ZTDBTC(JL,JK+1)=ZDBTC(JL,JK)*ZTDBTC(JL,JK)
+
+ ENDDO
+ ENDDO
+
+ !-- vertical quadrature producing clear-sky fluxes
+
+ ! print *,'SRTM_SPCVRT after 3 before SRTM_VRTQDR clear'
+
+ CALL SRTM_VRTQDR ( KIDIA, KFDIA, KLEV, IW ,&
+ & ZREFC, ZREFDC, ZTRAC , ZTRADC ,&
+ & ZDBTC, ZRDNDC, ZRUPC , ZRUPDC, ZTDBTC ,&
+ & ZCD , ZCU , PRMU0 )
+
+ !-- vertical quadrature producing cloudy fluxes
+
+ CALL SRTM_VRTQDR ( KIDIA, KFDIA, KLEV, IW ,&
+ & ZREF , ZREFD , ZTRA , ZTRAD ,&
+ & ZDBT , ZRDND , ZRUP , ZRUPD , ZTDBT ,&
+ & ZFD , ZFU , PRMU0)
+
+ !-- up and down-welling fluxes at levels
+ DO JK=1,KLEV+1
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ !-- accumulation of spectral fluxes
+ PBBFU(JL,JK) = PBBFU(JL,JK) + ZINCFLX(JL,IW(JL))*ZFU(JL,JK,IW(JL))
+ PBBFD(JL,JK) = PBBFD(JL,JK) + ZINCFLX(JL,IW(JL))*ZFD(JL,JK,IW(JL))
+ PBBCU(JL,JK) = PBBCU(JL,JK) + ZINCFLX(JL,IW(JL))*ZCU(JL,JK,IW(JL))
+ PBBCD(JL,JK) = PBBCD(JL,JK) + ZINCFLX(JL,IW(JL))*ZCD(JL,JK,IW(JL))
+
+ PBBFDIR(JL,JK)=PBBFDIR(JL,JK)+ZINCFLX(JL,IW(JL))*ZTDBT (JL,JK)
+ PBBCDIR(JL,JK)=PBBCDIR(JL,JK)+ZINCFLX(JL,IW(JL))*ZTDBTC(JL,JK)
+
+ ENDDO
+ ENDDO
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ IF ( JB >= 26 .AND. JB <= 28 ) THEN
+ PFUVF(JL) = PFUVF(JL) + ZINCFLX(JL,IW(JL))*ZFD(JL,KLEV+1,IW(JL))
+ PFUVC(JL) = PFUVC(JL) + ZINCFLX(JL,IW(JL))*ZCD(JL,KLEV+1,IW(JL))
+ ENDIF
+ IF ( JB == 23) THEN
+ PPARF(JL) = PPARF(JL)+ ZINCFLX(JL,IW(JL))*ZFD(JL,KLEV+1,IW(JL))*ZCOEFVS
+ PPARCF(JL)=PPARCF(JL)+ ZINCFLX(JL,IW(JL))*ZCD(JL,KLEV+1,IW(JL))*ZCOEFVS
+ ENDIF
+ IF ( JB == 24) THEN
+ PPARF(JL) = PPARF(JL)+ ZINCFLX(JL,IW(JL))*ZFD(JL,KLEV+1,IW(JL))
+ PPARCF(JL)=PPARCF(JL)+ ZINCFLX(JL,IW(JL))*ZCD(JL,KLEV+1,IW(JL))
+ ENDIF
+ PSUDU(JL) = PSUDU(JL) + ZINCFLX(JL,IW(JL))*ZTDBT(JL,KLEV+1)
+ ENDDO
+
+ ! Store the shortwave downwelling fluxes in each band
+ IF (LApproxSwUpdate) THEN
+ JB_ALBEDO = NMPSRTM(JB-IB1+1)
+ DO IC = 1,ICOUNT
+ JL = INDEX(IC)
+ PSwDiffuseBand(JL,JB_ALBEDO)= PSwDiffuseBand(JL,JB_ALBEDO) &
+ & + ZINCFLX(JL,IW(JL)) * (ZFD(JL, KLEV+1, IW(JL))-ZTDBT(JL,KLEV+1))
+ PSwDirectBand(JL,JB_ALBEDO) = PSwDirectBand(JL,JB_ALBEDO) &
+ & + ZINCFLX(JL,IW(JL)) * ZTDBT(JL,KLEV+1)
+ ENDDO
+ ENDIF
+
+ ENDDO
+ !-- end loop on JG
+
+ENDDO
+!-- end loop on JB
+
+! ------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_SPCVRT_MCICA',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE SRTM_SPCVRT_MCICA
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/srtm_srtm_224gp_mcica.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/srtm_srtm_224gp_mcica.F90
new file mode 100644
index 0000000000000000000000000000000000000000..31b4565b4f4292440826e58346811d36ef11c9e9
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/srtm_srtm_224gp_mcica.F90
@@ -0,0 +1,463 @@
+SUBROUTINE SRTM_SRTM_224GP_MCICA &
+ & ( KIDIA, KFDIA, KLON , KLEV , KSW , KCOLS , KCLDLY ,&
+ & PAER , PALBD, PALBP, PAPH , PAP , PAERTAUS, PAERASYS, PAEROMGS ,&
+ & PTS , PTH , PT ,&
+ & PQ , PCO2 , PCH4 , PN2O , PNO2 , POZN , PRMU0 ,&
+ & PFRCL, PTAUC, PASYC, POMGC,&
+ & PFSUX, PFSUC, PFUVF, PFUVC, PPARF, PPARCF, PSUDU ,&
+ & PFDIR, PCDIR, PFDIF, PCDIF, PSwDiffuseBand, PSwDirectBand, RII0)
+
+!----compiled for Cray with -h nopaattern----
+
+!-- interface to RRTM_SW
+! JJMorcrette 030225
+! JJMorcrette 20050110 McICA version
+! JJMorcrette 20070614 bug-fix for solar duration
+! JJMorcrette 20071015 3D fields of CO2, CH4, N2O and NO2
+! D.Salmond 31-Oct-2007 Vector version in the style of RRTM from Meteo France & NEC
+! JJMorcrette 20091201 Total and clear-sky downward direct flux
+! PBechtold+NSemane 09-Jul-2012 Gravity
+! R J Hogan 20140627 Passing through PSwDn*SurfBand
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMCST , ONLY : RG, RI0
+USE YOERAD , ONLY : NSW, NAER, LApproxSwUpdate
+USE YOESRTAER, ONLY : RSRTAUA, RSRPIZA, RSRASYA
+USE YOEAERATM, ONLY : LAERRRTM, LAERCSTR, LAERVOL
+!USE YOMPHY3 , ONLY : RII0
+USE YOMDYNCORE,ONLY : RPLRG
+USE YOM_YGFL , ONLY : YGFL
+
+IMPLICIT NONE
+
+!-- Input arguments
+
+INTEGER(KIND=JPIM),INTENT(IN) :: KLON
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+INTEGER(KIND=JPIM),INTENT(IN) :: KSW
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KCOLS
+INTEGER(KIND=JPIM),INTENT(IN) :: KCLDLY(KCOLS)
+
+REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV) ! top to bottom
+REAL(KIND=JPRB) ,INTENT(IN) :: PAERTAUS(KLON,KLEV,14), PAERASYS(KLON,KLEV,14), PAEROMGS(KLON,KLEV,14)
+REAL(KIND=JPRB) ,INTENT(IN) :: PALBD(KLON,KSW)
+REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(KLON,KSW)
+REAL(KIND=JPRB) ,INTENT(IN) :: PAPH(KLON,KLEV+1)
+REAL(KIND=JPRB) ,INTENT(IN) :: PAP(KLON,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PTS(KLON)
+REAL(KIND=JPRB) ,INTENT(IN) :: PTH(KLON,KLEV+1)
+REAL(KIND=JPRB) ,INTENT(IN) :: PT(KLON,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PQ(KLON,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCO2(KLON,KLEV), PCH4(KLON,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PN2O(KLON,KLEV), PNO2(KLON,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: POZN(KLON,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KLON)
+
+REAL(KIND=JPRB) ,INTENT(IN) :: PFRCL(KLON,KCOLS,KLEV) ! bottom to top
+REAL(KIND=JPRB) ,INTENT(IN) :: PTAUC(KLON,KCOLS,KLEV) ! bottom to top
+REAL(KIND=JPRB) ,INTENT(IN) :: PASYC(KLON,KCOLS,KLEV) ! bottom to top
+REAL(KIND=JPRB) ,INTENT(IN) :: POMGC(KLON,KCOLS,KLEV) ! bottom to top
+
+!-- Output arguments
+
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFSUX(KLON,2,KLEV+1)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFSUC(KLON,2,KLEV+1)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFUVF(KLON), PFUVC(KLON), PPARF(KLON), PPARCF(KLON)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PSUDU(KLON)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFDIF(KLON,KLEV+1), PCDIF(KLON,KLEV+1)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFDIR(KLON,KLEV+1), PCDIR(KLON,KLEV+1)
+
+! Surface diffuse and direct downwelling shortwave flux in each
+! shortwave albedo band, used in RADINTG to update the surface fluxes
+! accounting for high-resolution albedo information
+REAL(KIND=JPRB) ,INTENT(OUT) :: PSwDiffuseBand(KLON,NSW)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PSwDirectBand (KLON,NSW)
+
+REAL(KIND=JPRB) ,INTENT(IN) :: RII0
+!-----------------------------------------------------------------------
+
+!-- dummy integers
+
+INTEGER(KIND=JPIM) :: ICLDATM, INFLAG, ICEFLAG, I_LIQFLAG, ITMOL, I_NSTR
+
+INTEGER(KIND=JPIM) :: IK, IMOL, J1, J2, JAE, JL, JK, JSW, JB
+
+!-- dummy reals
+
+REAL(KIND=JPRB) :: ZPZ(KIDIA:KFDIA,0:KLEV) , ZPAVEL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZTAVEL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZCOLDRY(KIDIA:KFDIA,KLEV) , ZCOLMOL(KIDIA:KFDIA,KLEV) , ZWKL(KIDIA:KFDIA,35,KLEV)
+REAL(KIND=JPRB) :: ZCOLCH4(KIDIA:KFDIA,KLEV) , ZCOLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZCOLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZCOLO2(KIDIA:KFDIA,KLEV) , ZCOLO3(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZFORFAC(KIDIA:KFDIA,KLEV) , ZFORFRAC(KIDIA:KFDIA,KLEV), ZSELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZSELFFRAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZFAC00(KIDIA:KFDIA,KLEV) , ZFAC01(KIDIA:KFDIA,KLEV) , ZFAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZFAC11(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZONEMINUS(KIDIA:KFDIA) , ZRMU0(KIDIA:KFDIA) , ZADJI0
+REAL(KIND=JPRB) :: ZALBD(KIDIA:KFDIA,KSW) , ZALBP(KIDIA:KFDIA,KSW)
+
+REAL(KIND=JPRB) :: ZFRCL(KIDIA:KFDIA,KCOLS,KLEV), ZTAUC(KIDIA:KFDIA,KLEV,KCOLS), &
+ & ZASYC(KIDIA:KFDIA,KLEV,KCOLS)
+REAL(KIND=JPRB) :: ZOMGC(KIDIA:KFDIA,KLEV,KCOLS)
+REAL(KIND=JPRB) :: ZTAUA(KIDIA:KFDIA,KLEV,KSW), ZASYA(KIDIA:KFDIA,KLEV,KSW), ZOMGA(KIDIA:KFDIA,KLEV,KSW)
+REAL(KIND=JPRB) :: ZFUVF(KIDIA:KFDIA), ZFUVC(KIDIA:KFDIA), ZPARF(KIDIA:KFDIA), ZPARCF(KIDIA:KFDIA), ZSUDU(KIDIA:KFDIA)
+
+REAL(KIND=JPRB) :: ZBBCD(KIDIA:KFDIA,KLEV+1), ZBBCU(KIDIA:KFDIA,KLEV+1), ZBBFD(KIDIA:KFDIA,KLEV+1), &
+ & ZBBFU(KIDIA:KFDIA,KLEV+1)
+REAL(KIND=JPRB) :: ZBBFDIR(KIDIA:KFDIA,KLEV+1),ZBBCDIR(KIDIA:KFDIA,KLEV+1)
+
+! As PSw*Band but dimensioned KIDIA:KFDIA
+REAL(KIND=JPRB) :: ZSwDiffuseBand(KIDIA:KFDIA,NSW)
+REAL(KIND=JPRB) :: ZSwDirectBand (KIDIA:KFDIA,NSW)
+
+INTEGER(KIND=JPIM) :: ILAYTROP(KIDIA:KFDIA)
+INTEGER(KIND=JPIM) :: INDFOR(KIDIA:KFDIA,KLEV), INDSELF(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM) :: JP(KIDIA:KFDIA,KLEV), JT(KIDIA:KFDIA,KLEV), JT1(KIDIA:KFDIA,KLEV)
+
+REAL(KIND=JPRB) :: ZAMD ! Effective molecular weight of dry air (g/mol)
+REAL(KIND=JPRB) :: ZAMW ! Molecular weight of water vapor (g/mol)
+REAL(KIND=JPRB) :: ZAMCO2 ! Molecular weight of carbon dioxide (g/mol)
+REAL(KIND=JPRB) :: ZAMO ! Molecular weight of ozone (g/mol)
+REAL(KIND=JPRB) :: ZAMCH4 ! Molecular weight of methane (g/mol)
+REAL(KIND=JPRB) :: ZAMN2O ! Molecular weight of nitrous oxide (g/mol)
+REAL(KIND=JPRB) :: ZAMC11 ! Molecular weight of CFC11 (g/mol) - CFCL3
+REAL(KIND=JPRB) :: ZAMC12 ! Molecular weight of CFC12 (g/mol) - CF2CL2
+REAL(KIND=JPRB) :: ZAVGDRO ! Avogadro's number (molecules/mole)
+REAL(KIND=JPRB) :: ZGRAVIT ! Gravitational acceleration (cm/sec2)
+REAL(KIND=JPRB) :: ZAMM(KIDIA:KFDIA)
+
+REAL(KIND=JPRB) :: ZRAMW ! Molecular weight of water vapor (g/mol)
+REAL(KIND=JPRB) :: ZRAMCO2 ! Molecular weight of carbon dioxide (g/mol)
+REAL(KIND=JPRB) :: ZRAMO ! Molecular weight of ozone (g/mol)
+REAL(KIND=JPRB) :: ZRAMCH4 ! Molecular weight of methane (g/mol)
+REAL(KIND=JPRB) :: ZRAMN2O ! Molecular weight of nitrous oxide (g/mol)
+
+! Atomic weights for conversion from mass to volume mixing ratios; these
+! are the same values used in ECRT to assure accurate conversion to vmr
+data ZAMD / 28.970_JPRB /
+data ZAMW / 18.0154_JPRB /
+data ZAMCO2 / 44.011_JPRB /
+data ZAMO / 47.9982_JPRB /
+data ZAMCH4 / 16.043_JPRB /
+data ZAMN2O / 44.013_JPRB /
+data ZAMC11 / 137.3686_JPRB /
+data ZAMC12 / 120.9140_JPRB /
+data ZAVGDRO/ 6.02214E23_JPRB /
+data ZRAMW / 0.05550_JPRB /
+data ZRAMCO2 / 0.02272_JPRB /
+data ZRAMO / 0.02083_JPRB /
+data ZRAMCH4 / 0.06233_JPRB /
+data ZRAMN2O / 0.02272_JPRB /
+
+
+!REAL(KIND=JPRB) :: ZCLEAR, ZCLOUD, ZTOTCC
+REAL(KIND=JPRB) :: ZEPSEC
+
+INTEGER(KIND=JPIM) :: IOVLP, IC, ICOUNT, INDEX(KIDIA:KFDIA)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+
+#include "srtm_setcoef.intfb.h"
+!#include "srtm_spcvrt_mcica.intfb.h"
+
+
+!-----------------------------------------------------------------------
+!-- calculate information needed ny the radiative transfer routine
+
+ASSOCIATE(NFLEVG=>KLEV, &
+ & NACTAERO=>YGFL%NACTAERO)
+IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP_MCICA',0,ZHOOK_HANDLE)
+ZGRAVIT =(RG/RPLRG)*1.E2_JPRB
+ZEPSEC = 1.E-06_JPRB
+ZONEMINUS=1.0_JPRB - ZEPSEC
+ZADJI0 = RII0 / RI0
+!-- overlap: 1=max-ran, 2=maximum, 3=random N.B.: irrelevant in McICA version
+IOVLP=3
+
+IC=0
+DO JL = KIDIA, KFDIA
+ IF (PRMU0(JL) > 0.0_JPRB) THEN
+ IC=IC+1
+ INDEX(IC)=JL
+ ENDIF
+ENDDO
+ICOUNT=IC
+
+ICLDATM = 1
+INFLAG = 2
+ICEFLAG = 3
+I_LIQFLAG= 1
+ITMOL = 7
+I_NSTR = 2
+
+DO JSW=1,KCOLS
+ DO JK=1,KLEV
+ DO JL = KIDIA, KFDIA
+ ZFRCL(JL,JSW,JK) = PFRCL(JL,JSW,JK)
+ ZTAUC(JL,JK,JSW) = PTAUC(JL,JSW,JK)
+ ZASYC(JL,JK,JSW) = PASYC(JL,JSW,JK)
+ ZOMGC(JL,JK,JSW) = POMGC(JL,JSW,JK)
+ ENDDO
+ ENDDO
+ENDDO
+
+ZRMU0(KIDIA:KFDIA)=PRMU0(KIDIA:KFDIA)
+PFUVF(KIDIA:KFDIA)=0._JPRB
+PFUVC(KIDIA:KFDIA)=0._JPRB
+PPARF(KIDIA:KFDIA)=0._JPRB
+PPARCF(KIDIA:KFDIA)=0._JPRB
+
+!- coefficients related to the cloud optical properties (original RRTM_SW)
+
+!- coefficients for the temperature and pressure dependence of the
+! molecular absorption coefficients
+
+DO J1=1,35
+ DO J2=1,KLEV
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ ZWKL(JL,J1,J2)=0.0_JPRB
+ ENDDO
+ ENDDO
+ENDDO
+
+DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ ZPZ(JL,0) = paph(JL,klev+1)*0.01_JPRB
+ENDDO
+
+!ZCLEAR=1.0_JPRB
+!ZCLOUD=0.0_JPRB
+!ZTOTCC=0.0_JPRB
+
+DO JK = 1, KLEV
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ ZPAVEL(JL,JK) = pap(JL,KLEV-JK+1) *0.01_JPRB
+ ZTAVEL(JL,JK) = pt (JL,KLEV-JK+1)
+ ZPZ(JL,JK) = paph(JL,KLEV-JK+1) *0.01_JPRB
+ ZWKL(JL,1,JK) = pq(JL,KLEV-JK+1) *ZAMD*ZRAMW
+ ZWKL(JL,2,JK) = PCO2(JL,KLEV-JK+1)*ZAMD*ZRAMCO2
+ ZWKL(JL,3,JK) = pozn(JL,KLEV-JK+1)*ZAMD*ZRAMO
+ ZWKL(JL,4,JK) = PN2O(JL,KLEV-JK+1)*ZAMD*ZRAMN2O
+ ZWKL(JL,6,JK) = PCH4(JL,KLEV-JK+1)*ZAMD*ZRAMCH4
+!O2 volume mixing ratio
+ ZWKL(JL,7,JK) = 0.20944_JPRB
+ ZAMM(JL) = (1-ZWKL(JL,1,JK))*ZAMD + ZWKL(JL,1,JK)*ZAMW
+ ZCOLDRY(JL,JK) = (ZPZ(JL,JK-1)-ZPZ(JL,JK))*1.E3_JPRB*ZAVGDRO/(ZGRAVIT*ZAMM(JL)*(1+ZWKL(JL,1,JK)))
+ ENDDO
+ENDDO
+
+DO IMOL=1,ITMOL
+ DO JK=1,KLEV
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ ZWKL(JL,IMOL,JK)=ZCOLDRY(JL,JK)* ZWKL(JL,IMOL,JK)
+ ENDDO
+ ENDDO
+ENDDO
+
+CALL SRTM_SETCOEF &
+ & ( KIDIA , KFDIA , KLEV,&
+ & ZPAVEL , ZTAVEL,&
+ & ZCOLDRY , ZWKL,&
+ & ILAYTROP,&
+ & ZCOLCH4 , ZCOLCO2 , ZCOLH2O , ZCOLMOL , ZCOLO2 , ZCOLO3,&
+ & ZFORFAC , ZFORFRAC , INDFOR , ZSELFFAC, ZSELFFRAC, INDSELF, &
+ & ZFAC00 , ZFAC01 , ZFAC10 , ZFAC11,&
+ & JP , JT , JT1 , ZRMU0 &
+ & )
+
+!- call the radiation transfer routine
+
+DO JSW=1,KSW
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ ZALBD(JL,JSW)=PALBD(JL,JSW)
+ ZALBP(JL,JSW)=PALBP(JL,JSW)
+ ENDDO
+ENDDO
+
+!- mixing of aerosols
+
+IF (NAER == 0) THEN
+ DO JSW=1,KSW
+ DO JK=1,KLEV
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ ZTAUA(JL,JK,JSW)= 0.0_JPRB
+ ZASYA(JL,JK,JSW)= 0.0_JPRB
+ ZOMGA(JL,JK,JSW)= 1.0_JPRB
+ ENDDO
+ ENDDO
+ ENDDO
+ELSE
+
+!- If prognostic aerosols with proper RRTM optical properties, fill the RRTM aerosol arrays
+
+ IF (LAERRRTM) THEN
+ IF (LAERCSTR .OR. (LAERVOL .AND. NACTAERO == 15)) THEN
+ DO JSW=1,KSW
+ DO JK=1,KLEV
+ IK=KLEV-JK+1
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ ZTAUA(JL,JK,JSW)=PAERTAUS(JL,IK,JSW)
+ ZASYA(JL,JK,JSW)=PAERASYS(JL,IK,JSW)
+ ZOMGA(JL,JK,JSW)=PAEROMGS(JL,IK,JSW)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ ELSEIF (.NOT.LAERCSTR) THEN
+ DO JSW=1,KSW
+ DO JK=1,KLEV
+ IK=KLEV-JK+1
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ ZTAUA(JL,JK,JSW)=PAERTAUS(JL,IK,JSW)+RSRTAUA(JSW,6)*PAER(JL,6,IK)
+ ZASYA(JL,JK,JSW)=PAERASYS(JL,IK,JSW)+RSRTAUA(JSW,6)*PAER(JL,6,IK)*RSRPIZA(JSW,6)
+ ZOMGA(JL,JK,JSW)=PAEROMGS(JL,IK,JSW)+RSRTAUA(JSW,6)*PAER(JL,6,IK)*RSRPIZA(JSW,6)*RSRASYA(JSW,6)
+ IF (ZOMGA(JL,JK,JSW) /= 0.0_JPRB) THEN
+ ZASYA(JL,JK,JSW)=ZASYA(JL,JK,JSW)/ZOMGA(JL,JK,JSW)
+ ENDIF
+ IF (ZTAUA(JL,JK,JSW) /= 0.0_JPRB) THEN
+ ZOMGA(JL,JK,JSW)=ZOMGA(JL,JK,JSW)/ZTAUA(JL,JK,JSW)
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+
+ ELSE
+
+!- Otherwise, fill RRTM aerosol arrays with operational ECMWF aerosols,
+! do the mixing and distribute over the 14 spectral intervals
+
+ DO JSW=1,KSW
+ DO JK=1,KLEV
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ IK=KLEV+1-JK
+ ZTAUA(JL,JK,JSW)=0.0_JPRB
+ ZASYA(JL,JK,JSW)=0.0_JPRB
+ ZOMGA(JL,JK,JSW)=0.0_JPRB
+!CDIR UNROLL=6
+ DO JAE=1,6
+ ZTAUA(JL,JK,JSW)=ZTAUA(JL,JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK)
+ ZOMGA(JL,JK,JSW)=ZOMGA(JL,JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK) &
+ & *RSRPIZA(JSW,JAE)
+ ZASYA(JL,JK,JSW)=ZASYA(JL,JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK) &
+ & *RSRPIZA(JSW,JAE)*RSRASYA(JSW,JAE)
+ ENDDO
+ IF (ZOMGA(JL,JK,JSW) /= 0.0_JPRB) THEN
+ ZASYA(JL,JK,JSW)=ZASYA(JL,JK,JSW)/ZOMGA(JL,JK,JSW)
+ ENDIF
+ IF (ZTAUA(JL,JK,JSW) /= 0.0_JPRB) THEN
+ ZOMGA(JL,JK,JSW)=ZOMGA(JL,JK,JSW)/ZTAUA(JL,JK,JSW)
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+ENDIF
+
+DO JK=1,KLEV+1
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ ZBBCU(JL,JK)=0.0_JPRB
+ ZBBCD(JL,JK)=0.0_JPRB
+ ZBBFU(JL,JK)=0.0_JPRB
+ ZBBFD(JL,JK)=0.0_JPRB
+ ZBBFDIR(JL,JK)=0.0_JPRB
+ ZBBCDIR(JL,JK)=0.0_JPRB
+ ENDDO
+ENDDO
+
+DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ ZFUVF(JL)=0.0_JPRB
+ ZFUVC(JL)=0.0_JPRB
+ ZPARF(JL)=0.0_JPRB
+ ZPARCF(JL)=0.0_JPRB
+ ZSUDU(JL)=0.0_JPRB
+ENDDO
+
+CALL SRTM_SPCVRT_MCICA &
+ &( KIDIA , KFDIA , KLEV , KSW , KCOLS , ZONEMINUS,&
+ & ZALBD , ZALBP,&
+ & ZFRCL , ZTAUC , ZASYC , ZOMGC ,&
+ & ZTAUA , ZASYA , ZOMGA , ZRMU0,&
+ & ILAYTROP,&
+ & ZCOLCH4 , ZCOLCO2 , ZCOLH2O, ZCOLMOL , ZCOLO2 , ZCOLO3,&
+ & ZFORFAC , ZFORFRAC , INDFOR , ZSELFFAC, ZSELFFRAC, INDSELF,&
+ & ZFAC00 , ZFAC01 , ZFAC10 , ZFAC11 ,&
+ & JP , JT , JT1 ,&
+ & ZBBFD , ZBBFU , ZBBCD , ZBBCU , ZFUVF , ZFUVC, ZPARF, ZPARCF, ZSUDU,&
+ & ZBBFDIR , ZBBCDIR , ZSwDiffuseBand, ZSwDirectBand)
+
+DO JK=1,KLEV+1
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ PFSUC(JL,1,JK)=ZADJI0 * ZBBCU(JL,JK)
+ PFSUC(JL,2,JK)=ZADJI0 * ZBBCD(JL,JK)
+ PFSUX(JL,1,JK)=ZADJI0 * ZBBFU(JL,JK)
+ PFSUX(JL,2,JK)=ZADJI0 * ZBBFD(JL,JK)
+ PFDIR(JL,JK) =ZADJI0 * ZBBFDIR(JL,JK)
+ PCDIR(JL,JK) =ZADJI0 * ZBBCDIR(JL,JK)
+ PFDIF(JL,JK) =PFSUX(JL,2,JK)-PFDIR(JL,JK)
+ PCDIF(JL,JK) =PFSUC(JL,2,JK)-PCDIR(JL,JK)
+ ENDDO
+ENDDO
+
+IF (LApproxSwUpdate) THEN
+ DO JB=1,NSW
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ PSwDiffuseBand(JL,JB) = ZADJI0 * ZSwDiffuseBand(JL,JB)
+ PSwDirectBand (JL,JB) = ZADJI0 * ZSwDirectBand (JL,JB)
+ ENDDO
+ ENDDO
+ENDIF
+
+DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ PFUVF(JL) =ZADJI0 * ZFUVF(JL)
+ PFUVC(JL) =ZADJI0 * ZFUVC(JL)
+ PPARF(JL) =ZADJI0 * ZPARF(JL)
+ PPARCF(JL)=ZADJI0 * ZPARCF(JL)
+ PSUDU(JL) =ZADJI0 * ZSUDU(JL)
+ENDDO
+
+DO JK=1,KLEV+1
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ IF (PRMU0(JL) <= 0.0_JPRB) THEN
+ PFSUC(JL,1,JK)=0.0_JPRB
+ PFSUC(JL,2,JK)=0.0_JPRB
+ PFSUX(JL,1,JK)=0.0_JPRB
+ PFSUX(JL,2,JK)=0.0_JPRB
+ PFDIR(JL,JK) =0.0_JPRB
+ PCDIR(JL,JK) =0.0_JPRB
+ ENDIF
+ ENDDO
+ENDDO
+DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ IF (PRMU0(JL) <= 0.0_JPRB) THEN
+ PFUVF(JL) =0.0_JPRB
+ PFUVC(JL) =0.0_JPRB
+ PPARF(JL) =0.0_JPRB
+ PPARCF(JL)=0.0_JPRB
+ PSUDU(JL)=0.0_JPRB
+ ENDIF
+ENDDO
+
+!-----------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP_MCICA',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE SRTM_SRTM_224GP_MCICA
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/radsurf/radsurf_3d_vegetation.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/radsurf/radsurf_3d_vegetation.F90
new file mode 100644
index 0000000000000000000000000000000000000000..1b7f1e0f736475b2ea47ab10d093ce1cecb7ea77
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/radsurf/radsurf_3d_vegetation.F90
@@ -0,0 +1,74 @@
+! radsurf_3d_vegetation.f90 - Compute radiative transfer in 3D vegetation canopy
+!
+! (C) Copyright 2018- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author: Robin Hogan
+! Email: r.j.hogan@ecmwf.int
+!
+
+module radsurf_3d_vegetation
+
+contains
+ subroutine calc_boundary_conditions_sw(config, n_albedo_bands, tile_fraction, &
+ & canopy_depth, vegetation_optical_depth, vegetation_albedo, &
+ & vegetation_fraction, vegetation_normalized_perimeter, &
+ & ground_albedo_diffuse, ground_albedo_direct, &
+ & ref_dif, tra_dif, ref_dir, tra_dir_dif, tra_dir_dir, &
+ & albedo_diffuse_reg, albedo_direct_reg, &
+ & albedo_diffuse_out, albedo_direct_out, &
+ & ext_air, ssa_air, g_air)
+
+ use parkind1, only : jprb
+ use radiation_config, only : config_type
+
+ implicit none
+
+ ! Number of regions
+ integer, parameter :: nreg = 2
+
+ type(config_type), intent(in) :: config
+
+ integer, intent(in) :: n_albedo_bands
+
+ ! Fraction of gridbox occupied by this tile
+ real(kind=jprb), intent(in) :: tile_fraction
+
+ ! Depth of vegetation canopy in metres
+ real(kind=jprb), intent(in) :: canopy_depth
+
+ ! Optical properties of vegetation
+ real(kind=jprb), intent(in) :: vegetation_optical_depth
+ real(kind=jprb), intent(in) :: vegetation_albedo(:) ! Spectral interval
+
+ ! Optical properties of the ground (function of spectral interval)
+ real(kind=jprb), intent(in) :: ground_albedo_diffuse(:)
+ real(kind=jprb), intent(in) :: ground_albedo_direct(:)
+
+ ! Geometric properties
+ real(kind=jprb), intent(in) :: vegetation_fraction
+ real(kind=jprb), intent(in) :: vegetation_normalized_perimeter ! m-1
+
+
+ ! Intermediate properties to store
+ real(kind=jprb), intent(in), dimension(n_albedo_bands,nreg,nreg) :: ref_dif, ref_dir, tra_dif, tra_dir_dif, tra_dir_dir
+
+ ! Outputs
+ real(kind=jprb), intent(inout) :: albedo_diffuse_reg, albedo_direct_reg, albedo_diffuse_out, albedo_direct_out
+
+ real(kind=jprb), intent(inout) :: ext_air, ssa_air, g_air
+
+ end subroutine calc_boundary_conditions_sw
+
+ subroutine calc_boundary_conditions_lw
+
+ end subroutine calc_boundary_conditions_lw
+
+
+end module radsurf_3d_vegetation
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/radsurf/radsurf_homogeneous_vegetation.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/radsurf/radsurf_homogeneous_vegetation.F90
new file mode 100644
index 0000000000000000000000000000000000000000..bad0a7da95e87256ff2c634651ef1a0571d4db18
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/radsurf/radsurf_homogeneous_vegetation.F90
@@ -0,0 +1,66 @@
+! radsurf_homogeneous_vegetation.f90 - Compute radiative transfer in homogeneous vegetation canopy
+!
+! (C) Copyright 2018- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author: Robin Hogan
+! Email: r.j.hogan@ecmwf.int
+!
+
+module radsurf_homogeneous_vegetation
+
+contains
+ subroutine calc_boundary_conditions_sw(config, tile_fraction, &
+ & canopy_depth, vegetation_optical_depth, vegetation_albedo, &
+ & ground_albedo_diffuse, ground_albedo_direct, &
+ & ref_dif, tra_dif, ref_dir, tra_dir_dif, tra_dir_dir, &
+ & albedo_diffuse_reg, albedo_direct_reg, &
+ & albedo_diffuse_out, albedo_direct_out, &
+ & ext_air, ssa_air, g_air)
+
+ use parkind1, only :jprb
+ use radiation_config, only : config_type
+
+ implicit none
+
+ ! Number of regions
+ integer, parameter :: nreg = 2
+
+ type(config_type), intent(in) :: config
+
+ ! Fraction of gridbox occupied by this tile
+ real(kind=jprb), intent(in) :: tile_fraction
+
+ ! Depth of vegetation canopy in metres
+ real(kind=jprb), intent(in) :: canopy_depth
+
+ ! Optical properties of vegetation
+ real(kind=jprb), intent(in) :: vegetation_optical_depth
+ real(kind=jprb), intent(in) :: vegetation_albedo(:) ! Spectral interval
+
+ ! Optical properties of the ground (function of spectral interval)
+ real(kind=jprb), intent(in) :: ground_albedo_diffuse(:)
+ real(kind=jprb), intent(in) :: ground_albedo_direct(:)
+
+ ! Intermediate properties to store
+ real(kind=jprb), intent(in), dimension(nreg,nreg) :: ref_dif, ref_dir, tra_dif, tra_dir_dif, tra_dir_dir
+
+ ! Outputs
+ real(kind=jprb), intent(inout) :: albedo_diffuse_reg, albedo_direct_reg, albedo_diffuse_out, albedo_direct_out
+
+ real(kind=jprb), intent(inout) :: ext_air, ssa_air, g_air
+
+ end subroutine calc_boundary_conditions_sw
+
+ subroutine calc_boundary_conditions_lw
+
+ end subroutine calc_boundary_conditions_lw
+
+
+end module radsurf_homogeneous_vegetation
diff --git a/src/Makefile.MESONH.mk b/src/Makefile.MESONH.mk
index cf8177a06200a41f728dd68f39ffc20330fa1a50..c376a65a0747afb32c466bb1a22baf5bd4412212 100644
--- a/src/Makefile.MESONH.mk
+++ b/src/Makefile.MESONH.mk
@@ -126,11 +126,11 @@ DIR_RAD += LIB/RAD/ECMWF_RAD
INC_RAD = -I$(B)LIB/RAD/ECMWF_RAD
#
ifdef MNH_ECRAD
-DIR_RAD += LIB/RAD/ecrad-1.0.1_mnh
-DIR_RAD += LIB/RAD/ecrad-1.0.1
+DIR_RAD += LIB/RAD/ecrad-$(VERSION_ECRAD)_mnh
+DIR_RAD += LIB/RAD/ecrad-$(VERSION_ECRAD)
CPPFLAGS_RAD = -DMNH_ECRAD
-INC_RAD += -I$(B)LIB/RAD/ecrad-1.0.1/include
-ARCH_XYZ := $(ARCH_XYZ)-ECRAD
+INC_RAD += -I$(B)LIB/RAD/ecrad-$(VERSION_ECRAD)/include -I$(B)LIB/RAD/ecrad-$(VERSION_ECRAD)/drhook/include
+ARCH_XYZ := $(ARCH_XYZ)-ECRAD$(VER_ECRAD)
endif
#
#
diff --git a/src/configure b/src/configure
index fd3e433cb9c4837b0996769c0d68120b0417dfb6..f40aedcc6a9f328811363ddf689fceb1ca5b3606 100755
--- a/src/configure
+++ b/src/configure
@@ -29,9 +29,8 @@ export VERSION_OASIS=${VERSION_OASIS:-"mct_v3"}
export VERSION_TOY=${VERSION_TOY:-"v1-0"}
export VERSION_NCL=${VERSION_NCL:-"ncl-6.4.0"}
-
export VERSION_ECRAD=${VERSION_ECRAD:-"1.0.1"}
-
+export VER_ECRAD=${VERSION_ECRAD//./}
export LEN_HREC=${LEN_HREC:-16}
@@ -500,7 +499,7 @@ fi
#
${LOCAL}/bin/eval_dollar profile_mesonh.ihm > profile_mesonh
chmod +x profile_mesonh
-XYZ=${ARCH}-R${MNH_REAL}I${MNH_INT}-${VERSION_XYZ}${MNH_ECRAD:+-ECRAD}${MNH_FOREFIRE:+-FF}${VER_USER:+-${VER_USER}}-${VER_MPI}-${OPTLEVEL}
+XYZ=${ARCH}-R${MNH_REAL}I${MNH_INT}-${VERSION_XYZ}${MNH_ECRAD:+-ECRAD${VER_ECRAD}}${MNH_FOREFIRE:+-FF}${VER_USER:+-${VER_USER}}-${VER_MPI}-${OPTLEVEL}
cp profile_mesonh profile_mesonh-${XYZ}
#
# Do some post-install stuff