diff --git a/MY_RUN/KTEST/002_3Drelief/003_python/plot_002_3DRelief.py b/MY_RUN/KTEST/002_3Drelief/003_python/plot_002_3DRelief.py
index 079e324052720e530282675cb68dbaad869336eb..6f57fae700bef1f17d9783d15172b05175cf3e73 100644
--- a/MY_RUN/KTEST/002_3Drelief/003_python/plot_002_3DRelief.py
+++ b/MY_RUN/KTEST/002_3Drelief/003_python/plot_002_3DRelief.py
@@ -10,7 +10,6 @@ mpl.use('Agg')
from read_MNHfile import read_netcdf
from Panel_Plot import PanelPlot
from misc_functions import comp_altitude2DVar
-import cartopy.crs as ccrs
import os
os.system('rm -f tempgraph*')
@@ -21,8 +20,7 @@ path=""
LnameFiles = ['REL3D.1.EXP01.002.nc']
-Dvar_input = {
-'f1':['ZS', 'UT', 'WT','ni_u','nj_u','level','ZTOP', 'ni','nj','level_w','time']}
+Dvar_input = {'f1':['ZS', 'UT', 'WT','ni_u','nj_u','level','ZTOP', 'ni','nj','level_w','time']}
# Read the variables in the files
Dvar = {}
@@ -53,7 +51,6 @@ Lstep = [0.25, 0.1]
Lstepticks = Lstep
Lcolormap = ['gist_rainbow_r']*len(Lplot)
Ltime = [Dvar['f1']['time']]*len(Lplot)
-Lprojection = [ccrs.PlateCarree()]*len(Lplot)
fig1 = Panel1.psectionV(Lxx=LaxeX, Lzz=LaxeZ, Lvar=Lplot, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lminval=Lminval, Lmaxval=Lmaxval,
Lstep=Lstep, Lstepticks=Lstepticks, Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel,
orog=orog, Lylim=Lylim, colorbar=True, Ltime=Ltime)
diff --git a/MY_RUN/KTEST/004_Reunion/003_mesonh/run_mesonh_xyz b/MY_RUN/KTEST/004_Reunion/003_mesonh/run_mesonh_xyz
index ce9bd3dc383068a96cab69ce6d6391bc1cd8926e..a7a52d5318cfbcbda9146263dc1c2b07d2ba295c 100755
--- a/MY_RUN/KTEST/004_Reunion/003_mesonh/run_mesonh_xyz
+++ b/MY_RUN/KTEST/004_Reunion/003_mesonh/run_mesonh_xyz
@@ -10,8 +10,8 @@ ln -fs ../002_prep_ideal_case/REUNION_IDEA*.{des,lfi,nc} .
ln -sf ../001_prep_pgd/REUNION_PGD_1km5.{des,lfi,nc} .
if [ "x${MNH_ECRAD}" != "x" ] ; then
-ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-1.0.1/data/RAD* .
-ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-1.0.1/data/*.nc .
+ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-${VERSION_ECRAD}/data/RAD* .
+ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-${VERSION_ECRAD}/data/*.nc .
sed -e's/ECMW/ECRA/g' EXSEG1.nam.src > EXSEG1.nam
else
cp EXSEG1.nam.src EXSEG1.nam
diff --git a/MY_RUN/KTEST/004_Reunion/004_diag/run_diag_xyz b/MY_RUN/KTEST/004_Reunion/004_diag/run_diag_xyz
index 4f3502cb1f6807a798046f0c61824606e20372f6..a14520746231626dfb6e8e3a7a9ebca91b0c9e65 100755
--- a/MY_RUN/KTEST/004_Reunion/004_diag/run_diag_xyz
+++ b/MY_RUN/KTEST/004_Reunion/004_diag/run_diag_xyz
@@ -11,5 +11,10 @@ rm -f KWRAI* OUT*
ln -sf ../003_mesonh/REUNI.1.00A20.004.* .
ln -sf ../001_prep_pgd/REUNION_PGD_1km5.* .
+if [ "x${MNH_ECRAD}" != "x" ] ; then
+ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-${VERSION_ECRAD}/data/RAD* .
+ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-${VERSION_ECRAD}/data/*.nc .
+fi
+
time ${MPIRUN} DIAG${XYZ}
diff --git a/MY_RUN/KTEST/004_Reunion/007_python/plot_004_Reunion.py b/MY_RUN/KTEST/004_Reunion/007_python/plot_004_Reunion.py
index 2a607c828d7eff707b7bb5d75f8a68be83f5ff0a..ea59e343330e5dfc43a383bb976da141751a6705 100644
--- a/MY_RUN/KTEST/004_Reunion/007_python/plot_004_Reunion.py
+++ b/MY_RUN/KTEST/004_Reunion/007_python/plot_004_Reunion.py
@@ -6,15 +6,13 @@ Creation : 07/01/2021
Last modifications
"""
-
import matplotlib as mpl
mpl.use('Agg')
from read_MNHfile import read_netcdf
from Panel_Plot import PanelPlot
-from misc_functions import comp_altitude2DVar, windvec_verti_proj, mean_operator
+from misc_functions import comp_altitude2DVar, mean_operator
import cartopy.crs as ccrs
import numpy as np
-import math
import copy
import os
@@ -22,8 +20,6 @@ os.system('rm -f tempgraph*')
#
# User's parameter / Namelist
#
-path=""
-
LnameFiles = ['REUNI.1.00A20.004dia.nc', 'REUNI.1.00A20.004.nc']
Dvar_input = {
@@ -32,7 +28,7 @@ Dvar_input = {
# Read the variables in the files
Dvar = {}
-Dvar = read_netcdf(LnameFiles, Dvar_input, path=path, removeHALO=True)
+Dvar = read_netcdf(LnameFiles, Dvar_input, path="", removeHALO=True)
################################################################
######### PANEL 1 # Horizontal cross-section
@@ -40,7 +36,7 @@ Dvar = read_netcdf(LnameFiles, Dvar_input, path=path, removeHALO=True)
Panel1 = PanelPlot(2,2, [20,20],'004_Reunion horizontal sections')
Dvar['f1']['WIND'] = np.sqrt(Dvar['f1']['UT']**2 + Dvar['f1']['VT']**2)
-Lplot = [ Dvar['f1']['ZS'][:,:], Dvar['f1']['WIND'][0,:,:], Dvar['f1']['ALT_THETA'][0,:,:], Dvar['f1']['ALT_PRESSURE'][0,:,:]]
+Lplot = [ Dvar['f1']['ZS'][:,:], Dvar['f1']['WIND'][0,:,:], Dvar['f1']['ALT_THETA'][:,:], Dvar['f1']['ALT_PRESSURE'][:,:]]
LaxeX = [Dvar['f1']['longitude']]*len(Lplot)
LaxeY = [Dvar['f1']['latitude']]*len(Lplot)
@@ -79,8 +75,6 @@ Lscale = [400]*len(Lplot1)
fig2 = Panel1.pvector(Lxx=LaxeX, Lyy=LaxeY, Llevel=Llvl, Lvar1=Lplot1, Lvar2=Lplot2, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lwidth=Lwidth, Larrowstep=Larrowstep,
Llegendval=Llegendval, Lcbarlabel=Lcbarlabel, Lproj=Lprojection, Lid_overlap=[2,6], ax=fig1.axes, Lscale=Lscale)
-
-
################################################################
######### PANEL 2 # Vertical cross-section
###############################################################
@@ -141,4 +135,4 @@ Lcolor=['lightgray']
fig4 = Panel2.pvector(Lxx=LaxeX, Lyy=LaxeZ, Lvar1=Lplot1, Lvar2=Lplot2, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lwidth=Lwidth, Larrowstep=Larrowstep,
Llegendval=Llegendval, Lcbarlabel=Lcbarlabel, Lid_overlap=[6], ax=fig3.axes, Lscale=Lscale, Lylim=Lylim, Lxlim=Lxlim, Lcolor=Lcolor)
-Panel2.save_graph(2,fig4)
+Panel2.save_graph(2,fig4)
\ No newline at end of file
diff --git a/MY_RUN/KTEST/005_ARM/003_python/plot_005_ARM.py b/MY_RUN/KTEST/005_ARM/003_python/plot_005_ARM.py
index 7427083f029f7a175f234f47b3bed95fa23a28a2..46764697097f879f0c99455ba9a268a071b76511 100644
--- a/MY_RUN/KTEST/005_ARM/003_python/plot_005_ARM.py
+++ b/MY_RUN/KTEST/005_ARM/003_python/plot_005_ARM.py
@@ -17,28 +17,29 @@ os.system('rm -f tempgraph*')
# User's parameter / Namelist
#
path=""
-
LnameFiles = ['ARM__.1.CEN4T.000.nc' ]
+LG_LES = '/LES_budgets/Cartesian/Not_time_averaged/Not_normalized/cart/'
Dvar_input = {
-'f1':['MEAN_TH','MEAN_U','MEAN_V','MEAN_RC','MEAN_RR',
- 'SBG_TKE','SBG_WTHL','SBG_WRT',
- 'THLUP_MF','RTUP_MF','RVUP_MF','RCUP_MF','RIUP_MF','WUP_MF',
- 'MAFLX_MF','DETR_MF','ENTR_MF','FRCUP_MF','THVUP_MF','WTHL_MF',
- 'WRT_MF','WTHV_MF','WU_MF','WV_MF',
+'f1':[(LG_LES,'MEAN_TH') , (LG_LES,'MEAN_U') , (LG_LES,'MEAN_V') , (LG_LES,'MEAN_RC'), (LG_LES,'MEAN_RR'),
+ (LG_LES,'SBG_TKE') , (LG_LES,'SBG_WTHL'), (LG_LES,'SBG_WRT'),
+ (LG_LES,'THLUP_MF'), (LG_LES,'RTUP_MF') , (LG_LES,'RVUP_MF'), (LG_LES,'RCUP_MF'), (LG_LES,'RIUP_MF'), (LG_LES,'WUP_MF'),
+ (LG_LES,'MAFLX_MF'), (LG_LES,'DETR_MF') , (LG_LES,'ENTR_MF'), (LG_LES,'FRCUP_MF'), (LG_LES,'THVUP_MF'), (LG_LES,'WTHL_MF'),
+ (LG_LES,'WRT_MF') , (LG_LES,'WTHV_MF') , (LG_LES,'WU_MF') , (LG_LES,'WV_MF'),
'level_les','time_les']
}
# Read the variables in the files
Dvar = {}
-Dvar = read_netcdf(LnameFiles, Dvar_input, path=path, removeHALO=False)
+Dvar = read_netcdf(LnameFiles, Dvar_input, path=path, removeHALO=False, get_data_only=True)
################################################################
######### PANEL 1
###############################################################
Panel1 = PanelPlot(2,3, [25,14],'', titlepad=25, minmaxpad=1.04, timepad=-0.07, colorbarpad=0.03, labelcolorbarpad = 13, colorbaraspect=40)
-Lplot = [Dvar['f1']['MEAN_TH'],Dvar['f1']['MEAN_U'], Dvar['f1']['MEAN_V'], Dvar['f1']['MEAN_RC'], Dvar['f1']['MEAN_RR'],Dvar['f1']['SBG_TKE'],]
+Lplot = [Dvar['f1'][(LG_LES,'MEAN_TH')],Dvar['f1'][(LG_LES,'MEAN_U')], Dvar['f1'][(LG_LES,'MEAN_V')],
+ Dvar['f1'][(LG_LES,'MEAN_RC')], Dvar['f1'][(LG_LES,'MEAN_RR')],Dvar['f1'][(LG_LES,'SBG_TKE')]]
LaxeX = [Dvar['f1']['time_les']/3600.]*len(Lplot)
LaxeZ = [Dvar['f1']['level_les']]*len(Lplot)
Ltitle = ['Mean potential temperature TH', 'Mean U', 'Mean V', 'Mean cloud mixing ratio RC', 'Mean precipitation RR', 'Subgrid TKE']
@@ -57,7 +58,6 @@ LaddWhite = [False, False, True, True,True, True]
fig1 = Panel1.psectionV(Lxx=LaxeX, Lzz=LaxeZ, Lvar=Lplot, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lminval=Lminval, Lmaxval=Lmaxval,
Lstep=Lstep, Lstepticks=Lstepticks, Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel, Lfacconv=Lfacconv,
LaddWhite_cm=LaddWhite, Lylim=Lylim)
-
Panel1.save_graph(1,fig1)
################################################################
@@ -65,7 +65,8 @@ Panel1.save_graph(1,fig1)
###############################################################
Panel2 = PanelPlot(2,3, [25,14],'', titlepad=25, minmaxpad=1.04, timepad=-0.07, colorbarpad=0.03, labelcolorbarpad = 13, colorbaraspect=40)
-Lplot = [Dvar['f1']['SBG_WTHL'], Dvar['f1']['SBG_WRT'], Dvar['f1']['THLUP_MF'], Dvar['f1']['RTUP_MF'], Dvar['f1']['RVUP_MF'], Dvar['f1']['RCUP_MF']]
+Lplot = [Dvar['f1'][(LG_LES,'SBG_WTHL')], Dvar['f1'][(LG_LES,'SBG_WRT')], Dvar['f1'][(LG_LES,'THLUP_MF')],
+ Dvar['f1'][(LG_LES,'RTUP_MF')], Dvar['f1'][(LG_LES,'RVUP_MF')], Dvar['f1'][(LG_LES,'RCUP_MF')]]
LaxeX = [Dvar['f1']['time_les']/3600.]*len(Lplot)
LaxeZ = [Dvar['f1']['level_les']]*len(Lplot)
Ltitle = ['Subgrid vertical liquid potential temp. flux', 'Subgrid vertical RT flux',
@@ -85,7 +86,6 @@ LaddWhite = [False, False, False, False, False, False]
fig2 = Panel2.psectionV(Lxx=LaxeX, Lzz=LaxeZ, Lvar=Lplot, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lminval=Lminval, Lmaxval=Lmaxval,
Lstep=Lstep, Lstepticks=Lstepticks, Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel, Lfacconv=Lfacconv,
LaddWhite_cm=LaddWhite, Lylim=Lylim)
-
Panel2.save_graph(2,fig2)
################################################################
@@ -93,7 +93,8 @@ Panel2.save_graph(2,fig2)
###############################################################
Panel3 = PanelPlot(2,3, [25,14],'', titlepad=25, minmaxpad=1.04, timepad=-0.07, colorbarpad=0.03, labelcolorbarpad = 13, colorbaraspect=40)
-Lplot = [Dvar['f1']['RIUP_MF'], Dvar['f1']['WUP_MF'], Dvar['f1']['MAFLX_MF'], Dvar['f1']['DETR_MF'], Dvar['f1']['ENTR_MF'], Dvar['f1']['FRCUP_MF']]
+Lplot = [Dvar['f1'][(LG_LES,'RIUP_MF')], Dvar['f1'][(LG_LES,'WUP_MF')], Dvar['f1'][(LG_LES,'MAFLX_MF')],
+ Dvar['f1'][(LG_LES,'DETR_MF')], Dvar['f1'][(LG_LES,'ENTR_MF')], Dvar['f1'][(LG_LES,'FRCUP_MF')]]
LaxeX = [Dvar['f1']['time_les']/3600.]*len(Lplot)
LaxeZ = [Dvar['f1']['level_les']]*len(Lplot)
Ltitle = ['Updraft ice mixing ratio', 'Updraft vertical velocity',
@@ -113,16 +114,15 @@ LaddWhite = [True]*len(Lplot)
fig3 = Panel3.psectionV(Lxx=LaxeX, Lzz=LaxeZ, Lvar=Lplot, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lminval=Lminval, Lmaxval=Lmaxval,
Lstep=Lstep, Lstepticks=Lstepticks, Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel, Lfacconv=Lfacconv,
LaddWhite_cm=LaddWhite, Lylim=Lylim)
-
Panel3.save_graph(3,fig3)
-
################################################################
######### PANEL 4
###############################################################
Panel4 = PanelPlot(2,3, [25,14],'', titlepad=25, minmaxpad=1.04, timepad=-0.07, colorbarpad=0.03, labelcolorbarpad = 13, colorbaraspect=40)
-Lplot = [Dvar['f1']['THVUP_MF'], Dvar['f1']['WTHL_MF'], Dvar['f1']['WRT_MF'], Dvar['f1']['WTHV_MF'], Dvar['f1']['WU_MF'], Dvar['f1']['WV_MF']]
+Lplot = [Dvar['f1'][(LG_LES,'THVUP_MF')], Dvar['f1'][(LG_LES,'WTHL_MF')], Dvar['f1'][(LG_LES,'WRT_MF')],
+ Dvar['f1'][(LG_LES,'WTHV_MF')], Dvar['f1'][(LG_LES,'WU_MF')], Dvar['f1'][(LG_LES,'WV_MF')]]
LaxeX = [Dvar['f1']['time_les']/3600.]*len(Lplot)
LaxeZ = [Dvar['f1']['level_les']]*len(Lplot)
Ltitle = ['Updraft virtual potential temperature', 'Subgrid WTHL flux from Mass-Flux scheme',
@@ -142,5 +142,4 @@ LaddWhite = [False, False, True, False, False, False]
fig4 = Panel4.psectionV(Lxx=LaxeX, Lzz=LaxeZ, Lvar=Lplot, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lminval=Lminval, Lmaxval=Lmaxval,
Lstep=Lstep, Lstepticks=Lstepticks, Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel, Lfacconv=Lfacconv,
LaddWhite_cm=LaddWhite, Lylim=Lylim)
-
-Panel4.save_graph(4,fig4)
+Panel4.save_graph(4,fig4)
\ No newline at end of file
diff --git a/MY_RUN/KTEST/005_ARM/004_ncl/clean_ncl b/MY_RUN/KTEST/005_ARM/004_ncl/clean_ncl
new file mode 100755
index 0000000000000000000000000000000000000000..12eeedc8e2098dd3b9af358058400b0dc719d700
--- /dev/null
+++ b/MY_RUN/KTEST/005_ARM/004_ncl/clean_ncl
@@ -0,0 +1,2 @@
+#!/bin/bash
+rm -f ARM__.1.CEN4T.000* *.png
diff --git a/MY_RUN/KTEST/005_ARM/004_ncl/plot_arm.ncl b/MY_RUN/KTEST/005_ARM/004_ncl/plot_arm.ncl
new file mode 100644
index 0000000000000000000000000000000000000000..77b79867f4133f56b2c3c5cc8c1743a285598eaa
--- /dev/null
+++ b/MY_RUN/KTEST/005_ARM/004_ncl/plot_arm.ncl
@@ -0,0 +1,512 @@
+;================================================;
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/contributed.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/wrf/WRFUserARW.ncl"
+; ================================================;
+;================================================;
+begin
+;=================================================;
+; open file and read in data
+;=================================================;
+ fichier1 = addfile("ARM__.1.CEN4T.000.nc", "r")
+;==================================================;
+; Open the workstation
+;==================================================;
+ type = "png"
+ wks = gsn_open_wks(type,"visu_ARM")
+;=================================================;
+; lecture des différents champs
+;=================================================;
+kmax=100
+zhat = fichier1->ZHAT(:) ; ZHAT
+; Unstagger zhat (from grid 4 to 1)
+ nzh=new(kmax,double)
+ do k=0,kmax-2
+ nzh(k)=(zhat(k)+zhat(k+1))/2.
+ end do
+ nzh(kmax-1)=2*zhat(kmax-1)-zhat(kmax-2)
+TIME=new((/180/),double)
+TIME(0)=300
+do j=1,179
+ TIME(j)=TIME(j-1)+300
+end do
+
+group_LES_budgets = fichier1=>LES_budgets/Cartesian/Not_time_averaged/Not_normalized/cart
+
+vname="SBG_TKE"
+SBGTKE = group_LES_budgets->$vname$(:,:)
+SBGTKE@long_name="SBG_TKE"
+SBGTKE!1="nzh"
+SBGTKE!0="TIME"
+SBG_TKE=transpose(SBGTKE)
+
+vname="MEAN_TH"
+MEANTH = group_LES_budgets->$vname$(:,:) ; MEAN_TH
+MEANTH@long_name="MEAN_TH"
+MEANTH@units="K"
+MEANTH!1="nzh"
+MEANTH!0="TIME"
+MEAN_TH=transpose(MEANTH)
+
+vname="MEAN_U"
+MEANU = group_LES_budgets->$vname$(:,:)
+MEANU!1="nzh"
+MEANU!0="TIME"
+MEAN_U=transpose(MEANU)
+MEAN_U@long_name="MEAN_U"
+
+vname="MEAN_V"
+MEANV = group_LES_budgets->$vname$(:,:)
+MEANV!1="nzh"
+MEANV!0="TIME"
+MEAN_V=transpose(MEANV)
+MEAN_V@long_name="MEAN_V"
+
+vname="MEAN_RC"
+MEANRC = group_LES_budgets->$vname$(:,:)
+MEANRC!1="nzh"
+MEANRC!0="TIME"
+MEAN_RC=transpose(MEANRC)
+MEAN_RC@long_name="MEAN_RC"
+
+vname="MEAN_RR"
+MEANRR = group_LES_budgets->$vname$(:,:)
+MEANRR!1="nzh"
+MEANRR!0="TIME"
+MEAN_RR=transpose(MEANRR)
+MEAN_RR@long_name="MEAN_RR"
+
+vname="SBG_WTHL"
+SBGWTHL = group_LES_budgets->$vname$(:,:)
+SBGWTHL!1="nzh"
+SBGWTHL!0="TIME"
+SBG_WTHL=transpose(SBGWTHL)
+SBG_WTHL@long_name="SBG_WTHL"
+
+vname="SBG_WRT"
+SBGWRT = group_LES_budgets->$vname$(:,:)
+SBGWRT!1="nzh"
+SBGWRT!0="TIME"
+SBG_WRT=transpose(SBGWRT)
+SBG_WRT@long_name="SBG_WRT"
+
+
+vname="THLUP_MF"
+ THLUPMF= group_LES_budgets->$vname$(:,:)
+THLUPMF!1="nzh"
+THLUPMF!0="TIME"
+THLUP_MF=transpose(THLUPMF)
+THLUP_MF@long_name="THLUP_MF"
+
+vname="RTUP_MF"
+RTUPMF = group_LES_budgets->$vname$(:,:)
+RTUPMF!1="nzh"
+RTUPMF!0="TIME"
+RTUP_MF=transpose(RTUPMF)
+RTUP_MF@long_name="RTUP_MF"
+
+vname="RVUP_MF"
+RVUPMF = group_LES_budgets->$vname$(:,:)
+RVUPMF!1="nzh"
+RVUPMF!0="TIME"
+RVUP_MF=transpose(RVUPMF)
+RVUP_MF@long_name="RVUP_MF"
+
+vname="RCUP_MF"
+RCUPMF = group_LES_budgets->$vname$(:,:)
+RCUPMF!1="nzh"
+RCUPMF!0="TIME"
+RCUP_MF=transpose(RCUPMF)
+RCUP_MF@long_name="RCUP_MF"
+
+vname="RIUP_MF"
+RIUPMF = group_LES_budgets->$vname$(:,:)
+RIUPMF!1="nzh"
+RIUPMF!0="TIME"
+RIUP_MF=transpose(RIUPMF)
+RIUP_MF@long_name="RIUP_MF"
+
+vname="WUP_MF"
+WUPMF = group_LES_budgets->$vname$(:,:)
+WUPMF!1="nzh"
+WUPMF!0="TIME"
+WUP_MF=transpose(WUPMF)
+WUP_MF@long_name="WUP_MF"
+
+vname="MAFLX_MF"
+MAFLXMF = group_LES_budgets->$vname$(:,:)
+MAFLXMF!1="nzh"
+MAFLXMF!0="TIME"
+MAFLX_MF=transpose(MAFLXMF)
+MAFLX_MF@long_name="MAFLX_MF"
+
+vname="DETR_MF"
+DETRMF = group_LES_budgets->$vname$(:,:)
+DETRMF!1="nzh"
+DETRMF!0="TIME"
+DETR_MF=transpose(DETRMF)
+DETR_MF@long_name="DETR_MF"
+
+vname="ENTR_MF"
+ENTRMF = group_LES_budgets->$vname$(:,:)
+ENTRMF!1="nzh"
+ENTRMF!0="TIME"
+ENTR_MF=transpose(ENTRMF)
+ENTR_MF@long_name="ENTR_MF"
+
+vname="FRCUP_MF"
+FRCUPMF = group_LES_budgets->$vname$(:,:)
+FRCUPMF!1="nzh"
+FRCUPMF!0="TIME"
+FRCUP_MF=transpose(FRCUPMF)
+FRCUP_MF@long_name="FRCUP_MF"
+
+vname="THVUP_MF"
+THVUPMF = group_LES_budgets->$vname$(:,:)
+THVUPMF!1="nzh"
+THVUPMF!0="TIME"
+THVUP_MF=transpose(THVUPMF)
+THVUP_MF@long_name="THVUP_MF"
+
+vname="WTHL_MF"
+WTHLMF = group_LES_budgets->$vname$(:,:)
+WTHLMF!1="nzh"
+WTHLMF!0="TIME"
+WTHL_MF=transpose(WTHLMF)
+WTHL_MF@long_name="WTHL_MF"
+
+vname="WRT_MF"
+WRTMF = group_LES_budgets->$vname$(:,:)
+WRTMF!1="nzh"
+WRTMF!0="TIME"
+WRT_MF=transpose(WRTMF)
+WRT_MF@long_name="WRT_MF"
+
+
+vname="WTHV_MF"
+WTHVMF = group_LES_budgets->$vname$(:,:)
+WTHVMF!1="nzh"
+WTHVMF!0="TIME"
+WTHV_MF=transpose(WTHVMF)
+WTHV_MF@long_name="WTHV_MF"
+
+
+vname="WU_MF"
+WUMF = group_LES_budgets->$vname$(:,:)
+WUMF!1="nzh"
+WUMF!0="TIME"
+WU_MF=transpose(WUMF)
+WU_MF@long_name="WU_MF"
+
+
+vname="WV_MF"
+WVMF = group_LES_budgets->$vname$(:,:)
+WVMF!1="nzh"
+WVMF!0="TIME"
+WV_MF=transpose(WVMF)
+WV_MF@long_name="WV_MF"
+
+;=================================================;
+; Altitude des niveaux modèles
+;=================================================;
+; Unstagger zhat (from grid 4 to 1)
+ nzh=new(kmax,double)
+ do k=0,kmax-2
+ nzh(k)=(zhat(k)+zhat(k+1))/2.
+ end do
+ nzh(kmax-1)=2*zhat(kmax-1)-zhat(kmax-2)
+;=================================================;
+; Set some other basic resources
+;=================================================;
+ resmap = True
+ resmap@gsnFrame = False
+ resmap@gsnDraw = False
+ resmap@gsnMaximize = True
+ resmap@gsnPaperOrientation = "portrait"
+ resmap@gsnSpreadColors = True ; use full range of colormap
+ resmap@tiYAxisString =" "
+ resmap@cnFillOn = True ; turn on color fill
+ resmap@cnLinesOn = False ; turn off contour lines
+ ;resmap@tmXBLabelStride = 2 ; to reduce the number of labels on xaxis
+ ;resmap@lbLabelStride = 2. ; to reduce the number of labels on labelbar
+ resmap@sfYArray = nzh(0:76)
+ resmap@sfXArray = TIME
+ resmap@tmXBTickSpacingF = 10800.
+ resmap@tmXBMode = "Explicit"
+ resmap@tmXBValues = (/10800,21600,32400,43200,54000/)
+ resmap@tmXBLabels =(/3,6,9,12,15/)
+resmap@tiXAxisPosition="Left"
+resmap@tiXAxisFontHeightF=0.015
+;=================================================;
+; TRACE
+;=================================================;
+ gsn_define_colormap(wks,"rainbow") ; Choose colormap
+ colors = gsn_retrieve_colormap(wks) ; retrieve color map for editing
+ colors(2,:) = (/ 1, 1, 1 /) ; replace the first color with white color (les deux premières sont background /foreground donc c'est bien la 2 qu'il faut changer)
+ gsn_define_colormap(wks,colors) ; redefine colormap to workstation, color map now includes a gray
+
+
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.25
+opts@cnMinLevelValF=0
+opts@cnMaxLevelValF=2.5
+
+plot = gsn_csm_contour(wks,SBG_TKE(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=1
+opts@cnMinLevelValF=298
+opts@cnMaxLevelValF=316
+
+plot = gsn_csm_contour(wks,MEAN_TH(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.5
+opts@cnMinLevelValF=3
+opts@cnMaxLevelValF=11
+
+plot = gsn_csm_contour(wks,MEAN_U(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.2
+opts@cnMinLevelValF=0.
+opts@cnMaxLevelValF=3.2
+
+plot = gsn_csm_contour(wks,MEAN_V(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.00001
+opts@cnMinLevelValF=0
+opts@cnMaxLevelValF=0.0002
+
+plot = gsn_csm_contour(wks,MEAN_RC(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.000001
+opts@cnMinLevelValF=0
+opts@cnMaxLevelValF=0.00002
+
+plot = gsn_csm_contour(wks,MEAN_RR(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.02
+opts@cnMinLevelValF=-0.3
+opts@cnMaxLevelValF=0.12
+
+plot = gsn_csm_contour(wks,SBG_WTHL(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.00005
+opts@cnMinLevelValF=-0.0001
+opts@cnMaxLevelValF=0.0004
+
+plot = gsn_csm_contour(wks,SBG_WRT(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=1
+opts@cnMinLevelValF=301
+opts@cnMaxLevelValF=318
+
+plot = gsn_csm_contour(wks,THLUP_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.001
+opts@cnMinLevelValF=0.0035
+opts@cnMaxLevelValF=0.017
+plot = gsn_csm_contour(wks,RTUP_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.001
+opts@cnMinLevelValF=0.001
+opts@cnMaxLevelValF=0.017
+
+plot = gsn_csm_contour(wks,RVUP_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.00025
+opts@cnMinLevelValF=0.00025
+opts@cnMaxLevelValF=0.00425
+
+plot = gsn_csm_contour(wks,RCUP_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "AutomaticLevels"
+plot = gsn_csm_contour(wks,RIUP_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.25
+opts@cnMinLevelValF=0.250
+opts@cnMaxLevelValF=5.5
+
+plot = gsn_csm_contour(wks,WUP_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.02
+opts@cnMinLevelValF=0.02
+opts@cnMaxLevelValF=0.32
+
+plot = gsn_csm_contour(wks,MAFLX_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.025
+opts@cnMinLevelValF=0.025
+opts@cnMaxLevelValF=0.45
+
+plot = gsn_csm_contour(wks,DETR_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.00025
+opts@cnMinLevelValF=0.00025
+opts@cnMaxLevelValF=0.005
+
+plot = gsn_csm_contour(wks,ENTR_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.01
+opts@cnMinLevelValF=0.01
+opts@cnMaxLevelValF=0.16
+
+plot = gsn_csm_contour(wks,FRCUP_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=1
+opts@cnMinLevelValF=303
+opts@cnMaxLevelValF=319
+
+plot = gsn_csm_contour(wks,THVUP_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.005
+opts@cnMinLevelValF=-0.075
+opts@cnMaxLevelValF=0.055
+
+plot = gsn_csm_contour(wks,WTHL_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.00001
+opts@cnMinLevelValF=0.00001
+opts@cnMaxLevelValF=0.00019
+
+plot = gsn_csm_contour(wks,WRT_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.005
+opts@cnMinLevelValF=-0.016
+opts@cnMaxLevelValF=0.075
+plot = gsn_csm_contour(wks,WTHV_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.005
+opts@cnMinLevelValF=-0.120
+opts@cnMaxLevelValF=-0.005
+
+plot = gsn_csm_contour(wks,WU_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.004
+opts@cnMinLevelValF=-0.024
+opts@cnMaxLevelValF=0.048
+plot = gsn_csm_contour(wks,WV_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+end
diff --git a/MY_RUN/KTEST/005_ARM/004_ncl/run_ncl b/MY_RUN/KTEST/005_ARM/004_ncl/run_ncl
new file mode 100755
index 0000000000000000000000000000000000000000..7fa36570be699763a33bdad50638a95b35f01eb7
--- /dev/null
+++ b/MY_RUN/KTEST/005_ARM/004_ncl/run_ncl
@@ -0,0 +1,37 @@
+#!/bin/bash
+#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.
+set -x
+
+ln -sf ../002_mesonh/ARM__.1.CEN4T.000.* .
+
+rm -f visu_ARM.*.png
+
+ncl plot_arm.ncl
+${POSTRUN} display visu_ARM.000001.png
+${POSTRUN} display visu_ARM.000002.png
+${POSTRUN} display visu_ARM.000003.png
+${POSTRUN} display visu_ARM.000004.png
+${POSTRUN} display visu_ARM.000005.png
+${POSTRUN} display visu_ARM.000006.png
+${POSTRUN} display visu_ARM.000007.png
+${POSTRUN} display visu_ARM.000008.png
+${POSTRUN} display visu_ARM.000009.png
+${POSTRUN} display visu_ARM.000010.png
+${POSTRUN} display visu_ARM.000011.png
+${POSTRUN} display visu_ARM.000012.png
+${POSTRUN} display visu_ARM.000013.png
+${POSTRUN} display visu_ARM.000014.png
+${POSTRUN} display visu_ARM.000015.png
+${POSTRUN} display visu_ARM.000016.png
+${POSTRUN} display visu_ARM.000017.png
+${POSTRUN} display visu_ARM.000018.png
+${POSTRUN} display visu_ARM.000019.png
+${POSTRUN} display visu_ARM.000020.png
+${POSTRUN} display visu_ARM.000021.png
+${POSTRUN} display visu_ARM.000022.png
+${POSTRUN} display visu_ARM.000023.png
+${POSTRUN} display visu_ARM.000024.png
+exit 0
diff --git a/MY_RUN/KTEST/005_ARM/Makefile b/MY_RUN/KTEST/005_ARM/Makefile
index ea3b47d02c482ebfd287cf86e058ea1f156a6b8c..e9802cb77dfeb5f17cc60876cc4024efe8a6c41f 100644
--- a/MY_RUN/KTEST/005_ARM/Makefile
+++ b/MY_RUN/KTEST/005_ARM/Makefile
@@ -1,9 +1,15 @@
all:
cd 001_prep_ideal && run_prep_ideal_case_xyz
cd 002_mesonh && run_mesonh_xyz
+ ifneq "$(MNH_PYTHON)" "NO"
cd 003_python && run_python
+ endif
+ cd 004_ncl && run_ncl
clean:
cd 001_prep_ideal && clean_prep_ideal_case_xyz
cd 002_mesonh && clean_mesonh_xyz
+ ifneq "$(MNH_PYTHON)" "NO"
cd 003_python && clean_python
+ endif
+ cd 004_ncl && clean_ncl
diff --git a/MY_RUN/KTEST/007_16janvier/008_run2/run_mesonh_xyz b/MY_RUN/KTEST/007_16janvier/008_run2/run_mesonh_xyz
index 77692f0f6cc8be019f7463931b40a9ed79072b3d..e82b13a488c3483b41efbe28899e1855fc93f306 100755
--- a/MY_RUN/KTEST/007_16janvier/008_run2/run_mesonh_xyz
+++ b/MY_RUN/KTEST/007_16janvier/008_run2/run_mesonh_xyz
@@ -14,8 +14,8 @@ ln -sf ../003_nest/16JAN98_36km.neste1.{des,lfi,nc} .
ln -sf ../003_nest/16JAN98_9km.neste1.{des,lfi,nc} .
if [ "x${MNH_ECRAD}" != "x" ] ; then
-ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-1.0.1/data/RAD* .
-ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-1.0.1/data/*.nc .
+ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-${VERSION_ECRAD}/data/RAD* .
+ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-${VERSION_ECRAD}/data/*.nc .
sed -e's/ECMW/ECRA/g' EXSEG1.nam.src > EXSEG1.nam
sed -e's/ECMW/ECRA/g' EXSEG2.nam.src > EXSEG2.nam
else
diff --git a/MY_RUN/KTEST/007_16janvier/009_diag/run_diag_xyz b/MY_RUN/KTEST/007_16janvier/009_diag/run_diag_xyz
index 27ffa99ea871b2f79b7d149dc36073667afa399b..ef961876a3a4c209f5f455058f0e1c74ebce364c 100755
--- a/MY_RUN/KTEST/007_16janvier/009_diag/run_diag_xyz
+++ b/MY_RUN/KTEST/007_16janvier/009_diag/run_diag_xyz
@@ -14,8 +14,8 @@ ln -sf ../003_nest/16JAN98_9km.neste1.* .
ln -sf ../003_nest/16JAN98_36km.neste1.* .
if [ "x${MNH_ECRAD}" != "x" ] ; then
-ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-1.0.1/data/RAD* .
-ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-1.0.1/data/*.nc .
+ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-${VERSION_ECRAD}/data/RAD* .
+ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-${VERSION_ECRAD}/data/*.nc .
fi
cp DIAG1.nam1 DIAG1.nam
diff --git a/MY_RUN/KTEST/007_16janvier/010_python/plot_007_16janvier.py b/MY_RUN/KTEST/007_16janvier/010_python/plot_007_16janvier.py
index 7e32b6b951b437dcba03357de097726a2bd5d985..9bc7193671db8a65ad0364bbd55d7a4b4ea65fb5 100644
--- a/MY_RUN/KTEST/007_16janvier/010_python/plot_007_16janvier.py
+++ b/MY_RUN/KTEST/007_16janvier/010_python/plot_007_16janvier.py
@@ -32,7 +32,7 @@ Dvar = read_netcdf(LnameFiles, Dvar_input, path=path, removeHALO=True)
################################################################
######### PANEL 1
###############################################################
-Panel1 = PanelPlot(2,2, [20,20],'007_janvier domaine 1 16JAN.1.12B18.001dg.nc')
+Panel1 = PanelPlot(2,2, [20,20],'007_janvier domaine 1 16JAN.1.12B18.001dg.nc', minmaxpad=1.05)
Lplot = [ Dvar['f1']['ZS'],Dvar['f1']['THT850HPA'], Dvar['f1']['MRV700HPA'],Dvar['f1']['ALT_PRESSURE']]
lon = [Dvar['f1']['longitude']]*len(Lplot)
@@ -73,7 +73,7 @@ Panel1.save_graph(1,fig2)
################################################################
######### PANEL 2
###############################################################
-Panel2 = PanelPlot(2,2, [20,20],'007_janvier domaine 2 16JAN.1.12B18.001dg.nc')
+Panel2 = PanelPlot(2,2, [20,20],'007_janvier domaine 2 16JAN.1.12B18.001dg.nc', minmaxpad=1.05)
Lplot = [ Dvar['f2']['ZS'],Dvar['f2']['THT850HPA'], Dvar['f2']['MRV700HPA'],Dvar['f2']['ALT_PRESSURE']]
lon = [Dvar['f2']['longitude']]*len(Lplot)
diff --git a/MY_RUN/KTEST/011_KW78CHEM/004_python/plot_011_KW78CHEM.py b/MY_RUN/KTEST/011_KW78CHEM/004_python/plot_011_KW78CHEM.py
index d271fe993d8733a11387ff34e6ebd728f36d6e3c..3f792a31363a78a8d5db2c9e5163afa1597afc82 100644
--- a/MY_RUN/KTEST/011_KW78CHEM/004_python/plot_011_KW78CHEM.py
+++ b/MY_RUN/KTEST/011_KW78CHEM/004_python/plot_011_KW78CHEM.py
@@ -1,6 +1,5 @@
#!/usr/bin/env python3
"""
-
@author: Quentin Rodier
Creation : 07/01/2021
@@ -36,7 +35,7 @@ Dvar = read_netcdf(LnameFiles, Dvar_input, path=path, removeHALO=True)
################################################################
######### PANEL 1
###############################################################
-Panel1 = PanelPlot(2,3, [25,14],'', titlepad=25, minmaxpad=1.04, timepad=-0.07, colorbarpad=0.01)
+Panel1 = PanelPlot(2,3, [25,14],'', titlepad=25, minmaxpad=1.04, timepad=-0.07, colorbarpad=0.01, lateralminmaxpad=0.9)
Lplot = [ Dvar['f1']['INPRR'], Dvar['f1']['ACPRR'], Dvar['f1']['PABST'],Dvar['f2']['ALT_CLOUD'],Dvar['f2']['ALT_CLOUD'] ]
@@ -92,7 +91,7 @@ Panel1.save_graph(1,fig2)
###############################################################
Panel2 = PanelPlot(2,2, [20,20],'', titlepad=25, minmaxpad=1.04, timepad=-0.07, colorbarpad=0.01, colorbaraspect=40, labelcolorbarpad = 13)
-# Interpoler COT','O3T à 3000 et 5000m avec une moyenne sur2 niveaux
+# Interpoler COT','O3T à 3000 et 5000m avec une moyenne sur 2 niveaux
Dvar['f1']['COT3000m'] = (Dvar['f1']['COT'][6,:,:] + Dvar['f1']['COT'][5,:,:])/2.0
Dvar['f1']['O3T3000m'] = (Dvar['f1']['O3T'][6,:,:] + Dvar['f1']['O3T'][5,:,:])/2.0
Dvar['f1']['COT5000m'] = (Dvar['f1']['COT'][10,:,:] + Dvar['f1']['COT'][9,:,:])/2.0
@@ -131,7 +130,6 @@ Dvar['f1']['UM'] = tomass.MXM(Dvar['f1']['UT'])
Dvar['f1']['VM'] = tomass.MYM(Dvar['f1']['VT'])
Dvar['f1']['WM'] = tomass.MZM(Dvar['f1']['WT'])
-
angle_sec1, RVT_sec1, axe_m1 = oblique_proj(Dvar['f1']['RVT'], Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
WIND_proj = windvec_verti_proj(Dvar['f1']['UM'], Dvar['f1']['VM'], Dvar['f1']['level'], angle_sec1)
angle_sec1, WIND_sec1, axe_m1 = oblique_proj(WIND_proj, Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
@@ -161,7 +159,6 @@ fig3 = Panel3.psectionV(Lxx=LaxeX, Lzz=LaxeZ, Lvar=Lplot, Lxlab=Lxlab, Lylab=Lyl
Lstep=Lstep, Lstepticks=Lstepticks, Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel, Lfacconv=Lfacconv,
Ltime=Ltime, Lpltype=Lpltype, LaddWhite_cm=LaddWhite)
-
Lplot1 = [ WIND_sec1]
Lplot2 = [ WT_sec1]
Ltitle = ['Wind']
@@ -174,7 +171,6 @@ Lscale = [200]*len(Lplot)
fig4 = Panel3.pvector(Lxx=LaxeX, Lyy=LaxeZ, Lvar1=Lplot1, Lvar2=Lplot2, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lwidth=Lwidth, Larrowstep=Larrowstep,
Llegendval=Llegendval, Lcbarlabel=Lcbarlabel, Lid_overlap=[0], ax=fig3.axes, Lscale=Lscale)
-
Lplot = [RRT_sec1]
LaxeX = [axe_m1]
LaxeZ = [Dvar['f1']['level']]
@@ -196,7 +192,6 @@ LaddWhite = [True]*len(Lplot)
fig5 = Panel3.psectionV(Lxx=LaxeX, Lzz=LaxeZ, Lvar=Lplot, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lminval=Lminval, Lmaxval=Lmaxval,
Lstep=Lstep, Lstepticks=Lstepticks, LcolorLine=LcolorLine, Lcbarlabel=Lcbarlabel, Lfacconv=Lfacconv,
Ltime=Ltime, Lpltype=Lpltype, LaddWhite_cm=LaddWhite, ax=fig4.axes,Lid_overlap=[2],colorbar=False)
-
Panel3.save_graph(3,fig5)
################################################################
@@ -292,4 +287,4 @@ fig8 = Panel5.psectionV(Lxx=LaxeX, Lzz=LaxeZ, Lvar=Lplot, Lxlab=Lxlab, Lylab=Lyl
Lstep=Lstep, Lstepticks=Lstepticks, LcolorLine=LcolorLine, Lcbarlabel=Lcbarlabel, Lfacconv=Lfacconv,
Lpltype=Lpltype, ax=fig7.axes,Lid_overlap=[0, 2, 4, 6, 8, 10, 12, 14, 16],colorbar=False)
-Panel5.save_graph(5,fig8)
+Panel5.save_graph(5,fig8)
\ No newline at end of file
diff --git a/MY_RUN/KTEST/012_dust/005_python/plot_012_dust.py b/MY_RUN/KTEST/012_dust/005_python/plot_012_dust.py
index 7448f10d0b38061642aacbb934f40796745cc745..2116f12329b9163e64761721f006b0e9e06efd1f 100644
--- a/MY_RUN/KTEST/012_dust/005_python/plot_012_dust.py
+++ b/MY_RUN/KTEST/012_dust/005_python/plot_012_dust.py
@@ -9,7 +9,7 @@ import matplotlib as mpl
mpl.use('Agg')
from read_MNHfile import read_netcdf
from Panel_Plot import PanelPlot
-from misc_functions import mean_operator, convert_date
+from misc_functions import mean_operator
import cartopy.crs as ccrs
import numpy as np
import os
@@ -21,8 +21,7 @@ os.system('rm -f tempgraph*')
path=""
LnameFiles = ['DUST7.1.SEG02.004.nc']
-Dvar_input = {
-'f1':['ZS', 'UT','VT', 'WT','THT',
+Dvar_input = {'f1':['ZS', 'UT','VT', 'WT','THT',
'DSTM03T','DSTM33T','DSTM02T','DSTM32T','DSTM01T','DSTM31T','F_DST001P1','F_DST002P1','F_DST003P1',
'latitude','longitude','level',
'INPRR','ACPRR','PABST','RCT','RVT','RRT','LSTHM']}
@@ -30,6 +29,7 @@ Dvar_input = {
# Read the variables in the files
Dvar = {}
Dvar = read_netcdf(LnameFiles, Dvar_input, path=path, removeHALO=True)
+
################################################################
######### PANEL 1
###############################################################
@@ -74,6 +74,7 @@ fig2 = Panel1.pvector(Lxx=lon, Lyy=lat, Lvar1=Lplot1, Llevel=Llvl, Lvar2=Lplot2,
Llegendval=Llegendval, Lcbarlabel=Lcbarlabel, Lid_overlap=[0], ax=fig1.axes, Lscale=Lscale)
Panel1.save_graph(1,fig2)
+
################################################################
######### PANEL 2
###############################################################
@@ -97,6 +98,7 @@ fig3 = Panel2.psectionH(lon=lon, lat=lat, Lvar=Lplot, Llevel=Llvl, Lxlab=Lxlab,
Ltime=Ltime, LaddWhite_cm=LaddWhite, Lproj=Lprojection, ax=[])
Panel2.save_graph(2,fig3)
+
################################################################
######### PANEL 3
###############################################################
@@ -119,4 +121,4 @@ fig4 = Panel3.psectionH(lon=lon, lat=lat, Lvar=Lplot, Lxlab=Lxlab, Lylab=Lylab,
Lstep=[], Lstepticks=[], Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel,Lcarte=Lcarte,
Ltime=Ltime, LaddWhite_cm=LaddWhite, Lproj=Lprojection, ax=[])
-Panel3.save_graph(3,fig4)
+Panel3.save_graph(3,fig4)
\ No newline at end of file
diff --git a/MY_RUN/KTEST/014_LIMA/003_ncl/clean_ncl b/MY_RUN/KTEST/014_LIMA/003_ncl/clean_ncl
new file mode 100755
index 0000000000000000000000000000000000000000..ef83c16a5de17b683dd873050ef83dedfa0a005d
--- /dev/null
+++ b/MY_RUN/KTEST/014_LIMA/003_ncl/clean_ncl
@@ -0,0 +1,2 @@
+#!/bin/bash
+rm -f *.nc *.png
diff --git a/MY_RUN/KTEST/014_LIMA/003_ncl/plot_LIMA.ncl b/MY_RUN/KTEST/014_LIMA/003_ncl/plot_LIMA.ncl
new file mode 100644
index 0000000000000000000000000000000000000000..753a1d2ec97a0c960d674b36dea14f611165c718
--- /dev/null
+++ b/MY_RUN/KTEST/014_LIMA/003_ncl/plot_LIMA.ncl
@@ -0,0 +1,126 @@
+;================================================;
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl"
+; ================================================;
+;================================================;
+begin
+;=================================================;
+; open file and read in data
+;=================================================;
+ fichier1 = addfile("XPREF.1.SEG01.000.nc", "r")
+;==================================================;
+; Open the workstation
+;==================================================;
+ type = "png"
+ wks = gsn_open_wks(type,"visu_LIMA")
+;=================================================;
+; lecture des différents champs
+;=================================================;
+
+group_Budgets = fichier1=>Budgets
+group_RI = group_Budgets=>RI
+group_RS = group_Budgets=>RS
+group_RG = group_Budgets=>RG
+group_CICE = group_Budgets=>CICE
+group_CIFNFREE01 = group_Budgets=>CIFNFREE01
+group_CIFNNUCL01 = group_Budgets=>CIFNNUCL01
+
+
+vname = "AVEF"
+RI= group_RI->$vname$(0,:,0,:)
+RI@long_name="ice water content"
+RI@units="g/kg"
+
+NI= group_CICE->$vname$(0,:,0,:)
+NI@long_name="ice concentration"
+NI@units="/kg"
+
+RS= group_RS->$vname$(0,:,0,:)
+RS@long_name="snow water content"
+RS@units="g/kg"
+
+RG= group_RG->$vname$(0,:,0,:)
+RG@long_name="graupel water content"
+RG@units="g/kg"
+
+N_IFN_FREE= group_CIFNFREE01->$vname$(0,:,0,:)
+N_IFN_FREE@long_name="concentration of free IFN"
+N_IFN_FREE@units="/kg"
+
+N_IFN_NUCL= group_CIFNNUCL01->$vname$(0,:,0,:)
+N_IFN_NUCL@long_name="concentration of nucleated IFN"
+N_IFN_NUCL@units="/kg"
+
+
+zhat = fichier1->ZHAT(1:50)
+xhat = fichier1->XHAT(1:180)
+zs = fichier1->ZS(1:180) ; ZS
+
+xconf=conform(RI,xhat(0:179),1)
+
+;=================================================;
+; Altitude des niveaux modèles
+;=================================================;
+; Unstagger zhat (from grid 4 to 1)
+ nzh=new(50,double)
+ do k=0,48
+ nzh(k)=(zhat(k)+zhat(k+1))/2.
+ end do
+ nzh(49)=2*zhat(49)-zhat(48)
+
+; Create z (altitude des niveaux modèle)
+ z=new((/50,180/),double)
+ zcoef=new(180,double)
+ zcoef=1.-zs/nzh(49)
+
+ do i=0,179
+ z(:,i) = nzh*zcoef(i)+zs(i)
+ end do
+;=================================================;
+; Set some other basic resources
+;=================================================;
+ resmap = True
+ resmap@gsnFrame = False
+ resmap@gsnDraw = False
+ resmap@gsnMaximize = True
+ resmap@gsnPaperOrientation = "portrait"
+ resmap@gsnSpreadColors = True ; use full range of colormap
+ resmap@tiYAxisString =" "
+ resmap@cnFillOn = True ; turn on color fill
+ resmap@cnLinesOn = False ; turn off contour lines
+
+ resmap@tiXAxisPosition="Left"
+ resmap@tiXAxisFontHeightF=0.015
+; resmap@gsnSpreadColorStart = 0 ; force la première couleur en blanc(= couleur 0 de la palette)
+ resmap@sfYArray = z ; 2D
+ resmap@sfXArray = xconf ; 2D
+ resmap@trGridType = "TriangularMesh"
+;=================================================;
+; TRACE
+;=================================================;
+ gsn_define_colormap(wks,"rainbow") ; Choose colormap
+ res=resmap
+ res@cnLevelSelectionMode = "AutomaticLevels"
+ plot = gsn_csm_contour(wks,RI(:,:),res)
+ draw(plot)
+ frame(wks)
+
+ plot2 = gsn_csm_contour(wks,NI(:,:),res)
+ draw(plot2)
+ frame(wks)
+
+ plot3 = gsn_csm_contour(wks,RS(:,:),res)
+ draw(plot3)
+ frame(wks)
+
+ plot4 = gsn_csm_contour(wks,RG(:,:),res)
+ draw(plot4)
+ frame(wks)
+ plot5 = gsn_csm_contour(wks,N_IFN_FREE(:,:),res)
+ draw(plot5)
+ frame(wks)
+ plot6 = gsn_csm_contour(wks,N_IFN_NUCL(:,:),res)
+ draw(plot6)
+ frame(wks)
+
+end
diff --git a/MY_RUN/KTEST/014_LIMA/003_ncl/run_ncl b/MY_RUN/KTEST/014_LIMA/003_ncl/run_ncl
new file mode 100755
index 0000000000000000000000000000000000000000..2444be340eda2cb7a5a846cb44cd71694626e1c0
--- /dev/null
+++ b/MY_RUN/KTEST/014_LIMA/003_ncl/run_ncl
@@ -0,0 +1,20 @@
+#!/bin/bash
+#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.
+set -x
+
+ln -sf ../002_mesonh/XPREF.1.SEG01.000.nc .
+
+rm -f visu_LIMA.*.png
+
+ncl plot_LIMA.ncl
+
+${POSTRUN} display visu_LIMA.000001.png
+${POSTRUN} display visu_LIMA.000002.png
+${POSTRUN} display visu_LIMA.000003.png
+${POSTRUN} display visu_LIMA.000004.png
+${POSTRUN} display visu_LIMA.000005.png
+${POSTRUN} display visu_LIMA.000006.png
+exit 0
diff --git a/MY_RUN/KTEST/014_LIMA/004_python/plot_014_LIMA.py b/MY_RUN/KTEST/014_LIMA/004_python/plot_014_LIMA.py
index b64203496df724da0109d0798a84d4b66302de4e..61f335890fa2c86098b3b9e1aeb1c33eaa038cb2 100644
--- a/MY_RUN/KTEST/014_LIMA/004_python/plot_014_LIMA.py
+++ b/MY_RUN/KTEST/014_LIMA/004_python/plot_014_LIMA.py
@@ -20,25 +20,27 @@ os.system('rm -f tempgraph*')
path=""
LnameFiles = ['XPREF.1.SEG01.000.nc' ]
-Dvar_input = {'f1':[('RI','AVEF'), ('CICE','AVEF'), ('RS','AVEF'),('RG','AVEF'), ('CIFNFREE01','AVEF'),('CIFNNUCL01','AVEF') ]}
+Dvar_input = {'f1':[('/Budgets/RI','AVEF'), ('/Budgets/CICE','AVEF'), ('/Budgets/RS','AVEF'),
+ ('/Budgets/RG','AVEF'), ('/Budgets/CIFNFREE01','AVEF'),('/Budgets/CIFNNUCL01','AVEF') ]}
Dvar_input_coord_budget = {'f1':['cart_level', 'cart_ni']}
Dvar_input_coord = {'f1':['ZS','ZTOP']}
# Read the variables in the files
Dvar, Dvar_coord_budget, Dvar_coord = {}, {}, {}
-Dvar = read_netcdf(LnameFiles, Dvar_input, path=path, removeHALO=False)
-Dvar_coord_budget = read_netcdf(LnameFiles, Dvar_input_coord_budget, path=path, removeHALO=False)
+Dvar = read_netcdf(LnameFiles, Dvar_input, path=path, removeHALO=True)
+Dvar_coord_budget = read_netcdf(LnameFiles, Dvar_input_coord_budget, path=path, removeHALO=True)
Dvar_coord = read_netcdf(LnameFiles, Dvar_input_coord, path=path, removeHALO=True)
-Dvar['f1']['altitude'], Dvar['f1']['ni_2D'] = comp_altitude1DVar(Dvar['f1'][('CIFNFREE01','AVEF')], Dvar_coord['f1']['ZS'],Dvar_coord['f1']['ZTOP'], Dvar_coord_budget['f1']['cart_level'],Dvar_coord_budget['f1']['cart_ni'])
+Dvar['f1']['altitude'], Dvar['f1']['ni_2D'] = comp_altitude1DVar(Dvar['f1'][('/Budgets/CIFNNUCL01','AVEF')], Dvar_coord['f1']['ZS'],
+ Dvar_coord['f1']['ZTOP'], Dvar_coord_budget['f1']['cart_level'],Dvar_coord_budget['f1']['cart_ni'])
################################################################
######### PANEL 1
###############################################################
Panel1 = PanelPlot(2,3, [25,14],'014_LIMA', titlepad=25, minmaxpad=1.04, timepad=-0.07, colorbarpad=0.03, labelcolorbarpad = 13, colorbaraspect=40)
-Lplot = [Dvar['f1'][('RI','AVEF')],Dvar['f1'][('CICE','AVEF')], Dvar['f1'][('RS','AVEF')],
- Dvar['f1'][('RG','AVEF')],Dvar['f1'][('CIFNFREE01','AVEF')], Dvar['f1'][('CIFNNUCL01','AVEF')]]
+Lplot = [Dvar['f1'][('/Budgets/RI','AVEF')],Dvar['f1'][('/Budgets/CICE','AVEF')], Dvar['f1'][('/Budgets/RS','AVEF')],
+ Dvar['f1'][('/Budgets/RG','AVEF')],Dvar['f1'][('/Budgets/CIFNFREE01','AVEF')], Dvar['f1'][('/Budgets/CIFNNUCL01','AVEF')]]
LaxeX = [Dvar['f1']['ni_2D']]*len(Lplot)
LaxeZ = [Dvar['f1']['altitude']]*len(Lplot)
Ltitle = ['Ice water content', 'Ice concentration', 'Snow water content',
diff --git a/MY_RUN/KTEST/014_LIMA/Makefile b/MY_RUN/KTEST/014_LIMA/Makefile
index c03971716585263f5a1107ad18335ea48c7fc060..d2df0e9b7892909be537addfc14b71a2626254b3 100644
--- a/MY_RUN/KTEST/014_LIMA/Makefile
+++ b/MY_RUN/KTEST/014_LIMA/Makefile
@@ -1,6 +1,7 @@
all:
cd 001_prep_ideal_case && run_prep_ideal_case_xyz
cd 002_mesonh && run_mesonh_xyz
+ cd 003_ncl && run_ncl
ifneq "$(MNH_PYTHON)" "NO"
cd 004_python && run_python
endif
@@ -8,6 +9,7 @@ all:
clean:
cd 001_prep_ideal_case && clean_prep_ideal_case_xyz
cd 002_mesonh && clean_mesonh_xyz
+ cd 003_ncl && clean_ncl
ifneq "$(MNH_PYTHON)" "NO"
cd 004_python && clean_python
endif
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/Python/Panel_Plot.py b/src/LIB/Python/Panel_Plot.py
index 24134085e04ad816580a545bfb65de987ec3db8b..8e095faf07fd46b6dcd4f01df5dddca6b0b5759a 100644
--- a/src/LIB/Python/Panel_Plot.py
+++ b/src/LIB/Python/Panel_Plot.py
@@ -1,9 +1,12 @@
#!/usr/bin/env python3
# -*- coding: utf-8 -*-
"""
-Created on Wed Feb 24 10:49:45 2021
+MNH_LIC Copyright 1994-2021 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.
-@author: rodierq
+@author: 07/2021 Quentin Rodier
"""
import matplotlib as mpl
mpl.use('Agg')
@@ -11,6 +14,7 @@ import matplotlib.pyplot as plt
from matplotlib import cm
from matplotlib.colors import ListedColormap
import numpy as np
+import cartopy
import cartopy.feature as cfeature
class PanelPlot():
@@ -56,8 +60,12 @@ class PanelPlot():
# Grid lines and labels
if 'PlateCarree' in str(projo):
gl = ax.gridlines(crs=self.projo, draw_labels=True, linewidth=1, color='gray')
- gl.top_labels = False
- gl.right_labels = False
+ if float(cartopy.__version__[:4]) >= 0.18:
+ gl.top_labels = False
+ gl.right_labels = False
+ else:
+ gl.xlabels_top = False
+ gl.ylabels_right = False
# Coastlines
if self.drawCoastLines and 'GeoAxes' in str(type(ax)):
@@ -188,7 +196,7 @@ class PanelPlot():
Lfacconv=[], ax=[], Lid_overlap=[], colorbar=True, orog=[], Lxlim=[], Lylim=[], Ltime=[], Lpltype=[], LaddWhite_cm=[]):
"""
Horizontal cross section plot
- Arguments :
+ Parameters :
- Lxx : List of x or y coordinate variable or time axis
- Lzz : List of z coordinates variable
- Lvar : List of variables to plot
@@ -253,7 +261,7 @@ class PanelPlot():
# Print time validity
if Ltime: self.showTimeText(self.ax, iax, str(Ltime[i]))
-
+
# Number of contours level
if not Lstep[i]: # Default value of number of steps is 20
Lstep[i] = (Lmaxval[i] - Lminval[i])/20
@@ -315,7 +323,7 @@ class PanelPlot():
Lylim=[], Ltime=[], LaxisColor=[]):
"""
XY (multiple)-lines plot
- Arguments :
+ Parameters :
- Lxx : List of variables to plot or coordinates along the X axis #TODO : ajouter Lfacconv pour les deux axes. Impact tous les cas test avec lignes X/Y
- Lyy : List of variables to plot or coordinates along the Y axis
- Lxlab : List of x-axis label
@@ -405,7 +413,7 @@ class PanelPlot():
Lid_overlap=[], colorbar=True, Ltime=[], LaddWhite_cm=[], Lpltype=[], Lcbformatlabel=[]):
"""
Horizontal cross section plot
- Arguments :
+ Parameters :
- lon : longitude 2D array
- lat : latitude 2D array
- Lvar : List of variables to plot
@@ -554,7 +562,7 @@ class PanelPlot():
Lylim=[], Lxlim=[]):
"""
Horizontal vectors lines
- Arguments :
+ Parameters :
- Lxx : List of x or y coordinate variable (lat or ni or nm)
- Lyy : List of y coordinates variable (lon or level)
- Lvar1 : List of wind-component along x/y or oblic axis (3D for hor. section, 2D for vertical section)
@@ -667,7 +675,7 @@ class PanelPlot():
Lylim=[], Lxlim=[]):
"""
Wind stream lines
- Arguments :
+ Parameters :
- Lxx : List of x or y coordinate variable (lat or ni or nm)
- Lyy : List of y coordinates variable (lon or level)
- Lvar1 : List of wind-component along x/y or oblic axis (3D for hor. section, 2D for vertical section)
@@ -768,7 +776,7 @@ class PanelPlot():
Lylim=[], Ltime=[], LaxisColor=[]):
"""
XY Histogram
- Arguments :
+ Parameters :
- Lbins : List of bins
- Lvar : List of the value for each bin
- Lxlab : List of x-axis label
diff --git a/src/LIB/Python/misc_functions.py b/src/LIB/Python/misc_functions.py
index 6b2c0932742f0d47e6607275a890f990a50226ce..aa91aa7a311dc721c17f3f28cc7a8fd4f78df5b1 100644
--- a/src/LIB/Python/misc_functions.py
+++ b/src/LIB/Python/misc_functions.py
@@ -1,9 +1,12 @@
#!/usr/bin/env python3
# -*- coding: utf-8 -*-
"""
-Created on Thu Feb 25 11:25:31 2021
+MNH_LIC Copyright 1994-2021 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.
-@author: rodierq
+@author: 07/2021 Quentin Rodier
"""
import copy
from scipy.interpolate import RectBivariateSpline
@@ -11,8 +14,6 @@ import numpy as np
import math
def convert_date(datesince, time_in_sec):
- print(type(datesince))
- print(type(time_in_sec))
return str(time_in_sec) + datesince[:33]
class mean_operator():
@@ -37,103 +38,172 @@ class mean_operator():
out[k,:,:] = (var[k,:,:] + var[k+1,:,:])*0.5
return out
-def windvec_verti_proj(u, v, lvl, angle):
- """
- Compute the projected horizontal wind vector on an axis with a given angle w.r.t. the x/ni axes (West-East)
- Arguments :
- - u : U-wind component
- - v : V-wind component
- - angle (radian) of the new axe w.r.t the x/ni axes (West-East). angle = 0 for (z,x) sections, angle=pi/2 for (z,y) sections
- Returns :
- - a 3D wind component projected on the axe to be used with Panel_Plot.vector as Lvar1
- """
- out = copy.deepcopy(u)
- for k in range(len(lvl)):
- out[k,:,:] = u[k,:,:]*math.cos(angle) + v[k,:,:]*math.sin(angle)
- return out
+def windvec_verti_proj(u, v, level, angle):
+ """Compute the projected horizontal wind vector on an axis with a given angle w.r.t. the x/ni axes (West-East)
+
+ Parameters
+ ----------
+ u : array 3D
+ U-wind component
+
+ v : array 3D
+ V-wind component
+
+ level : array 1D
+ level dimension array
+
+ angle : float
+ angle (radian) of the new axe w.r.t the x/ni axes (West-East). angle = 0 for (z,x) sections, angle=pi/2 for (z,y) sections
+
+ Returns
+ -------
+
+ projected_wind : array 3D
+ a 3D wind component projected on the axe to be used with Panel_Plot.pvector as Lvar1
+ """
+ projected_wind = copy.deepcopy(u)
+ for k in range(len(level)):
+ projected_wind[k,:,:] = u[k,:,:]*math.cos(angle) + v[k,:,:]*math.sin(angle)
+ return projected_wind
def oblique_proj(var, ni, nj, lvl, i_beg, j_beg, i_end, j_end):
- """
- Compute an oblique projection of a 3D variable w.r.t. its axes
- Arguments :
- - var : 3D var to project (example THT)
- - ni : 1D x-axe of the 3D dimension
- - nj : 1D y-axe of the 3D dimension
- - level : 1D level variable (level or level_w)
- - i_beg, j_beg : coordinate of the begin point of the new axe
- - i_end, j_end : coordinate of the end point of the new axe
- Returns :
- - a 2D (z,m) variable projected on the oblique axe
- - a 1D m new axe (distance from the beggining point)
- - the angle (radian) of the new axe w.r.t the x/ni axes (West-East)
- """
- dist_seg=np.sqrt((i_end-i_beg)**2.0 + (j_end-j_beg)**2.0) # Distance de la section oblique m
- out_var = np.zeros((len(lvl),int(dist_seg)+1)) # Initialisation du nouveau champs projeté dans la coupe (z,m)
- axe_m = np.zeros(int(dist_seg)+1) #Axe des abscisses qui sera tracé selon la coupe
- axe_m_coord = [] #Coordonnées x,y des points qui composent l'axe
- axe_m_coord.append( (ni[i_beg],nj[j_beg]) ) #Le premier point est celui donné par l'utilisateur
- for m in range(int(dist_seg)): #Discrétisation selon distance de la coupe / int(distance_de_la_coupe)
- axe_m_coord.append( (axe_m_coord[0][0] + (ni[i_end]-ni[i_beg])/(int(dist_seg))*(m+1),
- axe_m_coord[0][1] + (nj[j_end]-nj[j_beg])/(int(dist_seg))*(m+1) ))
- axe_m[m+1] = np.sqrt((ni[i_beg]-axe_m_coord[m+1][0])**2 + (nj[j_beg]-axe_m_coord[m+1][1])**2)
-
- for k in range(len(lvl)):
- a=RectBivariateSpline(ni, nj,var[k,:,:],kx=1,ky=1) #Interpolation par niveau à l'ordre 1 pour éviter des valeurs négatives de champs strictement > 0
- for m in range(int(dist_seg)+1):
- out_var[k,m] = a.ev(axe_m_coord[m][0],axe_m_coord[m][1]) # La fonction ev de RectBivariate retourne la valeur la plus proche du point considéré
-
- angle_proj = math.acos((ni[i_end]-ni[i_beg])/axe_m[-1])
- return angle_proj, out_var, axe_m
+ """Compute an oblique projection of a 3D variable w.r.t. its axes
+
+ Parameters
+ ----------
+ var : array 3D
+ the 3D variable to project (e.g. THT)
+
+ ni : array 1D
+ 1D x-axis of the 3D dimension
+
+ nj : array 1D
+ 1D y-axis of the 3D dimension
+
+ level : array 1D
+ 1D z-axe of the 3D dimension
+
+ i_beg, j_beg : int
+ coordinate of the begin point of the new axe
+
+ i_end, j_end : int
+ coordinate of the end point of the new axe
+
+ Returns
+ -------
+ angle_proj : float
+ the angle (radian) of the new axe w.r.t the x/ni axes (West-East)
+
+ out_var : array 2D
+ a 2D (z,m) variable projected on the oblique axe
+
+ axe_m : array 1D
+ a 1D m new axe (distance from the beggining point)
+
+ """
+ dist_seg=np.sqrt((i_end-i_beg)**2.0 + (j_end-j_beg)**2.0) # Distance de la section oblique m
+ out_var = np.zeros((len(lvl),int(dist_seg)+1)) # Initialisation du nouveau champs projeté dans la coupe (z,m)
+ axe_m = np.zeros(int(dist_seg)+1) #Axe des abscisses qui sera tracé selon la coupe
+ axe_m_coord = [] #Coordonnées x,y des points qui composent l'axe
+ axe_m_coord.append( (ni[i_beg],nj[j_beg]) ) #Le premier point est celui donné par l'utilisateur
+ for m in range(int(dist_seg)): #Discrétisation selon distance de la coupe / int(distance_de_la_coupe)
+ axe_m_coord.append( (axe_m_coord[0][0] + (ni[i_end]-ni[i_beg])/(int(dist_seg))*(m+1),
+ axe_m_coord[0][1] + (nj[j_end]-nj[j_beg])/(int(dist_seg))*(m+1) ))
+ axe_m[m+1] = np.sqrt((ni[i_beg]-axe_m_coord[m+1][0])**2 + (nj[j_beg]-axe_m_coord[m+1][1])**2)
+
+ for k in range(len(lvl)):
+ a=RectBivariateSpline(ni, nj,var[k,:,:],kx=1,ky=1) #Interpolation par niveau à l'ordre 1 pour éviter des valeurs négatives de champs strictement > 0
+ for m in range(int(dist_seg)+1):
+ out_var[k,m] = a.ev(axe_m_coord[m][0],axe_m_coord[m][1]) # La fonction ev de RectBivariate retourne la valeur la plus proche du point considéré
+
+ angle_proj = math.acos((ni[i_end]-ni[i_beg])/axe_m[-1])
+ return angle_proj, out_var, axe_m
def comp_altitude1DVar(oneVar2D, orography, ztop, level, n_xory):
- """
- Compute and returns an altitude and x or y grid mesh variable in 2D following the topography in 1D
- To be used with 2D simulations
- Arguments :
- - oneVar2D : a random netCDF 2D var (example UT, THT)
- - orography : 1D orography (ZS)
- - ztop : scalar of the top height of the model (ZTOP)
- - level : 1D level variable (level or level_w)
- - n_xory: : 1D directionnal grid variable (ni_u, nj_u, ni_v or nj_v)
- Returns :
- - a 2D altitude variable with topography taken into account
- - a 2D directionnal variable
- """
- n_xory_2D = copy.deepcopy(oneVar2D)
- altitude = copy.deepcopy(oneVar2D)
- for i in range(len(level)):
- n_xory_2D[i,:] = n_xory
- for j in range(len(n_xory)):
+ """Compute and returns an altitude and x or y grid mesh variable in 2D following the topography in 1D
+ To be used with 2D simulations
+
+ Parameters
+ ----------
+ oneVar2D : array 2D
+ a 2D array (e.g. UT, THT)
+
+ orography : array 1D
+ 1D orography (ZS)
+
+ ztop : real
+ scalar of the top height of the model (ZTOP)
+
+ level : array 1D
+ 1D level variable (level or level_w)
+
+ n_xory : array 1D
+ 1D directionnal grid variable (ni_u, nj_u, ni_v or nj_v)
+
+ Returns
+ -------
+ altitude
+ a 2D altitude variable with topography taken into account
+
+ n_xory_2D
+ a 2D directionnal variable duplicated from n_xory
+ """
+ n_xory_2D = copy.deepcopy(oneVar2D)
+ altitude = copy.deepcopy(oneVar2D)
+
for k in range(len(level)):
- altitude[k,j] = orography[j] + level[k]*((ztop-orography[j])/ztop)
- return altitude, n_xory_2D
+ n_xory_2D[k,:] = n_xory
+ for j in range(len(n_xory)):
+ for k in range(len(level)):
+ altitude[k,j] = orography[j] + level[k]*((ztop-orography[j])/ztop)
+ return altitude, n_xory_2D
def comp_altitude2DVar(oneVar3D, orography, ztop, level, n_y, n_x):
- """
- Compute and returns an altitude and x or y grid mesh variable in 3D following the topography in 2D
- To be used with 3D simulations in cartesian coordinates
- Arguments :
- - oneVar3D : a random netCDF 3D var (example UT, THT)
- - orography : 2D orography (ZS)
- - ztop : scalar of the top height of the model (ZTOP)
- - level : 1D level variable (level or level_w)
- - n_xory: : 1D directionnal grid variable (ni_u, nj_u, ni_v or nj_v)
- Returns :
- - a 3D altitude variable with topography taken into account
- - a 3D directionnal variable
- """
- n_x3D = copy.deepcopy(oneVar3D)
- n_y3D = copy.deepcopy(oneVar3D)
- altitude = copy.deepcopy(oneVar3D)
- for i in range(len(level)):
- n_y3D[i,:] = n_y
- n_x3D[i,:] = n_x
- for i in range(oneVar3D.shape[2]):
- for j in range(oneVar3D.shape[1]):
- if ztop==0:
- altitude[:,i,j] = level[:]
- else:
- for k in range(len(level)):
- altitude[k,j,i] = orography[j,i] + level[k]*((ztop-orography[j,i])/ztop)
-
- return altitude, n_x3D, n_y3D
+ """Compute and returns an altitude and x or y grid mesh variable in 3D following the topography in 2D
+ To be used with 3D simulations
+
+ Parameters
+ ----------
+ oneVar3D : array 3D
+ a 3D array (e.g. UT, THT)
+
+ orography : array 2D
+ 2D orography (ZS)
+
+ ztop : real
+ scalar of the top height of the model (ZTOP)
+
+ level : array 1D
+ 1D level variable (level or level_w)
+
+ n_x : array 1D
+ 1D directionnal grid variable along i (ni_u, or ni_v)
+
+ n_y : array 1D
+ 1D directionnal grid variable along j (nj_u, or nj_v)
+
+ Returns
+ -------
+ altitude
+ a 3D altitude variable with topography taken into account
+
+ n_x3D
+ a 3D directionnal variable duplicated from n_x
+
+ n_y3D
+ a 3D directionnal variable duplicated from n_y
+ """
+ n_x3D = copy.deepcopy(oneVar3D)
+ n_y3D = copy.deepcopy(oneVar3D)
+ altitude = copy.deepcopy(oneVar3D)
+ for i in range(len(level)):
+ n_y3D[i,:] = n_y
+ n_x3D[i,:] = n_x
+ for i in range(oneVar3D.shape[2]):
+ for j in range(oneVar3D.shape[1]):
+ if ztop==0:
+ altitude[:,i,j] = level[:]
+ else:
+ for k in range(len(level)):
+ altitude[k,j,i] = orography[j,i] + level[k]*((ztop-orography[j,i])/ztop)
+ return altitude, n_x3D, n_y3D
\ No newline at end of file
diff --git a/src/LIB/Python/read_MNHfile.py b/src/LIB/Python/read_MNHfile.py
index 7ad0bd539810b5413023b7339b11e479f3a7d548..6c1311c1730eddb20446c428ddedc1de2d683cf2 100644
--- a/src/LIB/Python/read_MNHfile.py
+++ b/src/LIB/Python/read_MNHfile.py
@@ -1,287 +1,344 @@
#!/usr/bin/env python3
# -*- coding: utf-8 -*-
"""
-Created on Mon Feb 22 10:29:13 2021
+MNH_LIC Copyright 1994-2021 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.
-@author: rodierq
+@author: 07/2021 Quentin Rodier
"""
-
import netCDF4 as nc
import numpy as np
-def read_netcdf(LnameFiles, Dvar_input, path='.', removeHALO=True):
- Dvar = {}
- for i,nameFiles in enumerate(LnameFiles):
- f_nb = 'f' + str(i+1)
- print('Reading file ' + f_nb)
- print(path + nameFiles)
- if '000' in nameFiles[-6:-3]: #time series file (diachronic)
+def read_netcdf(LnameFiles, Dvar_input, path='.', get_data_only=True, del_empty_dim=True, removeHALO=True):
+ """Read a netCDF4 Meso-NH file
+ For each file, call functions to read diachronic or synchronous file
+
+ Parameters
+ ----------
+ LnameFiles : list of str
+ list of Meso-NH netCDF4 file (diachronic or synchronous)
+
+ Dvar_input : Dict{'fileNumber' : 'var_name',('group_name','var_name')}
+ where
+ 'fileNumber' is a str corresponding to 'f' + the file number in LnameFiles (by order)
+ 'var_name' is the exact str of the netCDF4 variable name
+ ('group_name','var_name') is the exact tuple of the (sub-)groups name and the netCDF4 variable name
+ e.g. : {'f1':['ZS', 'WT','ni', 'level'],
+ 'f2':[('/LES_budgets/Cartesian/Not_time_averaged/Not_normalized/cart/',MEAN_TH'),('/Budgets/RI','AVEF')]
+ }
+
+ path : str
+ unique path of the files
+
+ get_data_only : bool, default: True
+ if True, the function returns Dvar as masked_array (only data)
+ if False, the function returns Dvar as netCDF4._netCDF4.Variable
+
+ del_empty_dim : bool, default: True
+ if get_data_only=True and del_empty_dim=True, returns Dvar as an array without dimensions with size 1 and 0
+ e.g. : an array of dimensions (time_budget, cart_level, cart_nj, cart_ni) with shape (180,1,50,1) is returned (180,50)
+
+ removeHALO : bool, default: True
+ if True, remove first and last (NHALO=1) point [1:-1] if get_data_only=True on each
+ level, level_w, ni, ni_u, ni_v, nj, nj_u, nj_v dimensions
+
+ Returns
+ -------
+ Dvar : Dict
+ Dvar[ifile]['var_name'] if the group contains only one variable
+ Dvar[ifile][('group_name','var_name')] if the group contains more than one variable
+ """
+ Dvar = {}
+ for i,nameFiles in enumerate(LnameFiles):
+ f_nb = 'f' + str(i+1)
+ print('Reading file ' + f_nb)
+ print(path + nameFiles)
theFile = nc.Dataset(path + nameFiles,'r')
- if theFile['MASDEV'][0] <= 54:
- read_TIMESfiles_54(theFile, f_nb, Dvar_input, Dvar)
- else : # 55 groups variables
- read_TIMESfiles_55(theFile, f_nb, Dvar_input, Dvar, removeHALO)
+ Dvar[f_nb] = {}
+ if '000' in nameFiles[-6:-3]:
+ if theFile['MASDEV'][0] <= 54:
+ raise TypeError('The python lib is available for MNH >= 5.5')
+ else:
+ Dvar[f_nb] = read_TIMESfiles_55(theFile, Dvar_input[f_nb], Dvar[f_nb], get_data_only, del_empty_dim, removeHALO)
+ else:
+ Dvar[f_nb]= read_BACKUPfile(theFile, Dvar_input[f_nb], Dvar[f_nb], get_data_only, del_empty_dim, removeHALO)
theFile.close()
- else:
- read_BACKUPfile(nameFiles, f_nb, Dvar_input, Dvar, path=path, removeHALO=removeHALO)
- return Dvar #Return the dic of [files][variables]
-
-def read_BACKUPfile(nameF, ifile, Dvar_input, Dvar_output, path='.', removeHALO=True):
- theFile = nc.Dataset(path + nameF,'r')
- Dvar_output[ifile] = {} #initialize dic for each files
-
- # Reading date since beginning of the model run
- Dvar_output[ifile]['time'] = theFile.variables['time'][0]
- Dvar_output[ifile]['date'] = nc.num2date(Dvar_output[ifile]['time'],units=theFile.variables['time'].units, calendar = theFile.variables['time'].calendar)
+ return Dvar
- for var in Dvar_input[ifile]: #For each files
- # Read variables
- n_dim = theFile.variables[var].ndim
- name_dim = theFile.variables[var].dimensions
+def read_var(theFile, Dvar, var_name, get_data_only=True, del_empty_dim=True, removeHALO=True):
+ """Read a netCDF4 variable
+
+ Parameters
+ ----------
+ theFile : netCDF4._netCDF4.Dataset
+ a Meso-NH diachronic netCDF4 file
+
+ var_name : str
+ a Meso-NH netCDF4 variable name
+
+ get_data_only : bool, default: True
+ if True, the function returns Dvar as masked_array (only data)
+ if False, the function returns Dvar as netCDF4._netCDF4.Variable
- if (n_dim ==0) or (n_dim == 1 and 'time' in name_dim): #Scalaires or Variable time
- Dvar_output[ifile][var] = theFile.variables[var][0].data
- else:
+ del_empty_dim : bool, default: True
+ if get_data_only=True and del_empty_dim=True, returns Dvar as an array without dimensions with size 1 and 0
+ e.g. : an array of dimensions (time_budget, cart_level, cart_nj, cart_ni) with shape (180,1,50,1) is returned (180,50)
+
+ removeHALO : bool, default: True
+ if True, remove first and last (NHALO=1) point [1:-1] if get_data_only=True on each
+ level, level_w, ni, ni_u, ni_v, nj, nj_u, nj_v dimensions
+
+ Returns
+ -------
+ Dvar : Dict
+ Dvar['var_name'] if the group contains only one variable
+ Dvar[('group_name','var_name')] if the group contains more than one variable
+ """
+ try:
+ var_dim = theFile.variables[var_name].ndim
+ var_dim_name = theFile.variables[var_name].dimensions
+ except:
+ raise KeyError("Group and variable name not found in the file, check the group/variable name with ncdump -h YourMNHFile.000.nc. You asked for variable : " + var_name)
+
+ if not get_data_only:
+ Dvar[var_name] = theFile.variables[var_name]
+ else:
+ if var_dim == 0:
+ Dvar[var_name] = theFile.variables[var_name][0].data
+ elif var_dim == 1:
+ Dvar[var_name] = theFile.variables[var_name][:]
+ elif var_dim == 2:
+ Dvar[var_name] = theFile.variables[var_name][:,:]
+ elif var_dim == 3:
+ Dvar[var_name] = theFile.variables[var_name][:,:,:]
+ elif var_dim == 4:
+ Dvar[var_name] = theFile.variables[var_name][:,:,:,:]
+ elif var_dim == 5:
+ Dvar[var_name] = theFile.variables[var_name][:,:,:,:,:]
+ elif var_dim == 6:
+ Dvar[var_name] = theFile.variables[var_name][:,:,:,:,:,:]
+ elif var_dim == 7:
+ Dvar[var_name] = theFile.variables[var_name][:,:,:,:,:,:,:]
if removeHALO:
- if n_dim == 1:
- Dvar_output[ifile][var] = theFile.variables[var][1:-1] #Variables 1D
- elif n_dim == 2:
- if theFile.variables[var].shape[0] == 1 and 'size' in name_dim[1]: #Variables 2D with the second dimension not a coordinate (--> list of strings : chemicals)
- Dvar_output[ifile][var] = theFile.variables[var][0,:] #Variables 2D
- elif theFile.variables[var].shape[0] == 1: #Variables 2D with first dim = 0
- Dvar_output[ifile][var] = theFile.variables[var][0,1:-1] #Variables 2D
- else:
- Dvar_output[ifile][var] = theFile.variables[var][1:-1,1:-1] #Variables 2D
- elif n_dim == 5: #Variables time, sizeXX, level, nj, ni (ex: chemical budgets in 3D)
- Dvar_output[ifile][var] = theFile.variables[var][0, :, 1:-1,:1:-1,1:-1]
- elif n_dim == 4 and 'time' in name_dim and ('level' in name_dim or 'level_w' in name_dim): # time,z,y,x
- if theFile.variables[var].shape[1] == 1: #Variables 4D time,z,y,x with time=0 z=0
- Dvar_output[ifile][var] = theFile.variables[var][0,0,1:-1,1:-1] #Variables 2D y/x
- elif theFile.variables[var].shape[2] == 1: #Variable 2D (0,zz,0,xx)
- Dvar_output[ifile][var] = theFile.variables[var][0,1:-1,0,1:-1] #Variables 2D z/y
- elif theFile.variables[var].shape[3] == 1: #Variable 2D (0,zz,yy,0)
- Dvar_output[ifile][var] = theFile.variables[var][0,1:-1,1:-1,0] #Variables 2D z/x
- ## ATTENTION VARIABLE 1D codé en 4D non faite
- else: #Variable 3D simple
- Dvar_output[ifile][var] = theFile.variables[var][0,1:-1,1:-1,1:-1] #Variables time + 3D
- elif n_dim == 4 and 'time' in name_dim and 'level' not in name_dim and 'level_w' not in name_dim: # time,nb_something,y,x
- Dvar_output[ifile][var] = theFile.variables[var][0,:,1:-1,1:-1] #Variables 2D y/x
- elif n_dim == 3 and 'time' in name_dim: # time, y, x
- Dvar_output[ifile][var] = theFile.variables[var][0,1:-1,1:-1]
- else :
- Dvar_output[ifile][var] = theFile.variables[var][1:-1,1:-1,1:-1] #Variables 3D
- else:
- if n_dim == 1:
- Dvar_output[ifile][var] = theFile.variables[var][:] #Variables 1D
- elif n_dim == 2:
- if theFile.variables[var].shape[0] == 1 and 'size' in name_dim[1]: #Variables 2D with the second dimension not a coordinate (--> list of strings : chemicals)
- Dvar_output[ifile][var] = theFile.variables[var][0,:] #Variables 2D
- elif theFile.variables[var].shape[0] == 1: #Variables 2D with first dim = 0
- Dvar_output[ifile][var] = theFile.variables[var][0,:] #Variables 2D
- else:
- Dvar_output[ifile][var] = theFile.variables[var][:,:] #Variables 2D
- elif n_dim == 5: #Variables time, sizeXX, level, nj, ni (ex: chemical budgets in 3D)
- Dvar_output[ifile][var] = theFile.variables[var][0,:,:,:,:]
- elif n_dim == 4: # time,z,y,x
- if theFile.variables[var].shape[1] == 1: #Variables 4D time,z,y,x with time=0 z=0
- Dvar_output[ifile][var] = theFile.variables[var][0,0,:,:] #Variables 2D y/x
- elif theFile.variables[var].shape[2] == 1: #Variable 2D (0,zz,0,xx)
- Dvar_output[ifile][var] = theFile.variables[var][0,:,0,:] #Variables 2D z/y
- elif theFile.variables[var].shape[3] == 1: #Variable 2D (0,zz,yy,0)
- Dvar_output[ifile][var] = theFile.variables[var][0,:,:,0] #Variables 2D z/x
- ## ATTENTION VARIABLE 1D codé en 4D non faite
- else: #Variable 3D simple
- Dvar_output[ifile][var] = theFile.variables[var][0,:,:,:] #Variables time + 3D
- elif n_dim ==3 and name_dim in var.dimensions: # time, y, x
- Dvar_output[ifile][var] = theFile.variables[var][0,:,:]
- else:
- Dvar_output[ifile][var] = theFile.variables[var][:,:,:] #Variables 3D
- # For all variables except scalars, change Fill_Value to NaN
- Dvar_output[ifile][var]= np.where(Dvar_output[ifile][var] != -99999.0, Dvar_output[ifile][var], np.nan)
- Dvar_output[ifile][var]= np.where(Dvar_output[ifile][var] != 999.0, Dvar_output[ifile][var], np.nan)
-
- theFile.close()
- return Dvar_output #Return the dic of [files][variables]
-
-def read_TIMESfiles_54(theFile, ifile, Dvar_input, Dvar_output):
- Dvar_output[ifile] = {} #initialize dic for each files
+ for i in range(8):
+ try:
+ if var_dim_name[i]=='level' or var_dim_name[i]=='level_w' or \
+ var_dim_name[i]=='ni' or var_dim_name[i]=='ni_u' or var_dim_name[i]=='ni_v' or \
+ var_dim_name[i]=='nj' or var_dim_name[i]=='nj_u' or var_dim_name[i]=='nj_v':
+ if var_dim != 0:
+ Dvar[var_name] = removetheHALO(i+1, Dvar[var_name])
+ except:
+ break
+ if del_empty_dim:
+ Ldimtosqueeze=[]
+ var_shape = theFile.variables[var_name].shape
+ for i in range(8):
+ try:
+ if var_shape[i]==1: Ldimtosqueeze.append(i)
+ except IndexError:
+ break
+ Ldimtosqueeze=tuple(Ldimtosqueeze)
+ Dvar[var_name] = np.squeeze(Dvar[var_name], axis=Ldimtosqueeze)
+
+ return Dvar
- # Level variable is automatically read without the Halo
- Dvar_output[ifile]['level'] = theFile.variables['level'][1:-1]
+def read_from_group(theFile, Dvar, group_name, var_name, get_data_only=True, del_empty_dim=True,removeHALO=True):
+ """Read a variable from a netCDF4 group
- # Time variable is automatically read (time since begging of the run) from the 1st variable of the asked variable to read
- suffix, name_first_var = remove_PROC(Dvar_input[ifile][0])
- try: # It is possible that there is only one value (one time) in the .000 file, as such time series are not suitable and the following line can't be executed. The time variable is then not written
- increment = theFile.variables[name_first_var+'___DATIM'][1,-1] - theFile.variables[name_first_var+'___DATIM'][0,-1] #-1 is the last entry of the date (current UTC time in seconds)
- length_time = theFile.variables[name_first_var+'___DATIM'].shape[0]
- Dvar_output[ifile]['time'] = np.arange(increment,increment*(length_time+1),increment)
+ Parameters
+ ----------
+ theFile : netCDF4._netCDF4.Dataset
+ a Meso-NH diachronic netCDF4 file
+
+ group_name : str
+ a Meso-NH netCDF4 group name
+
+ var_name : str
+ a Meso-NH netCDF4 variable name
+
+ get_data_only : bool, default: True
+ if True, the function returns Dvar as masked_array (only data)
+ if False, the function returns Dvar as netCDF4._netCDF4.Variable
+
+ del_empty_dim : bool, default: True
+ if get_data_only=True and del_empty_dim=True, returns Dvar as an array without dimensions with size 1 and 0
+ e.g. : an array of dimensions (time_budget, cart_level, cart_nj, cart_ni) with shape (180,1,50,1) is returned (180,50)
+
+ removeHALO : bool, default: True
+ if True, remove first and last (NHALO=1) point [1:-1] if get_data_only=True on each
+ level, level_w, ni, ni_u, ni_v, nj, nj_u, nj_v dimensions
+
+ Returns
+ -------
+ Dvar : Dict
+ Dvar['var_name'] if the group contains only one variable
+ Dvar[('group_name','var_name')] if the group contains more than one variable
+ """
+ try:
+ var_dim = theFile[group_name].variables[var_name].ndim
+ var_dim_name = theFile[group_name].variables[var_name].dimensions
except:
- pass
+ raise KeyError("Group and variable name not found in the file, check the group/variable name with ncdump -h YourMNHFile.000.nc. You asked for group/variable : " + group_name + var_name)
- for var in Dvar_input[ifile]: #For each files
- suffix, var_name = remove_PROC(var)
- n_dim = theFile.variables[var].ndim
- name_dim = theFile.variables[var].dimensions
+ if not get_data_only:
+ Dvar[(group_name,var_name)] = theFile[group_name].variables[var_name]
+ else:
+ if var_dim == 0:
+ Dvar[(group_name,var_name)] = theFile[group_name].variables[var_name][0].data
+ if var_dim == 1:
+ Dvar[(group_name,var_name)] = theFile[group_name].variables[var_name][:]
+ elif var_dim == 2:
+ Dvar[(group_name,var_name)] = theFile[group_name].variables[var_name][:,:]
+ elif var_dim == 3:
+ Dvar[(group_name,var_name)] = theFile[group_name].variables[var_name][:,:,:]
+ elif var_dim == 4:
+ Dvar[(group_name,var_name)] = theFile[group_name].variables[var_name][:,:,:,:]
+ elif var_dim == 5:
+ Dvar[(group_name,var_name)] = theFile[group_name].variables[var_name][:,:,:,:,:]
+ elif var_dim == 6:
+ Dvar[(group_name,var_name)] = theFile[group_name].variables[var_name][:,:,:,:,:,:]
+ elif var_dim == 7:
+ Dvar[(group_name,var_name)] = theFile[group_name].variables[var_name][:,:,:,:,:,:,:]
+ if removeHALO:
+ for i in range(8):
+ try:
+ if var_dim_name[i]=='level' or var_dim_name[i]=='level_w' or \
+ var_dim_name[i]=='ni' or var_dim_name[i]=='ni_u' or var_dim_name[i]=='ni_v' or \
+ var_dim_name[i]=='nj' or var_dim_name[i]=='nj_u' or var_dim_name[i]=='nj_v':
+ if var_dim != 0:
+ Dvar[(group_name,var_name)] = removetheHALO(i+1, Dvar[(group_name,var_name)])
+ except:
+ break
+ if del_empty_dim:
+ Ldimtosqueeze=[]
+ var_shape = Dvar[(group_name,var_name)].shape
+ for i in range(8):
+ try:
+ if var_shape[i]==1: Ldimtosqueeze.append(i)
+ except IndexError:
+ break
+ Ldimtosqueeze=tuple(Ldimtosqueeze)
+ Dvar[(group_name,var_name)] = np.squeeze(Dvar[(group_name,var_name)], axis=Ldimtosqueeze)
+
+ # LES budget, ZTSERIES needs to be transposed to use psection functions without specifying .T each time
+ if 'LES_budget' in group_name or 'ZTSERIES' in group_name or 'XTSERIES' in group_name:
+ Dvar[(group_name,var_name)] = Dvar[(group_name,var_name)].T
+ return Dvar
- # First, test if the variable is a dimension/coordinate variable
- if (n_dim ==0): # Scalaires variable
- Dvar_output[ifile][var] = theFile.variables[var][0].data
- pass
- elif n_dim == 1:
- Dvar_output[ifile][var_name] = theFile.variables[var][1:-1] # By default, the Halo is always removed because is not in the other variables in any .000 variable
- pass
- elif n_dim == 2:
- Lsize1 = list_size1(n_dim, name_dim)
- if Lsize1 == [True, False]: Dvar_output[ifile][var_name] = theFile.variables[var][0,1:-1]
- pass
+def read_BACKUPfile(theFile, Dvar_input, Dvar, get_data_only=True, del_empty_dim=True, removeHALO=True):
+ """Read variables from Meso-NH MASDEV >= 5.5.0 synchronous file
+ For all variables in Dvar_input of one file, call functions to read the variable of the group+variable
+
+ Parameters
+ ----------
+ theFile : netCDF4._netCDF4.Dataset
+ a Meso-NH diachronic netCDF4 file
- Lsize1 = list_size1(n_dim, name_dim)
- if Lsize1 == [True, False, False, True, True]: Dvar_output[ifile][var_name] = theFile.variables[var][0,:,:,0,0].T # Need to be transposed here
- if Lsize1 == [True, True, False, True, False]: Dvar_output[ifile][var_name] = theFile.variables[var][0,0,:,0,:]
-
- return Dvar_output #Return the dic of [files][variables]
+ Dvar_input : Dict{'var_name',('group_name','var_name')}
+ with
+ 'var_name' is the exact str of the netCDF4 variable name
+ ('group_name','var_name') is the exact tuple of the (sub-)groups name and the netCDF4 variable name
+ e.g. : {'f1':['ZS', 'WT','ni', 'level'],
+ 'f2':[('/LES_budgets/Cartesian/Not_time_averaged/Not_normalized/cart/',MEAN_TH'),('/Budgets/RI','AVEF')]
+ }
+
+ get_data_only: bool, default: True
+ if True, the function returns Dvar as masked_array (only data)
+ if False, the function returns Dvar as netCDF4._netCDF4.Variable
+
+ del_empty_dim: bool, default: True
+ if get_data_only=True and del_empty_dim=True, returns Dvar as masked_array without dimensions with size 1 and 0
+ e.g. : an array of dimensions (time_budget, cart_level, cart_nj, cart_ni) with shape (180,1,50,1) is returned (180,50)
+
+ Returns
+ -------
+ Dvar : Dict
+ Dvar['var_name'] if the group contains only one variable
+ Dvar[('group_name','var_name')] if the group contains more than one variable
+ """
+ # Reading date since beginning of the model run
+ Dvar['time'] = theFile.variables['time'][0]
+ Dvar['date'] = nc.num2date(Dvar['time'],units=theFile.variables['time'].units, calendar = theFile.variables['time'].calendar)
+
+ for var in Dvar_input:
+ if type(var) == tuple:
+ Dvar = read_from_group(theFile, Dvar, var[0], var[1], get_data_only, del_empty_dim, removeHALO)
+ else:
+ Dvar = read_var(theFile, Dvar, var, get_data_only, del_empty_dim, removeHALO)
+
+ # For all variables except scalars, change Fill_Value to NaN
+ Dvar[var]= np.where(Dvar[var] != -99999.0, Dvar[var], np.nan)
+ Dvar[var]= np.where(Dvar[var] != 999.0, Dvar[var], np.nan)
+ return Dvar
-def read_TIMESfiles_55(theFile, ifile, Dvar_input, Dvar_output, removeHALO=False):
- """
- Read variables from MNH MASDEV >= 5.5.0
- Parameters :
- - Dvar_input : dictionnary of {file : var}. var can be either
- - a string = the variable name
- - or a tuple of ('group_name','var_name')
- If the variable desired is in a group_name and the group_name is not specified, it is assumed group_name = variable_name
- except for specific variable as (cart, neb, clear, cs1, cs2, cs3) type
- Return :
- Dvar_output : dictionnary of Dvar_output[ifile][variables or tuple (group,variables) if the user specified a tuple]
- """
- Dvar_output[ifile] = {} #initialize dic for each files
- def read_var(theFile, Dvar_output, var):
- suffix, var_name = remove_PROC(var)
- try: # NetCDF4 Variables
- n_dim = theFile.variables[var_name].ndim
- # First, test if the variable is a dimension/coordinate variable
- if (n_dim ==0): # Scalaires variable
- Dvar_output[var_name] = theFile.variables[var_name][0].data
- else:
- if(removeHALO):
- if n_dim == 1:
- Dvar_output[var_name] = theFile.variables[var_name][1:-1]
- elif n_dim == 2:
- Dvar_output[var_name] = theFile.variables[var_name][1:-1,1:-1]
- else:
- raise NameError("Lecture des variables de dimension sup a 2 pas encore implementees pour fichiers .000")
- else:
- if n_dim == 1:
- Dvar_output[var_name] = theFile.variables[var_name][:]
- elif n_dim == 2:
- Dvar_output[var_name] = theFile.variables[var_name][:,:]
- else:
- raise NameError("Lecture des variables de dimension sup a 2 pas encore implementees pour fichiers .000")
- except KeyError: # NetCDF4 Group not specified by the user
- if '(cart)' in var_name or '(neb)' in var_name or '(clear)' in var_name or '(cs1)' in var_name or '(cs2)' in var_name or '(cs3)' in var_name or 'AVEF' in suffix or 'INIF' in suffix or 'ENDF' in suffix:
- # If users specify the complete variable name with averaging type
- group_name = get_group_from_varname(var_name)
- else:
- group_name = var_name
- read_from_group(theFile, Dvar_output, group_name, var)
- return Dvar_output
+def read_TIMESfiles_55(theFile, Dvar_input, Dvar, get_data_only=True, del_empty_dim=True, removeHALO=True):
+ """Read variables from Meso-NH MASDEV >= 5.5.0 diachronic file
+ For all variables in Dvar_input of one file, call functions to read the variable of the group+variable
- def read_from_group(theFile, Dvar_output, group_name, var):
- """
- Read variables from MNH MASDEV >= 5.5.0
- Parameters :
- - var : the variable name
- - group_name : the group name
- Return :
- Dvar_output : dictionnary of :
- - Dvar_output[ifile]['var_name'] if the group contains only one variable
- - Dvar_output[ifile][('group_name','var_name'] if the group contains more than one variable
- """
- if '___' in var:
- suffix, var_name = remove_PROC(var)
- else:
- suffix = var
- var_name = var
- if group_name == 'TSERIES' or group_name =='AVION': #always 1D
- Dvar_output[(group_name,var)] = theFile.groups[group_name].variables[var][:]
- elif group_name == 'ZTSERIES' or group_name =='AVIONZ': #always 2D
- Dvar_output[(group_name,var)] = theFile.groups[group_name].variables[var][:,:].T
- elif 'XTSERIES' in group_name: #always 2D
- Dvar_output[(group_name,var)] = theFile.groups[group_name].variables[var][:,:].T
- elif theFile.groups[group_name].type == 'TLES' : # LES type
- try: #By default, most variables read are 2D cart and user does not specify it in the variable name
- whites = ' '*(17 - len('(cart)') - len(var_name))
- Dvar_output[var] = theFile.groups[var].variables[var + whites + '(cart)'][:,:].T
- except:
- try: #Variable 3D sv,time_les, level_les
- Dvar_output[var] = theFile.groups[group_name].variables[var][:,:,:]
- except:
- try: #Variable 2D with type of variable specified (cart, neb, clear, cs1, cs2, cs3)
- Dvar_output[var] = theFile.groups[group_name].variables[var][:,:].T
- except ValueError: # Variable 1D
- Dvar_output[var] = theFile.groups[group_name].variables[var][:]
- elif theFile.groups[group_name].type == 'CART': # Budget CART type
- shapeVar = theFile.groups[group_name].variables[suffix].shape
- Ltosqueeze=[] # Build a tuple with the number of the axis which are 0 dimensions to be removed by np.squeeze
- if shapeVar[0]==1: Ltosqueeze.append(0)
- if shapeVar[1]==1: Ltosqueeze.append(1)
- if shapeVar[2]==1: Ltosqueeze.append(2)
- if shapeVar[3]==1: Ltosqueeze.append(3)
- Ltosqueeze=tuple(Ltosqueeze)
- if len(theFile.groups[group_name].variables.keys()) > 1: # If more than one variable in the group
- Dvar_output[(group_name,var)] = np.squeeze(theFile.groups[group_name].variables[suffix][:,:,:,:], axis=Ltosqueeze)
- else:
- Dvar_output[group_name] = np.squeeze(theFile.groups[group_name].variables[suffix][:,:,:,:], axis=Ltosqueeze)
- elif theFile.groups[group_name].type == 'MASK': # Budget MASK type
- shapeVar = theFile.groups[group_name].variables[suffix].shape
- Ltosqueeze=[] # Build a tuple with the number of the axis which are 0 dimensions to be removed by np.squeeze
- if shapeVar[0]==1: Ltosqueeze.append(0)
- if shapeVar[1]==1: Ltosqueeze.append(1)
- if shapeVar[2]==1: Ltosqueeze.append(2)
- Ltosqueeze=tuple(Ltosqueeze)
- if len(theFile.groups[group_name].variables.keys()) > 1: # If more than one variable in the group
- Dvar_output[(group_name,var)] = np.squeeze(theFile.groups[group_name].variables[suffix][:,:,:], axis=Ltosqueeze).T
- else:
- Dvar_output[group_name] = np.squeeze(theFile.groups[group_name].variables[suffix][:,:,:], axis=Ltosqueeze).T
- else:
- raise NameError("Type de groups variables not implemented in read_MNHfile.py")
- return Dvar_output
- for var in Dvar_input[ifile]: #For each var
+ Parameters
+ ----------
+ theFile : netCDF4._netCDF4.Dataset
+ a Meso-NH diachronic netCDF4 file
+
+ Dvar_input : Dict{'var_name',('group_name','var_name')}
+ with
+ 'var_name' is the exact str of the netCDF4 variable name
+ ('group_name','var_name') is the exact tuple of the (sub-)groups name and the netCDF4 variable name
+ e.g. : {'f1':['ZS', 'WT','ni', 'level'],
+ 'f2':[('/LES_budgets/Cartesian/Not_time_averaged/Not_normalized/cart/',MEAN_TH'),('/Budgets/RI','AVEF')]
+ }
+
+ get_data_only: bool, default: True
+ if True, the function returns Dvar as masked_array (only data)
+ if False, the function returns Dvar as netCDF4._netCDF4.Variable
+
+ del_empty_dim: bool, default: True
+ if get_data_only=True and del_empty_dim=True, returns Dvar as masked_array without dimensions with size 1 and 0
+ e.g. : an array of dimensions (time_budget, cart_level, cart_nj, cart_ni) with shape (180,1,50,1) is returned (180,50)
+
+ Returns
+ -------
+ Dvar : Dict
+ Dvar[ifile]['var_name'] if the group contains only one variable
+ Dvar[ifile][('group_name','var_name')] if the group contains more than one variable
+ """
+ for var in Dvar_input:
+ print(var)
if type(var) == tuple:
- Dvar_output[ifile] = read_from_group(theFile, Dvar_output[ifile], var[0], var[1])
+ Dvar = read_from_group(theFile, Dvar, var[0], var[1], get_data_only, del_empty_dim, removeHALO)
else:
- Dvar_output[ifile] = read_var(theFile, Dvar_output[ifile], var)
-
- return Dvar_output #Return the dic of [files][variables]
+ Dvar = read_var(theFile, Dvar, var, get_data_only, del_empty_dim, removeHALO)
+ return Dvar
-def list_size1(n_dim, named_dim):
- Lsize1 = []
- for i in range(n_dim):
- if 'size1' == named_dim[i]:
- Lsize1.append(True)
- else:
- Lsize1.append(False)
- return Lsize1
+def removetheHALO(idim, var):
+ """Remove a NHALO=1 point [1:-1] at a given dimension idim of a variable var
-def remove_PROC(var):
- if '___PROC' in var:
- var_name = var[:-8]
- suffix = "" # No need of suffix for MNHVERSION < 550 (suffix is for NetCDF4 group)
- elif '___ENDF' in var or '___INIF' in var or '___AVEF' in var:
- var_name = var[:-7]
- suffix = var[-4:]
- else:
- var_name = var
- suffix = ''
- return suffix, var_name
-
-def get_group_from_varname(var):
- group_name=''
- if '___ENDF' in var or '___INIF' in var or '___AVEF' in var: #Variable CART
- suff, group_name = remove_PROC(var)
- else: #Variable with whites in names ex: 'MEAN_TH (cart)'
- for i in range(len(var)):
- if var[i] != ' ':
- group_name+=var[i]
- else: # As soon as the caracter is a blank, the group variable is set
- break
- return group_name
+ Parameters
+ ----------
+ idim: int
+ the dimension over which remove the first and last point
+
+ var: array
+ a Meso-NH netCDF4 variable name
+
+ Returns
+ -------
+ var : array
+ """
+ if idim == 1:
+ var = var[1:-1]
+ elif idim == 2:
+ var = var[:,1:-1]
+ elif idim == 3:
+ var = var[:,:,1:-1]
+ elif idim == 4:
+ var = var[:,:,:,1:-1]
+ elif idim == 5:
+ var = var[:,:,:,:,1:-1]
+ elif idim == 6:
+ var = var[:,:,:,:,:,1:-1]
+ elif idim == 7:
+ var = var[:,:,:,:,:,:,1:-1]
+ return var
diff --git a/src/LIB/RAD/ecrad-1.4.0.tar.gz b/src/LIB/RAD/ecrad-1.4.0.tar.gz
new file mode 100644
index 0000000000000000000000000000000000000000..23aca40b30fbe71caff28e98f33314d2d78f1be5
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0.tar.gz
@@ -0,0 +1,3 @@
+version https://git-lfs.github.com/spec/v1
+oid sha256:2fa92987214bde44613d682de4440caf766dc00b6cc04a3903afb62588e3ca0a
+size 8968642
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/MNH/ch_monitorn.f90 b/src/MNH/ch_monitorn.f90
index d1ac4a1a677008440dbdc542935e1b083af2a00c..6e817aa0f12bc2c3c1aba44cdd08c812eabc000e 100644
--- a/src/MNH/ch_monitorn.f90
+++ b/src/MNH/ch_monitorn.f90
@@ -609,10 +609,15 @@ ZDTSOLVER = PTSTEP / NCH_SUBSTEPS
!
IF (LORILAM) THEN
ALLOCATE( ZSVT(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),SIZE(XSVT,4)) )
-
- DO JSV = 1, SIZE(XSVT,4)
- ZSVT(:,:,:,JSV) = XRSVS(:,:,:,JSV) *PTSTEP / XRHODJ(:,:,:)
- END DO
+ IF (CPROGRAM /='DIAG ') THEN
+ DO JSV = 1, SIZE(XSVT,4)
+ ZSVT(:,:,:,JSV) = XRSVS(:,:,:,JSV) *PTSTEP / XRHODJ(:,:,:)
+ END DO
+ ELSE
+ DO JSV = 1, SIZE(XSVT,4)
+ ZSVT(:,:,:,JSV) = XSVT(:,:,:,JSV)
+ END DO
+ END IF
ZSVT(:,:,:,NSV_CHEMBEG:NSV_CHEMEND) = MAX(ZSVT(:,:,:,NSV_CHEMBEG:NSV_CHEMEND), XMNH_TINY)
ZSVT(:,:,:,NSV_AERBEG:NSV_AEREND) = MAX(ZSVT(:,:,:,NSV_AERBEG:NSV_AEREND), XMNH_TINY)
!
@@ -640,9 +645,7 @@ SELECT CASE (CCH_TDISCRETIZATION)
END SELECT
!
!
-IF (CPROGRAM=='DIAG ') THEN
- IF (LEN_TRIM(CSPEC_BU_DIAG)/=0.OR.LEN_TRIM(CSPEC_DIAG)/=0) GSPLIT=.FALSE. ! Modif. for DIAG
-END IF
+IF (CPROGRAM=='DIAG ') GSPLIT=.FALSE. ! Modif. for DIAG
!
!
!* 1.6 allocate tables
diff --git a/src/MNH/default_desfmn.f90 b/src/MNH/default_desfmn.f90
index a5d28030d88c7706332d98de04f7db63a7659678..cba4613595bd3934761d3e9d015871396668fdf3 100644
--- a/src/MNH/default_desfmn.f90
+++ b/src/MNH/default_desfmn.f90
@@ -95,7 +95,8 @@ END MODULE MODI_DEFAULT_DESFM_n
!! Module MODD_FRC :
!!
!! LGEOST_UV_FRC,LGEOST_TH_FRC,LTEND_THRV_FRC
-!! LVERT_MOTION_FRC,LRELAX_THRV_FRC,LRELAX_UV_FRC,XRELAX_TIME_FRC
+!! LVERT_MOTION_FRC,LRELAX_THRV_FRC,LRELAX_UV_FRC,LRELAX_UVMEAN_FRC,
+!! XRELAX_TIME_FRC
!! XRELAX_HEIGHT_FRC,CRELAX_HEIGHT_TYPE,LTRANS,XUTRANS,XVTRANS,
!! LPGROUND_FRC
!!
@@ -216,6 +217,8 @@ END MODULE MODI_DEFAULT_DESFM_n
! JL Redelsperger 06/2021: add parameters allowing to active idealized oceanic convection
! B. Vie 06/2021: add prognostic supersaturation for LIMA
! Q. Rodier 06/2021: modify default value to LGZ=F (grey-zone corr.), LSEDI and OSEDC=T (LIMA sedimentation)
+! F. Couvreux 06/2021: add LRELAX_UVMEAN_FRC
+! Q. Rodier 07/2021: modify XPOND=1
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -241,6 +244,9 @@ USE MODD_LES
USE MODD_PARAM_RAD_n
#ifdef MNH_ECRAD
USE MODD_PARAM_ECRAD_n
+#if ( VER_ECRAD == 140 )
+USE MODD_RADIATIONS_n , ONLY : NSWB_MNH, NLWB_MNH
+#endif
#endif
USE MODD_BLANK_n
USE MODD_FRC
@@ -497,7 +503,7 @@ NLBLY(:) = 1
XCPHASE = 20.
XCPHASE_PBL = 0.
XCARPKMAX = XUNDEF
-XPOND = 0.2
+XPOND = 1.0
!
!-------------------------------------------------------------------------------
!
@@ -721,8 +727,27 @@ LFIX_DAT=.FALSE.
!* 13bis. SET DEFAULT VALUES FOR MODD_PARAM_ECRAD_n :
! ---------------------------------------
!
+#if ( VER_ECRAD == 101 )
NSWSOLVER = 0 ! 0: 'McICA 1: 'SPARTACUS' 2: 'SPARTACUS' + 3D effect
NLWSOLVER = 0 ! 0: 'McICA 1: 'SPARTACUS' 2: 'SPARTACUS' + 3D effect
+#endif
+#if ( VER_ECRAD == 140 )
+LSPEC_ALB = .FALSE.
+LSPEC_EMISS = .FALSE.
+
+
+!ALLOCATE(USER_ALB_DIFF(NSWB_MNH))
+!ALLOCATE(USER_ALB_DIR(NSWB_MNH))
+!ALLOCATE(USER_EMISS(NLWB_MNH))
+!PRINT*,USER_ALB_DIFF
+!USER_ALB_DIFF = (/0,0,0,0,0,0,0,0,0,0,0,0,0,0/)
+!USER_ALB_DIR = (/0,0,0,0,0,0,0,0,0,0,0,0,0,0/)
+!USER_EMISS = (/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0/)
+SURF_TYPE="SNOW"
+
+NLWSOLVER = 1 ! 0: 'McICA 1: 'SPARTACUS' 2: 'SPARTACUS' + 3D effect
+NSWSOLVER = 1 ! 0: 'McICA 1: 'SPARTACUS' 2: 'SPARTACUS' + 3D effect
+#endif
! LEFF3D = .TRUE.
! LSIDEM = .TRUE.
NREG = 3 ! Number of cloudy regions (3=TripleClouds)
@@ -796,6 +821,7 @@ IF (KMI == 1) THEN
LVERT_MOTION_FRC = .FALSE.
LRELAX_THRV_FRC = .FALSE.
LRELAX_UV_FRC = .FALSE.
+ LRELAX_UVMEAN_FRC = .FALSE.
XRELAX_TIME_FRC = 10800.
XRELAX_HEIGHT_FRC = 0.
CRELAX_HEIGHT_TYPE = "FIXE"
diff --git a/src/MNH/forcing.f90 b/src/MNH/forcing.f90
index 062cd4afa4cd7221157c6e5e550a96145bc38730..04a4a91cd280cb170667db196631e49d3b3d9d88 100644
--- a/src/MNH/forcing.f90
+++ b/src/MNH/forcing.f90
@@ -149,6 +149,7 @@ END MODULE MODI_FORCING
! use overloaded comparison operator for date_time
! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! F. Couvreux 06/2021: add LRELAX_UVMEAN_FRC : relaxation applied to the horizontal avg. wind (for LES)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -169,9 +170,13 @@ USE MODD_TIME
!
use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_DATETIME
+USE MODE_GATHER_ll
USE MODE_MSG
+USE MODE_ll
+USE MODE_REPRO_SUM
!
USE MODI_GET_HALO
+USE MODI_LES_MEAN_ll
USE MODI_SHUMAN
USE MODI_UPSTREAM_Z
!
@@ -209,6 +214,9 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PJ
!* 0.2 Declarations of local variables
!
INTEGER :: IIU, IJU, IKU ! dimensions
+INTEGER :: IIB,IJB,IIE,IJE ! physical domain dimensions
+INTEGER :: IKB, IKE !
+INTEGER :: IIMAX_ll,IJMAX_ll
INTEGER, SAVE :: JSX ! saved loop index
INTEGER :: JI, JJ, JK, JL, JXP! loop indexes
!
@@ -248,11 +256,18 @@ INTEGER :: IRESP ! Return code of FM-routines
!
LOGICAL,DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: GRELAX_MASK_FRC
!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZUMEAN, ZVMEAN
+REAL :: ZTEMPU, ZTEMPV
+!
!----------------------------------------------------------------------------
!
IIU=SIZE(PUT,1)
IJU=SIZE(PUT,2)
IKU=SIZE(PUT,3)
+IKE = SIZE(PUT,3) - JPVEXT
+IKB = 1 + JPVEXT
+CALL GET_INDICE_ll( IIB,IJB,IIE,IJE)
+CALL GET_GLOBALDIMS_ll ( IIMAX_ll,IJMAX_ll)
!
ILUOUT0 = TLUOUT0%NLU
@@ -479,6 +494,8 @@ ALLOCATE(ZDUF(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)))
ALLOCATE(ZDVF(SIZE(PVT,1),SIZE(PVT,2),SIZE(PVT,3)))
ALLOCATE(ZTENDUF(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)))
ALLOCATE(ZTENDVF(SIZE(PVT,1),SIZE(PVT,2),SIZE(PVT,3)))
+ALLOCATE(ZUMEAN(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)))
+ALLOCATE(ZVMEAN(SIZE(PVT,1),SIZE(PVT,2),SIZE(PVT,3)))
!
IF (LFLAT) THEN
!
@@ -782,7 +799,7 @@ PVFRC_PAST(:,:,:) = ZVF(:,:,:)
!
!* 4.4 integration of the thermal, moisture and wind relaxation
!
-IF( LRELAX_THRV_FRC .OR. LRELAX_UV_FRC ) THEN
+IF( LRELAX_THRV_FRC .OR. LRELAX_UV_FRC .OR. LRELAX_UVMEAN_FRC) THEN
!
ZDZZ(:,:,:) = DZM(MZF(PZZ(:,:,:)))
ZDZZ(:,:,IKU) = PZZ(:,:,IKU) - PZZ(:,:,IKU-1)
@@ -837,6 +854,25 @@ IF( LRELAX_THRV_FRC .OR. LRELAX_UV_FRC ) THEN
END WHERE
!
END IF
+!
+ IF ( LRELAX_UVMEAN_FRC ) THEN
+ DO JK=IKB,IKE
+ ZTEMPU=SUM_DD_R2_ll(PUT(IIB:IIE,IJB:IJE,JK))/REAL(IIMAX_ll*IJMAX_ll)
+ ZUMEAN(:,:,JK) = ZTEMPU
+ ZTEMPV=SUM_DD_R2_ll(PVT(IIB:IIE,IJB:IJE,JK))/REAL(IIMAX_ll*IJMAX_ll)
+ ZVMEAN(:,:,JK) = ZTEMPV
+ END DO
+!
+! apply UV relaxation on the horizontal-average value of UV
+!
+ WHERE( GRELAX_MASK_FRC )
+ PRUS(:,:,:) = PRUS(:,:,:) - MXM(PRHODJ(:,:,:))*(ZUMEAN(:,:,:)-ZUF(:,:,:)) &
+ / XRELAX_TIME_FRC
+ PRVS(:,:,:) = PRVS(:,:,:) - MYM(PRHODJ(:,:,:))*(ZVMEAN(:,:,:)-ZVF(:,:,:)) &
+ / XRELAX_TIME_FRC
+ END WHERE
+!
+ END IF
!
END IF
!
@@ -891,6 +927,8 @@ DEALLOCATE(ZDZZ)
DEALLOCATE(ZRWCF)
DEALLOCATE(ZDUF)
DEALLOCATE(ZDVF)
+DEALLOCATE(ZUMEAN)
+DEALLOCATE(ZVMEAN)
!
!----------------------------------------------------------------------------
!
diff --git a/src/MNH/ini_modeln.f90 b/src/MNH/ini_modeln.f90
index b58702a5417dbb08559eb8afb026e01796c94e1e..48b3a7348e239e3db4e139c6687184d781a7365c 100644
--- a/src/MNH/ini_modeln.f90
+++ b/src/MNH/ini_modeln.f90
@@ -470,6 +470,11 @@ USE MODI_SUNPOS_n
USE MODI_SURF_SOLAR_GEOM
USE MODI_UPDATE_METRICS
USE MODI_UPDATE_NSV
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+USE YOERDI , ONLY :RCCO2
+#endif
+#endif
!
IMPLICIT NONE
!
@@ -566,6 +571,12 @@ IF (CCLOUD == 'LIMA') THEN
LHORELAX_SVC1R3=LHORELAX_SVLIMA
END IF
!
+! UPDATE CONSTANTS FOR OCEAN MODEL
+IF (LOCEAN) THEN
+ XP00=XP00OCEAN
+ XTH00=XTH00OCEAN
+END IF
+!
!
NULLIFY(TZINITHALO2D_ll)
NULLIFY(TZINITHALO3D_ll)
@@ -1438,15 +1449,31 @@ END IF
! Initialization of SW bands
NSWB_OLD = 6 ! Number of bands in ECMWF original scheme (from Fouquart et Bonnel (1980))
! then modified through INI_RADIATIONS_ECMWF but remains equal to 6 practically
+
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+NLWB_OLD = 16 ! For XEMIS initialization (should be spectral in the future)
+#endif
+#endif
+
+NLWB_MNH = 16 ! For XEMIS initialization (should be spectral in the future)
+
IF (CRAD == 'ECRA') THEN
NSWB_MNH = 14
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+ NLWB_MNH = 16
+#endif
+#endif
ELSE
NSWB_MNH = NSWB_OLD
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+ NLWB_MNH = NLWB_OLD
+#endif
+#endif
END IF
-NLWB_MNH = 16 ! For XEMIS initialization (should be spectral in the future)
-
-
ALLOCATE(XSW_BANDS (NSWB_MNH))
ALLOCATE(XLW_BANDS (NLWB_MNH))
ALLOCATE(XZENITH (IIU,IJU))
diff --git a/src/MNH/ini_posprofilern.f90 b/src/MNH/ini_posprofilern.f90
index 21894be24fba16d29538814eda120b48e9894bcc..7d5a3cd0df45721c88374309b73a19e9a79c2e70 100644
--- a/src/MNH/ini_posprofilern.f90
+++ b/src/MNH/ini_posprofilern.f90
@@ -65,6 +65,7 @@ END MODULE MODI_INI_POSPROFILER_n
!! C.Lac 10/2016 Add visibility diagnostic
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! M.Taufour : modify RARE for hydrometeors containing ice and add bright band calculation for RARE
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -173,7 +174,11 @@ ALLOCATE(TPROFILER%THV (ISTORE,IKU,NUMBPROFILER))
ALLOCATE(TPROFILER%RHOD (ISTORE,IKU,NUMBPROFILER))
ALLOCATE(TPROFILER%VISI (ISTORE,IKU,NUMBPROFILER))
ALLOCATE(TPROFILER%VISIKUN(ISTORE,IKU,NUMBPROFILER))
-ALLOCATE(TPROFILER%RARE (ISTORE,IKU,NUMBPROFILER))
+ALLOCATE(TPROFILER%CRARE (ISTORE,IKU,NUMBPROFILER))
+ALLOCATE(TPROFILER%CRARE_ATT (ISTORE,IKU,NUMBPROFILER))
+ALLOCATE(TPROFILER%LWCZ (ISTORE,IKU,NUMBPROFILER))
+ALLOCATE(TPROFILER%IWCZ (ISTORE,IKU,NUMBPROFILER))
+ALLOCATE(TPROFILER%CIZ (ISTORE,IKU,NUMBPROFILER))
ALLOCATE(TPROFILER%R (ISTORE,IKU,NUMBPROFILER,KRR))
ALLOCATE(TPROFILER%SV (ISTORE,IKU,NUMBPROFILER,KSV))
ALLOCATE(TPROFILER%AER (ISTORE,IKU,NUMBPROFILER,NAER))
@@ -216,7 +221,11 @@ TPROFILER%THV = XUNDEF
TPROFILER%RHOD = XUNDEF
TPROFILER%VISI = XUNDEF
TPROFILER%VISIKUN = XUNDEF
-TPROFILER%RARE = XUNDEF
+TPROFILER%CRARE = XUNDEF
+TPROFILER%CRARE_ATT = XUNDEF
+TPROFILER%LWCZ = XUNDEF
+TPROFILER%IWCZ = XUNDEF
+TPROFILER%CIZ = XUNDEF
TPROFILER%IWV = XUNDEF
TPROFILER%ZTD = XUNDEF
TPROFILER%ZWD = XUNDEF
diff --git a/src/MNH/ini_radiations_ecrad.f90 b/src/MNH/ini_radiations_ecrad.f90
index 6b3fdd2f29a1ccbc12b22ffb546171d5948c1781..be2571b921452e8dcaea3888d809919b532c62d1 100644
--- a/src/MNH/ini_radiations_ecrad.f90
+++ b/src/MNH/ini_radiations_ecrad.f90
@@ -165,9 +165,14 @@ LCCNO = .FALSE. ! True if CCN over sea is diagnosed
! Constant cloud condensation nuclei over land and sea
! In ECMWF original code, those values were 900 and 150
+#if ( VER_ECRAD == 101 )
XCCNLND = 900_JPRB ! constant CCN over land in m-3 (needed for Martin et al., 1994 parameterization)
XCCNSEA = 50_JPRB ! constant CCN over sea in m-3
-
+#endif
+#if ( VER_ECRAD == 140 )
+XCCNLND = 900_JPRB ! constant CCN over land in cm-3 (needed for Martin et al., 1994 parameterization)
+XCCNSEA = 50_JPRB ! constant CCN over sea in cm-3 (IFS value, 150 originally in MNH)
+#endif
! NAERMACC is in the namelist
! NAERMACC = 0 -> Use of Tegen aerosol climatology
! NAERMACC = 1 -> Use of MACC aerosol classification
@@ -216,6 +221,12 @@ RCCFC12 = 484.E-12_JPRB
RCCFC22 = 0.E-12_JPRB
RCCCL4 = 0.E-12_JPRB
+#if ( VER_ECRAD == 140 )
+USER_ALB_DIFF(:) = 0.5
+USER_ALB_DIR(:) = 0
+USER_EMISS(:) = 1
+#endif
+
! Radiation computed every NRADFR timesteps
NRADFR = INT(XDTRAD/XTSTEP)
diff --git a/src/MNH/init_mnh.f90 b/src/MNH/init_mnh.f90
index 9fe0836d00fcc2caa41a735c227bcfba2aa610e1..d2d7b194949ee3f1a8c7829c3022d5e439134462 100644
--- a/src/MNH/init_mnh.f90
+++ b/src/MNH/init_mnh.f90
@@ -76,8 +76,7 @@
!* 0. DECLARATIONS
! ------------
USE MODD_CONF
-USE MODD_CST, ONLY: XP00, XTH00, XP00OCEAN, XTH00OCEAN
-USE MODD_DYN_n, ONLY: CPRESOPT, NITR, LOCEAN ! only for spawning purpose
+USE MODD_DYN_n, ONLY: CPRESOPT, NITR ! only for spawning purpose
USE MODD_IO, ONLY: TFILE_OUTPUTLISTING, TPTR2FILE
USE MODD_LBC_n, ONLY: CLBCX,CLBCY ! only for spawning purpose
USE MODD_LUNIT
@@ -181,13 +180,6 @@ END IF
!
IF (CPROGRAM=='DIAG') CALL RESET_EXSEG()
!
-! UPDATE CONSTANTS FOR OCEAN MODEL
-DO JMI=1,JPMODELMAX
- IF (LOCEAN) THEN
- XP00=XP00OCEAN
- XTH00=XTH00OCEAN
- END IF
-END DO
!-------------------------------------------------------------------------------
!
!
diff --git a/src/MNH/lima_tendencies.f90 b/src/MNH/lima_tendencies.f90
index dd02f8a40357abb83d89b6af8513b2119392f25f..bd98d503c551fc74862ea85aeb1a80795beea2ce 100644
--- a/src/MNH/lima_tendencies.f90
+++ b/src/MNH/lima_tendencies.f90
@@ -525,7 +525,7 @@ IF (LCOLD .AND. LWARM) THEN
PA_TH, PA_RC, PA_CC, PA_RI, PA_CI )
END IF
!
-IF (LWARM) THEN
+IF (LWARM .AND. LRAIN) THEN
CALL LIMA_DROPLETS_SELF_COLLECTION (LDCOMPUTE, & ! depends on CF
PRHODREF, &
PCCT/ZCF1D, ZLBDC3, &
diff --git a/src/MNH/modd_frc.f90 b/src/MNH/modd_frc.f90
index 0627e3f4fcbdfbce2cc1536fc368f73887593acc..91994b803da64a835311586ea0b9d46bf31edfc7 100644
--- a/src/MNH/modd_frc.f90
+++ b/src/MNH/modd_frc.f90
@@ -17,9 +17,9 @@
! and the translation speed of the domain of simulation.
! The following control parameters are used by FORCING:
! - LGEOST_UV_FRC and LGEOST_TH_FRC
-! - LTEND_THRV_FRC
+! - LTEND_THRV_FRC and LTEND_UV_FRC
! - LVERT_MOTION_FRC
-! - LRELAX_THRV_FRC and LRELAX_UV_FRC using:
+! - LRELAX_THRV_FRC, LRELAX_UV_FRC and LRELAX_UVMEAN_FRC using:
! XRELAX_TIME_FRC, XRELAX_HEIGHT_FRC and CRELAX_HEIGHT_TYPE
! - LTRANS
!!
@@ -46,6 +46,7 @@
!! 01/2004 V. Masson surface externalization: removes SST forcing
!! 09/2017 Q.Rodier add LTEND_UV_FRC
!! 03/2021 JL Redelsperger Parameters defining sfc forcing shape for idealized ocean case
+!! 06/2021 F. Couvreux add LRELAX_UVMEAN_FRC
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -88,7 +89,8 @@ LOGICAL, SAVE :: LTEND_UV_FRC ! enables tendency forcing of the wind
LOGICAL, SAVE :: LVERT_MOTION_FRC ! enables prescribed a forced vertical
! transport for all prognostic variables
LOGICAL, SAVE :: LRELAX_THRV_FRC ! enables temp. and humidity relaxation
-LOGICAL, SAVE :: LRELAX_UV_FRC ! enables horizontal wind relaxation
+LOGICAL, SAVE :: LRELAX_UV_FRC ! enables horizontal wind relaxation applied to the full wind field
+LOGICAL, SAVE :: LRELAX_UVMEAN_FRC ! enables horizontal wind relaxation applied to the horiz. avg. wind
!
REAL, SAVE :: XRELAX_TIME_FRC ! e-folding time for relaxation
REAL, SAVE :: XRELAX_HEIGHT_FRC ! height below which relaxation
diff --git a/src/MNH/modd_param_ecradn.f90 b/src/MNH/modd_param_ecradn.f90
index a7bf0b344753be234bbed47285ed5880b1de3018..a984d405b9456ef1f32580a0f373cd5fcc550783 100644
--- a/src/MNH/modd_param_ecradn.f90
+++ b/src/MNH/modd_param_ecradn.f90
@@ -42,6 +42,9 @@
USE MODD_PARAMETERS, ONLY: JPMODELMAX
USE PARKIND1 , ONLY : JPIM,JPRB
#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+USE MODD_RADIATIONS_n , ONLY : NSWB_MNH, NLWB_MNH
+#endif
USE radiation_config, ONLY : config_type
#endif
IMPLICIT NONE
@@ -59,6 +62,18 @@ TYPE PARAM_ECRAD_t
INTEGER(KIND=JPIM) :: NRADIP ! 0: 40 mum, 1: Liou and Ou (1994), 2: Liou and Ou (1994) improved,
! 3: Sun and Rikus (1999)
REAL(KIND=JPRB) :: XCLOUD_FRAC_STD ! Cloud water content horizontal fractional standard deviation in a gridbox
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+ LOGICAL :: LSPEC_ALB
+ LOGICAL :: LSPEC_EMISS
+ REAL(KIND=JPRB), DIMENSION(14) :: USER_ALB_DIFF
+ REAL(KIND=JPRB), DIMENSION(14) :: USER_ALB_DIR
+ REAL(KIND=JPRB), DIMENSION(16) :: USER_EMISS
+
+ CHARACTER (LEN=4) :: SURF_TYPE
+#endif
+#endif
+
INTEGER(KIND=JPIM) :: NLWSCATTERING ! 0: No longwave scattering
! 1: Longwave scattering by clouds only
! 2: Longwave scattering by clouds and aerosols
@@ -192,6 +207,16 @@ REAL(KIND=JPRB), POINTER :: XRMINICE=>NULL()
INTEGER(KIND=JPIM), POINTER :: NMINICE=>NULL()
INTEGER(KIND=JPIM), POINTER :: NDECOLAT=>NULL()
REAL(KIND=JPRB), POINTER :: XCLOUD_FRAC_STD=>NULL()
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+LOGICAL, POINTER :: LSPEC_ALB=>NULL()
+LOGICAL, POINTER :: LSPEC_EMISS=>NULL()
+REAL(KIND=JPRB), DIMENSION(:), POINTER :: USER_ALB_DIFF=>NULL()
+REAL(KIND=JPRB), DIMENSION(:), POINTER :: USER_ALB_DIR=>NULL()
+REAL(KIND=JPRB), DIMENSION(:), POINTER :: USER_EMISS=>NULL()
+CHARACTER(LEN=4), POINTER :: SURF_TYPE
+#endif
+#endif
!INTEGER, POINTER :: NSW=>NULL()
!INTEGER, POINTER :: NSW_EC=>NULL()
REAL(KIND=JPRB), POINTER :: XCCH4=>NULL()
@@ -261,6 +286,16 @@ INTEGER, INTENT(IN) :: KFROM, KTO
NMINICE=>PARAM_ECRAD_MODEL(KTO)%NMINICE
NDECOLAT=>PARAM_ECRAD_MODEL(KTO)%NDECOLAT
XCLOUD_FRAC_STD=>PARAM_ECRAD_MODEL(KTO)%XCLOUD_FRAC_STD
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+ LSPEC_ALB=>PARAM_ECRAD_MODEL(KTO)%LSPEC_ALB
+ LSPEC_EMISS=>PARAM_ECRAD_MODEL(KTO)%LSPEC_EMISS
+ USER_ALB_DIFF=>PARAM_ECRAD_MODEL(KTO)%USER_ALB_DIFF
+ USER_ALB_DIR=>PARAM_ECRAD_MODEL(KTO)%USER_ALB_DIR
+ USER_EMISS=>PARAM_ECRAD_MODEL(KTO)%USER_EMISS
+ SURF_TYPE=>PARAM_ECRAD_MODEL(KTO)%SURF_TYPE
+#endif
+#endif
! NSW=>PARAM_ECRAD_MODEL(KTO)%NSW
! NSW_EC=>PARAM_ECRAD_MODEL(KTO)%NSW_EC
XCCH4=>PARAM_ECRAD_MODEL(KTO)%XCCH4
diff --git a/src/MNH/modd_radiationsn.f90 b/src/MNH/modd_radiationsn.f90
index ec51e9e32cf0b37c8915903f16f156d690234f55..c0953ce5ebdea59995cd0e4c366681fb23580383 100644
--- a/src/MNH/modd_radiationsn.f90
+++ b/src/MNH/modd_radiationsn.f90
@@ -59,6 +59,11 @@ TYPE RADIATIONS_t
INTEGER :: NRAD ! number of satellite radiances to synthesize
INTEGER :: NAER ! number od AERosol classes
INTEGER :: NSWB_OLD ! number of SW bands in ECMWF original code (usually 6)
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+ INTEGER :: NLWB_OLD ! number of LW bands for emissivity original code (usually 2)
+#endif
+#endif
INTEGER :: NSWB_MNH! number of SW bands practically used (14 if ECRAD, NSWB if original code)
INTEGER :: NLWB_MNH! number of LW bands practically used (16 if RRTM)
INTEGER :: NSTATM ! index od the STAndard ATMosphere level just above
@@ -132,6 +137,11 @@ INTEGER, POINTER :: NFLUX=>NULL()
INTEGER, POINTER :: NRAD=>NULL()
INTEGER, POINTER :: NAER=>NULL()
INTEGER, POINTER :: NSWB_OLD=>NULL()
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+INTEGER, POINTER :: NLWB_OLD=>NULL()
+#endif
+#endif
INTEGER, POINTER :: NSWB_MNH=>NULL()
INTEGER, POINTER :: NLWB_MNH=>NULL()
INTEGER, POINTER :: NSTATM=>NULL()
@@ -223,6 +233,11 @@ NFLUX=>RADIATIONS_MODEL(KTO)%NFLUX
NRAD=>RADIATIONS_MODEL(KTO)%NRAD
NAER=>RADIATIONS_MODEL(KTO)%NAER
NSWB_OLD=>RADIATIONS_MODEL(KTO)%NSWB_OLD
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+NLWB_OLD=>RADIATIONS_MODEL(KTO)%NLWB_OLD
+#endif
+#endif
NSWB_MNH=>RADIATIONS_MODEL(KTO)%NSWB_MNH
NLWB_MNH=>RADIATIONS_MODEL(KTO)%NLWB_MNH
NSTATM=>RADIATIONS_MODEL(KTO)%NSTATM
diff --git a/src/MNH/modd_type_profiler.f90 b/src/MNH/modd_type_profiler.f90
index ed00d4799ed5d79f395ebd3a92331bece8b1269e..64cd438eeb9774a852cb89895a4942e7fdea910e 100644
--- a/src/MNH/modd_type_profiler.f90
+++ b/src/MNH/modd_type_profiler.f90
@@ -31,6 +31,7 @@
!! Original 15/01/02
!! C.Lac 10/2016 Add visibility diagnostic
! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! M.Taufour 07/2021: modify RARE for hydrometeors containing ice and add bright band calculation for RARE
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -76,7 +77,11 @@ REAL, DIMENSION(:,:,:), POINTER :: TH=>NULL() ! th(n)
REAL, DIMENSION(:,:,:), POINTER :: THV=>NULL() ! thv(n)
REAL, DIMENSION(:,:,:), POINTER :: VISI=>NULL() ! VISI(n)
REAL, DIMENSION(:,:,:), POINTER :: VISIKUN=>NULL() ! VISI KUNKEL(n)
-REAL, DIMENSION(:,:,:), POINTER :: RARE=>NULL() ! radar reflectivity (n)
+REAL, DIMENSION(:,:,:), POINTER :: CRARE=>NULL() ! radar reflectivity (n)
+REAL, DIMENSION(:,:,:), POINTER :: CRARE_ATT=>NULL() ! radar attenuated reflectivity (n)
+REAL, DIMENSION(:,:,:), POINTER :: CIZ=>NULL() ! Ice number concentration ICE3 (n)
+REAL, DIMENSION(:,:,:), POINTER :: LWCZ=>NULL() ! liquid water content (n)
+REAL, DIMENSION(:,:,:), POINTER :: IWCZ=>NULL() ! ice water content (n)
REAL, DIMENSION(:,:,:), POINTER :: RHOD=>NULL() ! density of dry air/moist air
REAL, DIMENSION(:,:,:,:), POINTER :: R=>NULL() ! r*(n)
REAL, DIMENSION(:,:,:,:), POINTER :: SV=>NULL() ! Sv*(n)
diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90
index 65c7276a94ab388247e25455be1ff89e5e7434fd..ea53387a50a48a98c70ba748a3b1315bbc4f2c74 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -2122,7 +2122,7 @@ IF (LPROFILER) &
CALL PROFILER_n(XTSTEP, &
XXHAT, XYHAT, XZZ,XRHODREF, &
XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, XTSRAD, XPABST, &
- XAER, XCLDFR, XCIT)
+ XAER, XCLDFR, XCIT,PSEA=ZSEA(:,:))
!
!
CALL SECOND_MNH2(ZTIME2)
diff --git a/src/MNH/modn_frc.f90 b/src/MNH/modn_frc.f90
index ae7d5e41dac257a6881440f4d0a291f65794a562..42e04d16e941a48f3483e5e49a5666dd7c0ef953 100644
--- a/src/MNH/modn_frc.f90
+++ b/src/MNH/modn_frc.f90
@@ -14,9 +14,9 @@
! This module contains the following control parameters are used
! by FORCING:
! - LGEOST_UV_FRC and LGEOST_TH_FRC
-! - LTEND_THRV_FRC
-! - LVERT_MOTION_FRC
-! - LRELAX_THRV_FRC and LRELAX_UV_FRC using:
+! - LTEND_THRV_FRC and LTEND_UV_FRC
+! - LVERT_MOTION_FRC
+! - LRELAX_THRV_FRC, LRELAX_UV_FRC and LRELAX_UVMEAN_FRC using:
! XRELAX_TIME_FRC, XRELAX_HEIGHT_FRC and CRELAX_HEIGHT_TYPE
! - LTRANS
! XUTRANS, XVTRANS
@@ -43,6 +43,7 @@
!! add SST and surf pressure forcing
!! 06/2003 (V. Masson) removes SST forcing (externalisation of surface)
!! 09/2017 Q.Rodier add LTEND_UV_FRC
+!! 06/2021 F.Couvreux add LRELAX_UVMEAN_FRC
!-------------------------------------------------------------------------------
USE MODD_FRC
!
@@ -55,6 +56,7 @@ NAMELIST /NAM_FRC/ LGEOST_UV_FRC , &
LVERT_MOTION_FRC , &
LRELAX_THRV_FRC , &
LRELAX_UV_FRC , &
+ LRELAX_UVMEAN_FRC , &
XRELAX_TIME_FRC , &
XRELAX_HEIGHT_FRC , &
CRELAX_HEIGHT_TYPE , &
diff --git a/src/MNH/modn_param_ecradn.f90 b/src/MNH/modn_param_ecradn.f90
index 096bf9520c4244010342d0ce36ce2377f5aa8a29..1cf2bfa4704a09d08eec5211e7aaa0e9ab4cb2f7 100644
--- a/src/MNH/modn_param_ecradn.f90
+++ b/src/MNH/modn_param_ecradn.f90
@@ -14,7 +14,11 @@
!
!-------------------------------------------------------------------------------
USE PARKIND1 , ONLY : JPIM,JPRB
-
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+USE MODD_RADIATIONS_n , ONLY : NSWB_MNH, NLWB_MNH
+#endif
+#endif
!* 0. DECLARATIONS
! ------------
!
@@ -30,7 +34,18 @@ USE MODD_PARAM_ECRAD_n, ONLY: &
NREG_n => NREG, &
XCLOUD_FRAC_STD_n => XCLOUD_FRAC_STD, &
NLWSCATTERING_n => NLWSCATTERING, &
- NAERMACC_n => NAERMACC
+ NAERMACC_n => NAERMACC
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+USE MODD_PARAM_ECRAD_n, ONLY: &
+ LSPEC_ALB_n => LSPEC_ALB, &
+ LSPEC_EMISS_n => LSPEC_EMISS, &
+ ! USER_ALB_DIFF_n => USER_ALB_DIFF, &
+ ! USER_ALB_DIR_n => USER_ALB_DIR, &
+ ! USER_EMISS_n => USER_EMISS
+ SURF_TYPE_n => SURF_TYPE
+#endif
+#endif
! EFF3D_n => EFF3D, &
! SIDEM_n => SIDEM, &
! LWCSCA_n => LWCSCA, &
@@ -54,6 +69,16 @@ INTEGER(KIND=JPIM), SAVE :: NREG
REAL(KIND=JPRB), SAVE :: XCLOUD_FRAC_STD
INTEGER(KIND=JPIM), SAVE :: NLWSCATTERING
INTEGER(KIND=JPIM), SAVE :: NAERMACC
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+LOGICAL, SAVE :: LSPEC_ALB
+LOGICAL, SAVE :: LSPEC_EMISS
+!REAL(KIND=JPRB), ALLOCATABLE, SAVE :: USER_ALB_DIFF(:)
+!REAL(KIND=JPRB), ALLOCATABLE, SAVE :: USER_ALB_DIR(:)
+!REAL(KIND=JPRB), ALLOCATABLE, SAVE :: USER_EMISS(:)
+CHARACTER(LEN=4), SAVE :: SURF_TYPE
+#endif
+#endif
! LOGICAL, SAVE :: EFF3D
! LOGICAL, SAVE :: SIDEM
! LOGICAL, SAVE :: LWCSCA
@@ -64,7 +89,18 @@ INTEGER(KIND=JPIM), SAVE :: NAERMACC
!
NAMELIST/NAM_PARAM_ECRADn/NSWSOLVER,NLWSOLVER,NRADLP,NRADIP,&
NLIQOPT,NICEOPT,NOVLP,NGAS,NREG,XCLOUD_FRAC_STD,&
- NLWSCATTERING, NAERMACC
+ NLWSCATTERING, NAERMACC &
+#ifndef MNH_ECRAD
+ &
+#else
+#if ( VER_ECRAD == 140 )
+ , LSPEC_ALB, LSPEC_EMISS, &
+! USER_ALB_DIFF, USER_ALB_DIR, USER_EMISS, &
+ SURF_TYPE
+#else
+ &
+#endif
+#endif
!
CONTAINS
!
@@ -81,6 +117,16 @@ SUBROUTINE INIT_NAM_PARAM_ECRADn
XCLOUD_FRAC_STD = XCLOUD_FRAC_STD_n
NLWSCATTERING = NLWSCATTERING_n
NAERMACC = NAERMACC_n
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+ LSPEC_ALB = LSPEC_ALB_n
+ LSPEC_EMISS = LSPEC_EMISS_n
+! USER_ALB_DIFF = USER_ALB_DIFF_n
+! USER_ALB_DIR = USER_ALB_DIR_n
+! USER_EMISS = USER_EMISS_n
+ SURF_TYPE = SURF_TYPE_n
+#endif
+#endif
END SUBROUTINE INIT_NAM_PARAM_ECRADn
SUBROUTINE UPDATE_NAM_PARAM_ECRADn
@@ -96,6 +142,16 @@ SUBROUTINE UPDATE_NAM_PARAM_ECRADn
XCLOUD_FRAC_STD_n = XCLOUD_FRAC_STD
NLWSCATTERING_n = NLWSCATTERING
NAERMACC_n = NAERMACC
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+ LSPEC_ALB_n = LSPEC_ALB
+ LSPEC_EMISS_n = LSPEC_EMISS
+! USER_ALB_DIFF_n = USER_ALB_DIFF
+! USER_ALB_DIR_n = USER_ALB_DIR
+! USER_EMISS_n = USER_EMISS
+ SURF_TYPE_n = SURF_TYPE
+#endif
+#endif
END SUBROUTINE UPDATE_NAM_PARAM_ECRADn
END MODULE MODN_PARAM_ECRAD_n
diff --git a/src/MNH/profilern.f90 b/src/MNH/profilern.f90
index 05f09d32850add426ffe5d97336c3388b6da86f2..f91695cd03a4bc5a6bfd7fc3e806daed877a3ea7 100644
--- a/src/MNH/profilern.f90
+++ b/src/MNH/profilern.f90
@@ -12,7 +12,7 @@ INTERFACE
SUBROUTINE PROFILER_n(PTSTEP, &
PXHAT, PYHAT, PZ,PRHODREF, &
PU, PV, PW, PTH, PR, PSV, PTKE, &
- PTS,PP, PAER, PCLDFR, PCIT)
+ PTS,PP, PAER, PCLDFR, PCIT,PSEA)
!
REAL, INTENT(IN) :: PTSTEP ! time step
REAL, DIMENSION(:), INTENT(IN) :: PXHAT ! x coordinate
@@ -31,6 +31,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PP ! pressure
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PAER ! aerosol extinction
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! cloud fraction
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! ice concentration
+REAL, DIMENSION(:,:),INTENT(IN) :: PSEA ! for radar
!
!-------------------------------------------------------------------------------
!
@@ -44,7 +45,7 @@ END MODULE MODI_PROFILER_n
SUBROUTINE PROFILER_n(PTSTEP, &
PXHAT, PYHAT, PZ,PRHODREF, &
PU, PV, PW, PTH, PR, PSV, PTKE, &
- PTS, PP, PAER, PCLDFR, PCIT)
+ PTS, PP, PAER, PCLDFR, PCIT, PSEA)
! ########################################################
!
!
@@ -83,7 +84,7 @@ END MODULE MODI_PROFILER_n
!! March,28, 2018 (P. Wautelet) replace TEMPORAL_DIST by DATETIME_DISTANCE
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
-!
+! M.Taufour 07/2021: modify RARE for hydrometeors containing ice and add bright band calculation for RARE
! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -107,6 +108,31 @@ USE MODI_GPS_ZENITH_GRID
USE MODI_LIDAR
USE MODI_RADAR_RAIN_ICE
USE MODI_WATER_SUM
+USE MODE_FGAU, ONLY : GAULAG
+USE MODE_FSCATTER, ONLY: QEPSW,QEPSI,BHMIE,MOMG,MG
+USE MODD_PARAM_LIMA, ONLY: XALPHAR_L=>XALPHAR,XNUR_L=>XNUR,XALPHAS_L=>XALPHAS,XNUS_L=>XNUS,&
+ XALPHAG_L=>XALPHAG,XNUG_L=>XNUG, XALPHAI_L=>XALPHAI,XNUI_L=>XNUI,&
+ XRTMIN_L=>XRTMIN,XALPHAC_L=>XALPHAC,XNUC_L=>XNUC
+USE MODD_PARAM_LIMA_COLD, ONLY: XDI_L=>XDI,XLBEXI_L=>XLBEXI,XLBI_L=>XLBI,XAI_L=>XAI,XBI_L=>XBI,XC_I_L=>XC_I,&
+ XLBEXS_L=>XLBEXS,XLBS_L=>XLBS,XCCS_L=>XCCS,&
+ XAS_L=>XAS,XBS_L=>XBS,XCXS_L=>XCXS
+USE MODD_PARAM_LIMA_MIXED, ONLY: XDG_L=>XDG,XLBEXG_L=>XLBEXG,XLBG_L=>XLBG,XCCG_L=>XCCG,&
+ XAG_L=>XAG,XBG_L=>XBG,XCXG_L=>XCXG,XCG_L=>XCG
+USE MODD_PARAM_LIMA_WARM, ONLY: XLBEXR_L=>XLBEXR,XLBR_L=>XLBR,XBR_L=>XBR,XAR_L=>XAR,&
+ XBC_L=>XBC,XAC_L=>XAC
+USE MODD_RAIN_ICE_DESCR, ONLY: XALPHAR_I=>XALPHAR,XNUR_I=>XNUR,XLBEXR_I=>XLBEXR,&
+ XLBR_I=>XLBR,XCCR_I=>XCCR,XBR_I=>XBR,XAR_I=>XAR,&
+ XALPHAC_I=>XALPHAC,XNUC_I=>XNUC,&
+ XLBC_I=>XLBC,XBC_I=>XBC,XAC_I=>XAC,&
+ XALPHAC2_I=>XALPHAC2,XNUC2_I=>XNUC2,&
+ XALPHAS_I=>XALPHAS,XNUS_I=>XNUS,XLBEXS_I=>XLBEXS,&
+ XLBS_I=>XLBS,XCCS_I=>XCCS,XAS_I=>XAS,XBS_I=>XBS,XCXS_I=>XCXS,&
+ XALPHAG_I=>XALPHAG,XNUG_I=>XNUG,XDG_I=>XDG,XLBEXG_I=>XLBEXG,&
+ XLBG_I=>XLBG,XCCG_I=>XCCG,XAG_I=>XAG,XBG_I=>XBG,XCXG_I=>XCXG,XCG_I=>XCG,&
+ XALPHAI_I=>XALPHAI,XNUI_I=>XNUI,XDI_I=>XDI,XLBEXI_I=>XLBEXI,&
+ XLBI_I=>XLBI,XAI_I=>XAI,XBI_I=>XBI,XC_I_I=>XC_I,&
+ XRTMIN_I=>XRTMIN,XCONC_LAND,XCONC_SEA
+!
!
IMPLICIT NONE
!
@@ -131,6 +157,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PP ! pressure
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PAER ! aerosol extinction
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! cloud fraction
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! ice concentration
+REAL, DIMENSION(:,:),INTENT(IN) :: PSEA ! for radar
!
!-------------------------------------------------------------------------------
!
@@ -195,10 +222,33 @@ INTEGER :: I ! loop for stations
!
REAL,DIMENSION(SIZE(PTH,1),SIZE(PTH,2)) :: ZZTD,ZZHD,ZZWD
REAL,DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZTEMP,ZRARE,ZTHV,ZTEMPV
-REAL,DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZWORK32,ZWORK33,ZWORK34,ZCIT
+REAL,DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZWORK32,ZWORK33,ZWORK34
REAL,DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZVISI,ZVISIKUN
REAL :: ZK1,ZK2,ZK3 ! k1, k2 and K3 atmospheric refractivity constants
REAL :: ZRDSRV ! XRD/XRV
+!
+! specific to cloud radar
+INTEGER :: JLOOP,JLOOP2 ! loop counter
+REAL, DIMENSION(SIZE(PR,3)) :: ZTEMPZ! vertical profile of temperature
+REAL, DIMENSION(SIZE(PR,3)) :: ZRHODREFZ ! vertical profile of dry air density of the reference state
+REAL, DIMENSION(SIZE(PR,3)) :: ZCIT ! pristine ice concentration
+REAL, DIMENSION(SIZE(PR,3)) :: ZCCI,ZCCR,ZCCC ! ICE,RAIN CLOUD concentration (LIMA)
+REAL, DIMENSION(SIZE(PR,1),SIZE(PR,2),SIZE(PR,3)) :: ZR
+REAL, DIMENSION(SIZE(PR,3),SIZE(PR,4)+1) :: ZRZ ! vertical profile of hydrometeor mixing ratios
+REAL :: ZA,ZB,ZCC,ZCX,ZALPHA,ZNU,ZLB,ZLBEX,ZRHOHYD,XLAM_CRAD ! generic microphysical parameters
+INTEGER :: JJ ! loop counter for quadrature
+COMPLEX :: QMW,QMI,QM,QB,QEPSIW,QEPSWI ! dielectric parameter
+REAL :: ZAETOT,ZAETMP,ZREFLOC,ZQSCA,ZQBACK,ZQEXT ! temporary scattering parameters
+REAL,DIMENSION(:),ALLOCATABLE :: ZAELOC,ZZMZ ! temporary arrays
+INTEGER :: JPTS_GAULAG=9 ! number of points for Gauss-Laguerre quadrature
+REAL :: ZLBDA ! slope distribution parameter
+REAL :: ZFRAC_ICE ! ice water fraction
+REAL :: ZDELTA_EQUIV ! mass-equivalent Gauss-Laguerre point
+REAL :: ZFW ! liquid fraction
+REAL :: ZFPW ! weight for mixed-phase reflectivity
+REAL,DIMENSION(:),ALLOCATABLE :: ZX,ZW ! Gauss-Laguerre points and weights
+REAL,DIMENSION(:),ALLOCATABLE :: ZRTMIN ! local values for XRTMIN
+LOGICAL :: GCALC
!----------------------------------------------------------------------------
!
!* 2. PRELIMINARIES
@@ -211,6 +261,8 @@ ZK1 = 0.776 ! K/Pa
ZK2 = 0.704 ! K/Pa
ZK3 = 3739. ! K2/Pa
ZRDSRV=XRD/XRV
+!
+XLAM_CRAD = 3.154E-3 ! (in m) <=> 95.04 GHz = Rasta cloud radar frequency
!* 2.1 Indices
! -------
!
@@ -364,8 +416,6 @@ END IF
! --------------
!
ZTEMP(:,:,:)=PTH(:,:,:)*(PP(:,:,:)/ XP00) **(XRD/XCPD)
-IF (CCLOUD(1:3)=="ICE") CALL RADAR_RAIN_ICE (PR, PCIT, PRHODREF, ZTEMP, ZRARE, ZWORK32, &
- ZWORK33, ZWORK34 )
! Theta_v
ZTHV(:,:,:) = PTH(:,:,:) / (1.+WATER_SUM(PR(:,:,:,:)))*(1.+PR(:,:,:,1)/ZRDSRV)
! virtual temperature
@@ -373,8 +423,9 @@ ZTEMPV(:,:,:)=ZTHV(:,:,:)*(PP(:,:,:)/ XP00) **(XRD/XCPD)
CALL GPS_ZENITH_GRID(PR(:,:,:,1),ZTEMP,PP,ZZTD,ZZHD,ZZWD)
! Kunkel formulation
IF (SIZE(PR,4) >= 2) THEN
+ ZVISIKUN(:,:,:) = 10E5 !default value
WHERE ( PR(:,:,:,2) /=0 )
- ZVISIKUN(:,:,:) =0.027/(PR(:,:,:,2)*PRHODREF(:,:,:))**0.88
+ ZVISIKUN(:,:,:) =0.027/(10**(-8)+(PR(:,:,:,2)/(1+PR(:,:,:,2))*PRHODREF(:,:,:)*1000))**0.88
END WHERE
END IF
! Gultepe formulation
@@ -476,7 +527,268 @@ IF (GSTORE) THEN
TPROFILER%VISIKUN(IN,:,I) = PROFILER_INTERP(ZVISIKUN)
TPROFILER%ZZ (IN,:,I) = ZZ(:)
TPROFILER%RHOD(IN,:,I) = ZRHOD(:)
- IF (SIZE(PR,4) == 6) TPROFILER%RARE(IN,:,I) = PROFILER_INTERP(ZRARE)
+ TPROFILER%CIZ(IN,:,I) = PROFILER_INTERP(PCIT)
+! add RARE
+ ! initialization CRARE and CRARE_ATT + LWC and IWC
+ TPROFILER%CRARE(IN,:,I) = 0.
+ TPROFILER%CRARE_ATT(IN,:,I) = 0.
+ TPROFILER%LWCZ (IN,:,I) = 0.
+ TPROFILER%IWCZ (IN,:,I) = 0.
+ IF (CCLOUD=="LIMA" .OR. CCLOUD=="ICE3" ) THEN ! only for ICE3 and LIMA
+ TPROFILER%LWCZ (IN,:,I) = PROFILER_INTERP((PR(:,:,:,2)+PR(:,:,:,3))*PRHODREF(:,:,:))
+ TPROFILER%IWCZ (IN,:,I) = PROFILER_INTERP((PR(:,:,:,4)+PR(:,:,:,5)+PR(:,:,:,6))*PRHODREF(:,:,:))
+ ZTEMPZ(:)=PROFILER_INTERP(ZTEMP(:,:,:))
+ ZRHODREFZ(:)=PROFILER_INTERP(PRHODREF(:,:,:))
+ ZCIT(:)=PROFILER_INTERP(PCIT(:,:,:))
+ IF (CCLOUD=="LIMA") THEN
+ ZCCI(:)=PROFILER_INTERP(PSV(:,:,:,NSV_LIMA_NI))
+ ZCCR(:)=PROFILER_INTERP(PSV(:,:,:,NSV_LIMA_NR))
+ ZCCC(:)=PROFILER_INTERP(PSV(:,:,:,NSV_LIMA_NC))
+ ENDIF
+ DO JLOOP=3,6
+ ZRZ(:,JLOOP)=PROFILER_INTERP(PR(:,:,:,JLOOP))
+ END DO
+ DO JK=1,IKU
+ ZRZ(JK,2)=PROFILER_INTERP_2D(PR(:,:,JK,2)*PSEA(:,:)) ! becomes cloud mixing ratio over sea
+ ZRZ(JK,7)=PROFILER_INTERP_2D(PR(:,:,JK,2)*(1.-PSEA(:,:))) ! becomes cloud mixing ratio over land
+ END DO
+ ALLOCATE(ZAELOC(IKU))
+ !
+ ZAELOC(:)=0.
+ ! initialization of quadrature points and weights
+ ALLOCATE(ZX(JPTS_GAULAG),ZW(JPTS_GAULAG))
+ CALL GAULAG(JPTS_GAULAG,ZX,ZW) ! for integration over diameters
+ ! initialize minimum values
+ ALLOCATE(ZRTMIN(SIZE(PR,4)+1))
+ IF (CCLOUD == 'LIMA') THEN
+ ZRTMIN(2)=XRTMIN_L(2) ! cloud water over sea
+ ZRTMIN(3)=XRTMIN_L(3)
+ ZRTMIN(4)=XRTMIN_L(4)
+ ZRTMIN(5)=1E-10
+ ZRTMIN(6)=XRTMIN_L(6)
+ ZRTMIN(7)=XRTMIN_L(2) ! cloud water over land
+ ELSE
+ ZRTMIN(2)=XRTMIN_I(2) ! cloud water over sea
+ ZRTMIN(3)=XRTMIN_I(3)
+ ZRTMIN(4)=XRTMIN_I(4)
+ ZRTMIN(5)=1E-10
+ ZRTMIN(6)=XRTMIN_I(6)
+ ZRTMIN(7)=XRTMIN_I(2) ! cloud water over land
+ ENDIF
+ ! compute cloud radar reflectivity from vertical profiles of temperature
+ ! and mixing ratios
+ DO JK=1,IKU
+ QMW=SQRT(QEPSW(ZTEMPZ(JK),XLIGHTSPEED/XLAM_CRAD))
+ QMI=SQRT(QEPSI(ZTEMPZ(JK),XLIGHTSPEED/XLAM_CRAD))
+ DO JLOOP=2,7
+ IF (CCLOUD == 'LIMA') THEN
+ GCALC=(ZRZ(JK,JLOOP)>ZRTMIN(JLOOP).AND.(JLOOP.NE.4.OR.ZCCI(JK)>0.).AND.&
+ (JLOOP.NE.3.OR.ZCCR(JK)>0.).AND.((JLOOP.NE.2.AND.JLOOP.NE.7).OR.ZCCC(JK)>0.))
+ ELSE
+ GCALC=(ZRZ(JK,JLOOP)>ZRTMIN(JLOOP).AND.(JLOOP.NE.4.OR.ZCIT(JK)>0.))
+ ENDIF
+ IF(GCALC) THEN
+ SELECT CASE(JLOOP)
+ CASE(2) ! cloud water over sea
+ IF (CCLOUD == 'LIMA') THEN
+ ZA=XAC_L
+ ZB=XBC_L
+ ZCC=ZCCC(JK)*ZRHODREFZ(JK)
+ ZCX=0.
+ ZALPHA=XALPHAC_L
+ ZNU=XNUC_L
+ ZLBEX=1.0/(ZCX-ZB)
+ ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
+ ELSE
+ ZA=XAC_I
+ ZB=XBC_I
+ ZCC=XCONC_SEA
+ ZCX=0.
+ ZALPHA=XALPHAC2_I
+ ZNU=XNUC2_I
+ ZLBEX=1.0/(ZCX-ZB)
+ ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
+ ENDIF
+ CASE(3) ! rain water
+ IF (CCLOUD == 'LIMA') THEN
+ ZA=XAR_L
+ ZB=XBR_L
+ ZCC=ZCCR(JK)*ZRHODREFZ(JK)
+ ZCX=0.
+ ZALPHA=XALPHAR_L
+ ZNU=XNUR_L
+ ZLBEX=1.0/(ZCX-ZB)
+ ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
+ ELSE
+ ZA=XAR_I
+ ZB=XBR_I
+ ZCC=XCCR_I
+ ZCX=-1.
+ ZALPHA=XALPHAR_I
+ ZNU=XNUR_I
+ ZLB=XLBR_I
+ ZLBEX=XLBEXR_I
+ ENDIF
+ CASE(4) ! pristine ice
+ IF (CCLOUD == 'LIMA') THEN
+ ZA=XAI_L
+ ZB=XBI_L
+ ZCC=ZCCI(JK)*ZRHODREFZ(JK)
+ ZCX=0.
+ ZALPHA=XALPHAI_L
+ ZNU=XNUI_L
+ ZLBEX=1.0/(ZCX-ZB)
+ ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX) ! because ZCC not included in XLBI
+ ZFW=0
+ ELSE
+ ZA=XAI_I
+ ZB=XBI_I
+ ZCC=ZCIT(JK)
+ ZCX=0.
+ ZALPHA=XALPHAI_I
+ ZNU=XNUI_I
+ ZLBEX=XLBEXI_I
+ ZLB=XLBI_I*ZCC**(-ZLBEX) ! because ZCC not included in XLBI
+ ZFW=0
+ ENDIF
+ CASE(5) ! snow
+ IF (CCLOUD == 'LIMA') THEN
+ ZA=XAS_L
+ ZB=XBS_L
+ ZCC=XCCS_L
+ ZCX=XCXS_L
+ ZALPHA=XALPHAS_L
+ ZNU=XNUS_L
+ ZLB=XLBS_L
+ ZLBEX=XLBEXS_L
+ ZFW=0
+ ELSE
+ ZA=XAS_I
+ ZB=XBS_I
+ ZCC=XCCS_I
+ ZCX=XCXS_I
+ ZALPHA=XALPHAS_I
+ ZNU=XNUS_I
+ ZLB=XLBS_I
+ ZLBEX=XLBEXS_I
+ ZFW=0
+ ENDIF
+ CASE(6) ! graupel
+ !If temperature between -10 and 10B0C and Mr and Mg over min
+ !threshold: melting graupel
+ ! with liquid water fraction Fw=Mr/(Mr+Mg) else dry graupel
+ ! (Fw=0)
+ IF( ZTEMPZ(JK) > XTT-10 .AND. ZTEMPZ(JK) < XTT+10 &
+ .AND. ZRZ(JK,3) > ZRTMIN(3) ) THEN
+ ZFW=ZRZ(JK,3)/(ZRZ(JK,3)+ZRZ(JK,JLOOP))
+ ELSE
+ ZFW=0
+ ENDIF
+ IF (CCLOUD == 'LIMA') THEN
+ ZA=XAG_L
+ ZB=XBG_L
+ ZCC=XCCG_L
+ ZCX=XCXG_L
+ ZALPHA=XALPHAG_L
+ ZNU=XNUG_L
+ ZLB=XLBG_L
+ ZLBEX=XLBEXG_L
+ ELSE
+ ZA=XAG_I
+ ZB=XBG_I
+ ZCC=XCCG_I
+ ZCX=XCXG_I
+ ZALPHA=XALPHAG_I
+ ZNU=XNUG_I
+ ZLB=XLBG_I
+ ZLBEX=XLBEXG_I
+ ENDIF
+ CASE(7) ! cloud water over land
+ IF (CCLOUD == 'LIMA') THEN
+ ZA=XAC_L
+ ZB=XBC_L
+ ZCC=ZCCC(JK)*ZRHODREFZ(JK)
+ ZCX=0.
+ ZALPHA=XALPHAC_L
+ ZNU=XNUC_L
+ ZLBEX=1.0/(ZCX-ZB)
+ ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
+ ELSE
+ ZA=XAC_I
+ ZB=XBC_I
+ ZCC=XCONC_LAND
+ ZCX=0.
+ ZALPHA=XALPHAC_I
+ ZNU=XNUC_I
+ ZLBEX=1.0/(ZCX-ZB)
+ ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
+ ENDIF
+ END SELECT
+ ZLBDA=ZLB*(ZRHODREFZ(JK)*ZRZ(JK,JLOOP))**ZLBEX
+ ZREFLOC=0.
+ ZAETMP=0.
+ DO JJ=1,JPTS_GAULAG ! Gauss-Laguerre quadrature
+ ZDELTA_EQUIV=ZX(JJ)**(1./ZALPHA)/ZLBDA
+ SELECT CASE(JLOOP)
+ CASE(2,3,7)
+ QM=QMW
+ CASE(4,5,6)
+ ! pristine ice, snow, dry graupel
+ ZRHOHYD=MIN(6.*ZA*ZDELTA_EQUIV**(ZB-3.)/XPI,.92*XRHOLW)
+ QM=sqrt(MG(QMI**2,CMPLX(1,0),ZRHOHYD/.92/XRHOLW))
+ ! water inclusions in ice in air
+ QEPSWI=MG(QMW**2,QM**2,ZFW)
+ ! ice in air inclusions in water
+ QEPSIW=MG(QM**2,QMW**2,1.-ZFW)
+ !MG weighted rule (Matrosov 2008)
+ IF(ZFW .LT. 0.37) THEN
+ ZFPW=0
+ ELSE IF(ZFW .GT. 0.63) THEN
+ ZFPW=1
+ ELSE
+ ZFPW=(ZFW-0.37)/(0.63-0.37)
+ ENDIF
+ QM=sqrt(QEPSWI*(1.-ZFPW)+QEPSIW*ZFPW)
+ END SELECT
+ CALL BHMIE(XPI/XLAM_CRAD*ZDELTA_EQUIV,QM,ZQEXT,ZQSCA,ZQBACK)
+ ZREFLOC=ZREFLOC+ZQBACK*ZX(JJ)**(ZNU-1)*ZDELTA_EQUIV**2*ZW(JJ)
+ ZAETMP =ZAETMP +ZQEXT *ZX(JJ)**(ZNU-1)*ZDELTA_EQUIV**2*ZW(JJ)
+ END DO
+ ZREFLOC=ZREFLOC*(XLAM_CRAD/XPI)**4*ZCC*ZLBDA**ZCX/(4.*GAMMA(ZNU)*.93)
+ ZAETMP=ZAETMP * XPI *ZCC*ZLBDA**ZCX/(4.*GAMMA(ZNU))
+ TPROFILER%CRARE(IN,JK,I)=TPROFILER%CRARE(IN,JK,I)+ZREFLOC
+ ZAELOC(JK)=ZAELOC(JK)+ZAETMP
+ END IF
+ END DO
+ END DO
+ ! apply attenuation
+ ALLOCATE(ZZMZ(IKU))
+ ZZMZ = ZZ(:) ! PROFILER_INTERP(ZZM(:,:,:))
+! ZZMZ(1)=ZZM_STAT
+ ! zenith
+ ZAETOT=1.
+ DO JK = 2,IKU
+ ! attenuation from ZAELOC(JK) and ZAELOC(JK-1)
+ ZAETOT=ZAETOT*EXP(-(ZAELOC(JK-1)+ZAELOC(JK))*(ZZMZ(JK)-ZZMZ(JK-1)))
+ TPROFILER%CRARE_ATT(IN,JK,I)=TPROFILER%CRARE(IN,JK,I)*ZAETOT
+ END DO
+! TPROFILER%ZZ (IN,:,I) = ZZMZ(:)
+ DEALLOCATE(ZZMZ,ZAELOC)
+ ! m^3 bmm^6/m^3 bdBZ
+ WHERE(TPROFILER%CRARE(IN,:,I)>0)
+ TPROFILER%CRARE(IN,:,I)=10.*LOG10(1.E18*TPROFILER%CRARE(IN,:,I))
+ ELSEWHERE
+ TPROFILER%CRARE(IN,:,I)=XUNDEF
+ END WHERE
+ WHERE(TPROFILER%CRARE_ATT(IN,:,I)>0)
+ TPROFILER%CRARE_ATT(IN,:,I)=10.*LOG10(1.E18*TPROFILER%CRARE_ATT(IN,:,I))
+ ELSEWHERE
+ TPROFILER%CRARE_ATT(IN,:,I)=XUNDEF
+ END WHERE
+ DEALLOCATE(ZX,ZW,ZRTMIN)
+ END IF ! end LOOP ICE3
+! end add RARE
+!!
IF (.NOT. L1D) THEN
TPROFILER%P (IN,:,I) = PROFILER_INTERP(PP(II(I):II(I)+1,IJ(I):IJ(I)+1,:))
ELSE
@@ -566,7 +878,9 @@ IF (GSTORE) THEN
CALL DISTRIBUTE_PROFILER(TPROFILER%VISI(IN,JK,I))
CALL DISTRIBUTE_PROFILER(TPROFILER%VISIKUN(IN,JK,I))
CALL DISTRIBUTE_PROFILER(TPROFILER%RHOD(IN,JK,I))
- CALL DISTRIBUTE_PROFILER(TPROFILER%RARE(IN,JK,I))
+ CALL DISTRIBUTE_PROFILER(TPROFILER%CRARE(IN,JK,I))
+ CALL DISTRIBUTE_PROFILER(TPROFILER%CRARE_ATT(IN,JK,I))
+ CALL DISTRIBUTE_PROFILER(TPROFILER%CIZ(IN,JK,I))
CALL DISTRIBUTE_PROFILER(TPROFILER%IWV(IN,I))
CALL DISTRIBUTE_PROFILER(TPROFILER%ZTD(IN,I))
CALL DISTRIBUTE_PROFILER(TPROFILER%ZHD(IN,I))
diff --git a/src/MNH/prognos_lima.f90 b/src/MNH/prognos_lima.f90
index 967dd166ab2933510cf616c46e378076e66a5ffe..64834850299bea38e862fe05238081fc5dac9b1a 100644
--- a/src/MNH/prognos_lima.f90
+++ b/src/MNH/prognos_lima.f90
@@ -297,6 +297,7 @@ ENDWHERE
!Calcul de S+dS
PS0(:)=PS0(:)+((ZA1(:)-(((ZB(:)*(PS0(:)+1.0)+1.0)*ZDZRC(:))/ZRVSAT1(:)))*PTSTEP)
!
+PS0=MAX(PS0,-0.98)
!Ajustement tel que rv=(s+1)*rvs
ZTL(:)=PTT(:)-(PLV(:)/PCPH(:))*PRC(:)
ZRT(:)=PRC(:)+PRV(:)
diff --git a/src/MNH/radiations.f90 b/src/MNH/radiations.f90
index cdb8b13cbd0b4c168fe7b9ba6f2ddd57cc38146a..e0bda3fcab8d068a4574d5adb6c0baaf8d966406 100644
--- a/src/MNH/radiations.f90
+++ b/src/MNH/radiations.f90
@@ -1100,6 +1100,11 @@ DO JJ=IJB,IJE
ZO3AVE(IIJ,:) = POZON (JI,JJ,:)
END DO
END DO
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+POZON = POZON
+#endif
+#endif
!
!-------------------------------------------------------------------------------
!
@@ -1160,7 +1165,6 @@ ZEMIW(:,:)= ZEMIS(:,:)
ZRII0= PCORSOL*XI0 ! solar constant multiplied by seasonal variations due to Earth-Sun distance
!
!
-!
!* 5.2 ACCOUNTS FOR THE CLEAR-SKY APPROXIMATION
!
! Performs the horizontal average of the fields when no cloud
diff --git a/src/MNH/read_albedo_data.f90 b/src/MNH/read_albedo_data.f90
new file mode 100644
index 0000000000000000000000000000000000000000..0409608c8960b5284a0b7a3932e157f624980203
--- /dev/null
+++ b/src/MNH/read_albedo_data.f90
@@ -0,0 +1,64 @@
+!MNH_LIC Copyright 1994-2019 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.
+!-----------------------------------------------------------------
+! ######################
+ MODULE MODI_READ_ALBEDO_DATA
+! ######################
+!
+
+
+USE MODD_PARAM_ECRAD_n, ONLY : USER_ALB_DIFF, USER_ALB_DIR
+
+implicit none
+
+CONTAINS
+
+ SUBROUTINE READ_ALBEDO_DATA(SURF_TYPE)
+
+use easy_netcdf, only : netcdf_file
+use radiation_config, only: get_enum_code
+
+character(len=*), intent(in) :: SURF_TYPE
+
+!enum, bind(c)
+ ! enumerator IAlbedoSnow, &
+ ! & IAlbedoGrass
+ !end enum
+character(len=*), parameter :: AlbedoModelName(0:5) = (/ 'OCEA', &
+ & 'VEGE',&
+ & 'DESE',&
+ & 'SNOW',&
+ & 'ZERO',&
+ & 'UNIT' /)
+
+type(netcdf_file) :: file
+character(len=255) :: albedo_data_name
+integer :: NALB
+real, allocatable :: ALL_ALB_DIFF(:,:)
+real, allocatable :: ALL_ALB_DIR(:,:)
+
+albedo_data_name = '/home/liboisq/MesoNH/MNH-V5-4-4/src/QUENTIN/ecrad-1.4.0/data/spectral_albedo.nc'
+
+! Determine albedo model
+call get_enum_code(SURF_TYPE, AlbedoModelName, &
+ & ' ', NALB)
+
+! Open the file and configure the way it is read
+call file%open(trim(albedo_data_name), iverbose=1)
+call file%transpose_matrices()
+
+! Read the albedos
+call file%get_real_matrix('albedo_diff', ALL_ALB_DIFF)
+call file%get_real_matrix('albedo_dir', ALL_ALB_DIR)
+USER_ALB_DIFF(:) = ALL_ALB_DIFF(NALB+1,:) ! because index starts at 0
+USER_ALB_DIR(:) = ALL_ALB_DIR(NALB+1,:)
+
+call file%close()
+
+
+END SUBROUTINE READ_ALBEDO_DATA
+
+END MODULE MODI_READ_ALBEDO_DATA
+
diff --git a/src/MNH/read_emiss_data.f90 b/src/MNH/read_emiss_data.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ba95430aa53fe1c8ecd0a6d7aeffe6e2db0ba4c2
--- /dev/null
+++ b/src/MNH/read_emiss_data.f90
@@ -0,0 +1,63 @@
+!MNH_LIC Copyright 1994-2019 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.
+!-----------------------------------------------------------------
+! ######################
+ MODULE MODI_READ_EMISS_DATA
+! ######################
+!
+
+
+USE MODD_PARAM_ECRAD_n, ONLY : USER_EMISS
+
+implicit none
+
+CONTAINS
+
+
+!
+ SUBROUTINE READ_EMISS_DATA(SURF_TYPE)
+!
+use easy_netcdf, only : netcdf_file
+use radiation_config, only: get_enum_code
+
+
+character(len=*), intent(in) :: SURF_TYPE
+
+
+character(len=*), parameter :: EmissModelName(0:5) = (/ 'OCEA', &
+ & 'VEGE',&
+ & 'DESE',&
+ & 'SNOW',&
+ & 'ZERO',&
+ & 'UNIT' /)
+
+type(netcdf_file) :: file
+character(len=255) :: emiss_data_name
+integer :: NEMISS
+real, allocatable :: ALL_EMISS(:,:)
+
+emiss_data_name = '/home/liboisq/MesoNH/MNH-V5-4-4/src/QUENTIN/ecrad-1.4.0/data/spectral_emissivity.nc'
+
+! Determine emissivity model
+call get_enum_code(SURF_TYPE, EmissModelName, &
+ & ' ', NEMISS)
+
+
+! Open the file and configure the way it is read
+call file%open(trim(emiss_data_name), iverbose=1)
+call file%transpose_matrices()
+
+! Read the emissivities
+call file%get_real_matrix('emissivity', ALL_EMISS)
+
+USER_EMISS(:) = ALL_EMISS(NEMISS+1,:)
+
+call file%close()
+
+
+END SUBROUTINE READ_EMISS_DATA
+
+END MODULE MODI_READ_EMISS_DATA
+
diff --git a/src/MNH/read_exsegn.f90 b/src/MNH/read_exsegn.f90
index 793e407af8923876d115ba8af9d4002d89a919b5..a8c847c3f280ae1e4f7e1a27561252b676a3c574 100644
--- a/src/MNH/read_exsegn.f90
+++ b/src/MNH/read_exsegn.f90
@@ -2363,15 +2363,24 @@ IF ( LFORCING ) THEN
WRITE(ILUOUT,FMT=*) 'YOU CHOSE A TEMPERATURE AND HUMIDITY RELAXATION'
WRITE(ILUOUT,FMT=*) 'TOGETHER WITH TENDENCY OR GEOSTROPHIC FORCING'
WRITE(ILUOUT,FMT=*) &
- 'YOU MIGHT CHECK YOUR SWITCHES: LRELAX_THRV_FRC, LTEND_THRV_FRC, AND'
+ 'YOU MIGHT CHECK YOUR SWITCHES: LRELAX_THRV_FRC, LTEND_THRV_FRC, AND'
WRITE(ILUOUT,FMT=*) 'LGEOST_TH_FRC'
END IF
!
- IF ( LRELAX_UV_FRC .AND. LGEOST_UV_FRC ) THEN
+ IF ( LRELAX_UV_FRC .AND. LRELAX_UVMEAN_FRC) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU MUST CHOOSE BETWEEN A RELAXATION APPLIED TO'
+ WRITE(ILUOUT,FMT=*) 'THE 3D FULL WIND FIELD (LRELAX_UV_FRC) OR'
+ WRITE(ILUOUT,FMT=*) 'THE HORIZONTAL MEAN WIND (LRELAX_UVMEAN_FRC)'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+ IF ( (LRELAX_UV_FRC .OR. LRELAX_UVMEAN_FRC) .AND. LGEOST_UV_FRC ) THEN
WRITE(UNIT=ILUOUT,FMT=9003) KMI
WRITE(ILUOUT,FMT=*) 'YOU MUST NOT USE A WIND RELAXATION'
WRITE(ILUOUT,FMT=*) 'TOGETHER WITH A GEOSTROPHIC FORCING'
- WRITE(ILUOUT,FMT=*) 'CHECK SWITCHES: LRELAX_UV_FRC, LGEOST_UV_FRC'
+ WRITE(ILUOUT,FMT=*) 'CHECK SWITCHES: LRELAX_UV_FRC, LRELAX_UVMEAN_FRC, LGEOST_UV_FRC'
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
END IF
diff --git a/src/MNH/sources_neg_correct.f90 b/src/MNH/sources_neg_correct.f90
index 0ceaf5a547bb575c707c704c613770f9ab0a43cd..81d49856c651454e06a50734e65120171de54dca 100644
--- a/src/MNH/sources_neg_correct.f90
+++ b/src/MNH/sources_neg_correct.f90
@@ -52,7 +52,7 @@ integer :: ji, jj, jk
integer :: jr
integer :: jrmax
integer :: jsv
-integer :: jlimaend
+integer :: isv_lima_end
real, dimension(:, :, :), allocatable :: zt, zexn, zlv, zls, zcph, zcor
if ( krr == 0 ) return
@@ -60,6 +60,15 @@ if ( krr == 0 ) return
if ( hbudname /= 'NEADV' .and. hbudname /= 'NECON' .and. hbudname /= 'NEGA' .and. hbudname /= 'NETUR' ) &
call Print_msg( NVERB_WARNING, 'GEN', 'Sources_neg_correct', 'budget '//hbudname//' not yet tested' )
+if ( hcloud == 'LIMA' ) then
+ ! The negativity correction does not apply to the SPRO (supersaturation) variable which may be naturally negative
+ if ( lspro_lima ) then
+ isv_lima_end = nsv_lima_end - 1
+ else
+ isv_lima_end = nsv_lima_end
+ end if
+end if
+
if ( hbudname /= 'NECON' .and. hbudname /= 'NEGA' ) then
if ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. &
hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) then
@@ -85,7 +94,7 @@ if ( hbudname /= 'NECON' .and. hbudname /= 'NEGA' ) then
end do
end if
if ( lbudget_sv .and. hcloud == 'LIMA' ) then
- do ji = nsv_lima_beg, nsv_lima_end
+ do ji = nsv_lima_beg, isv_lima_end
call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) )
end do
end if
@@ -111,7 +120,7 @@ else !NECON + NEGA
end do
end if
if ( lbudget_sv .and. hcloud == 'LIMA' ) then
- do ji = nsv_lima_beg, nsv_lima_end
+ do ji = nsv_lima_beg, isv_lima_end
call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) * prhodj(:, :, :) )
end do
end if
@@ -286,9 +295,7 @@ CLOUD: select case ( hcloud )
end if
end if
- jlimaend=nsv_lima_end
- if ( lspro_lima ) jlimaend=jlimaend-1
- prsvs(:, :, :, nsv_lima_beg : jlimaend) = Max( 0.0, prsvs(:, :, :, nsv_lima_beg : jlimaend) )
+ prsvs(:, :, :, nsv_lima_beg : isv_lima_end) = Max( 0.0, prsvs(:, :, :, nsv_lima_beg : isv_lima_end) )
end select CLOUD
@@ -318,7 +325,7 @@ if ( hbudname /= 'NECON' .and. hbudname /= 'NEGA' ) then
end do
end if
if ( lbudget_sv .and. hcloud == 'LIMA' ) then
- do ji = nsv_lima_beg, nsv_lima_end
+ do ji = nsv_lima_beg, isv_lima_end
call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) )
end do
end if
@@ -341,7 +348,7 @@ else !NECON + NEGA
end do
end if
if ( lbudget_sv .and. hcloud == 'LIMA' ) then
- do ji = nsv_lima_beg, nsv_lima_end
+ do ji = nsv_lima_beg, isv_lima_end
call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) * prhodj(:, :, :) )
end do
end if
diff --git a/src/MNH/spawn_model2.f90 b/src/MNH/spawn_model2.f90
index 3d1e9382c36c785c3095dbee84634861f2ce60ae..7d286b6eefcd54cd57468413da56fb828b8fdbba 100644
--- a/src/MNH/spawn_model2.f90
+++ b/src/MNH/spawn_model2.f90
@@ -590,15 +590,15 @@ CSCONV = 'NONE' ! shallow convection will have to be restarted
!
! cas LIMA
!
-IF (HCLOUD=='LIMA') THEN
- CCLOUD='LIMA'
- NMOD_CCN=3
- LSCAV=.FALSE.
- LAERO_MASS=.FALSE.
- NMOD_IFN=2
- NMOD_IMM=1
- LHHONI=.FALSE.
-ENDIF
+!IF (HCLOUD=='LIMA') THEN
+! CCLOUD='LIMA'
+! NMOD_CCN=3
+! LSCAV=.FALSE.
+! LAERO_MASS=.FALSE.
+! NMOD_IFN=2
+! NMOD_IMM=1
+! LHHONI=.FALSE.
+!ENDIF
!
CALL INI_NSV(2) ! NSV* are set equal for model 2 and model 1.
! NSV is set to the total number of SV for model 2
diff --git a/src/MNH/write_profilern.f90 b/src/MNH/write_profilern.f90
index a6f03bbf535a334e7b25320221b9ff88202ae6af..486978e1c2accda7b8125d056c48166d2a5f201c 100644
--- a/src/MNH/write_profilern.f90
+++ b/src/MNH/write_profilern.f90
@@ -16,6 +16,7 @@
! P. Wautelet 03/03/2021: budgets: add tbudiachrometadata type (useful to pass more information to Write_diachro)
! P. Wautelet 11/03/2021: bugfix: correct name for NSV_LIMA_IMM_NUCL
! P. Wautelet 05/07/2021: reorganisation to store point values correctly (not in vertical profiles)
+! M. Taufour 07/2021: modify RARE for hydrometeors containing ice and add bright band calculation for RARE
!-----------------------------------------------------------------
! ###########################
MODULE MODE_WRITE_PROFILER_n
@@ -134,7 +135,7 @@ IF (TPROFILER%Y(KI)==XUNDEF) RETURN
IKU = SIZE(TPROFILER%W,2) !Number of vertical levels
!
!IPROC is too large (not a big problem) due to the separation between vertical profiles and point values
-IPROC = 24 + SIZE(TPROFILER%R,4) + SIZE(TPROFILER%SV,4)
+IPROC = 25 + SIZE(TPROFILER%R,4) + SIZE(TPROFILER%SV,4)
IF (LDIAG_IN_RUN) IPROC = IPROC + 15
IF (LORILAM) IPROC = IPROC + JPMODE*3
IF (LDUST) IPROC = IPROC + NMODE_DST*3
@@ -152,22 +153,26 @@ YGROUP = TPROFILER%NAME(KI)
!Treat vertical profiles
jproc = 0
-call Add_profile( 'Th', 'Potential temperature', 'K', tprofiler%th )
-call Add_profile( 'Thv', 'Virtual Potential temperature', 'K', tprofiler%thv )
-call Add_profile( 'VISI', 'Visibility', 'km', tprofiler%visi )
-call Add_profile( 'VISIKUN', 'Visibility Kunkel', 'km', tprofiler%visikun )
-call Add_profile( 'RARE', 'Radar reflectivity', 'dBZ', tprofiler%rare )
-call Add_profile( 'P', 'Pressure', 'Pa', tprofiler%p )
-call Add_profile( 'ALT', 'Altitude', 'm', tprofiler%zz )
-call Add_profile( 'ZON_WIND', 'Zonal wind', 'm s-1', tprofiler%zon )
-call Add_profile( 'MER_WIND', 'Meridional wind', 'm s-1', tprofiler%mer )
-call Add_profile( 'FF', 'Wind intensity', 'm s-1', tprofiler%ff )
-call Add_profile( 'DD', 'Wind direction', 'degree', tprofiler%dd )
-call Add_profile( 'W', 'Air vertical speed', 'm s-1', tprofiler%w )
+call Add_profile( 'Th', 'Potential temperature', 'K', tprofiler%th )
+call Add_profile( 'Thv', 'Virtual Potential temperature', 'K', tprofiler%thv )
+call Add_profile( 'VISI', 'Visibility', 'km', tprofiler%visi )
+call Add_profile( 'VISIKUN', 'Visibility Kunkel', 'km', tprofiler%visikun )
+call Add_profile( 'RARE', 'Radar reflectivity', 'dBZ', tprofiler%crare )
+call Add_profile( 'RAREatt', 'Radar attenuated reflectivity', 'dBZ', tprofiler%crare_att )
+call Add_profile( 'P', 'Pressure', 'Pa', tprofiler%p )
+call Add_profile( 'ALT', 'Altitude', 'm', tprofiler%zz )
+call Add_profile( 'ZON_WIND', 'Zonal wind', 'm s-1', tprofiler%zon )
+call Add_profile( 'MER_WIND', 'Meridional wind', 'm s-1', tprofiler%mer )
+call Add_profile( 'FF', 'Wind intensity', 'm s-1', tprofiler%ff )
+call Add_profile( 'DD', 'Wind direction', 'degree', tprofiler%dd )
+call Add_profile( 'W', 'Air vertical speed', 'm s-1', tprofiler%w )
if ( ldiag_in_run ) &
call Add_profile( 'TKE_DISS', 'TKE dissipation rate', 'm2 s-2', tprofiler% tke_diss )
+if ( Size( tprofiler%ciz, 1 ) > 0 ) &
+ call Add_profile( 'CIT', 'Ice concentration', 'kg-3', tprofiler%ciz )
+
irr = Size( tprofiler%r )
if ( irr >= 1 ) call Add_profile( 'Rv', 'Water vapor mixing ratio', 'kg kg-1', tprofiler%r(:,:,:,1) )
if ( irr >= 2 ) call Add_profile( 'Rc', 'Liquid cloud water mixing ratio', 'kg kg-1', tprofiler%r(:,:,:,2) )
@@ -468,10 +473,11 @@ if ( ldiag_in_run ) then
end if
call Add_point( 'LEI', 'Solid Latent heat flux', 'W m-2', tprofiler%lei )
end if
-call Add_point( 'IWV', 'Integrated Water Vapour', 'kg m-2', tprofiler%iwv )
-call Add_point( 'ZTD', 'Zenith Tropospheric Delay', 'm', tprofiler%ztd )
-call Add_point( 'ZWD', 'Zenith Wet Delay', 'm', tprofiler%zwd )
-call Add_point( 'ZHD', 'Zenith Hydrostatic Delay', 'm', tprofiler%zhd )
+
+call Add_point( 'IWV', 'Integrated Water Vapour', 'kg m-2', tprofiler%iwv )
+call Add_point( 'ZTD', 'Zenith Tropospheric Delay', 'm', tprofiler%ztd )
+call Add_point( 'ZWD', 'Zenith Wet Delay', 'm', tprofiler%zwd )
+call Add_point( 'ZHD', 'Zenith Hydrostatic Delay', 'm', tprofiler%zhd )
Allocate( tzfields( jproc ) )
diff --git a/src/Makefile.MESONH.mk b/src/Makefile.MESONH.mk
index 016e8ce5fd41f2de176a029279a37479c1265eb5..753951e3c73b87a1a81c036442456d27ef400376 100644
--- a/src/Makefile.MESONH.mk
+++ b/src/Makefile.MESONH.mk
@@ -134,11 +134,14 @@ 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
-CPPFLAGS_RAD = -DMNH_ECRAD
-INC_RAD += -I$(B)LIB/RAD/ecrad-1.0.1/include
-ARCH_XYZ := $(ARCH_XYZ)-ECRAD
+DIR_RAD += LIB/RAD/ecrad-$(VERSION_ECRAD)_mnh
+DIR_RAD += LIB/RAD/ecrad-$(VERSION_ECRAD)
+CPPFLAGS_RAD = -DMNH_ECRAD -DVER_ECRAD=$(VER_ECRAD)
+INC_RAD += -I$(B)LIB/RAD/ecrad-$(VERSION_ECRAD)/include
+ifeq "$(VER_ECRAD)" "140"
+INC_RAD += -I$(B)LIB/RAD/ecrad-$(VERSION_ECRAD)/drhook/include
+endif
+ARCH_XYZ := $(ARCH_XYZ)-ECRAD$(VER_ECRAD)
endif
#
#
@@ -148,7 +151,15 @@ CPPFLAGS += $(CPPFLAGS_RAD)
INC += $(INC_RAD)
IGNORE_DEP_MASTER += olwu.D olwv.D rad1Driv_MACLATMOSPH_60LEVELS_ICRCCM3.D tstrad.D tstrad_chansubset.D tstrad_rttov7.D \
- tstrad_sx6.D
+ tstrad_sx6.D
+
+ifneq "$(VER_ECRAD)" "140"
+IGNORE_DEP_MASTER += read_albedo_data.D read_emiss_data.D
+endif
+
+ifeq "$(VER_ECRAD)" "140"
+IGNORE_DEP_MASTER += yomhook.D
+endif
OBJS0 += spll_orrtm_kgb1.o spll_orrtm_kgb14.o spll_orrtm_kgb3_a.o spll_orrtm_kgb4_b.o \
spll_orrtm_kgb5_c.o spll_orrtm_kgb10.o spll_orrtm_kgb15.o spll_orrtm_kgb3_b.o \
diff --git a/src/SURFEX/av_pgd_param.F90 b/src/SURFEX/av_pgd_param.F90
index 6e7e253844610c73d9da3a439fadcd7511c7de4e..462ee4c915bd3cd265e044dd947fb6317f573945 100644
--- a/src/SURFEX/av_pgd_param.F90
+++ b/src/SURFEX/av_pgd_param.F90
@@ -108,7 +108,7 @@ REAL, DIMENSION(SIZE(PFIELD,1)) :: ZSUM_WEIGHT_PATCH
REAL, DIMENSION(SIZE(PFIELD,1)) :: ZWORK
REAL, DIMENSION(SIZE(PFIELD,1)) :: ZDZ
!
-REAL, DIMENSION(31) :: ZCOUNT
+REAL, DIMENSION(0:31) :: ZCOUNT
INTEGER, DIMENSION(SIZE(PFIELD,1)) :: NMASK
INTEGER :: PATCH_LIST(NVEGTYPE)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -169,7 +169,7 @@ DO JV=1,NVEGTYPE
ELSEIF (HSFTYPE=='TRE'.OR.HSFTYPE=='GRT') THEN
IF (JV==NVT_TEBD.OR.JV==NVT_BONE.OR.JV==NVT_TRBE.OR.JV==NVT_TRBD.OR.&
JV==NVT_TEBE.OR.JV==NVT_TENE.OR.JV==NVT_BOBD.OR.JV==NVT_BOND.OR.&
- JV==NVT_SHRB) ZWEIGHT(JI,JV) = PVEGTYPE(JI,JV)
+ JV==NVT_SHRB) ZWEIGHT(JI,JV) = PVEGTYPE(IMASK,JV)
ELSE
CALL ABOR1_SFX('AV_PGD_PARAM_1D: WEIGHTING FUNCTION FOR VEGTYPE NOT ALLOWED')
ENDIF
@@ -262,7 +262,7 @@ SELECT CASE (HATYPE)
IF (ALL(ZCOUNT(:)==0.)) THEN
ZWORK(JJ) = NUNDEF
ELSE
- ZWORK(JJ) = FLOAT(MAXLOC(ZCOUNT,1))
+ ZWORK(JJ) = FLOAT(MAXLOC(ZCOUNT,1)-1)
ENDIF
END DO
!
diff --git a/src/SURFEX/diag_isba_initn.F90 b/src/SURFEX/diag_isba_initn.F90
index c4716f23d7738a8f7d8adeaf35c8010f24e2e0a9..50404eda5bc44c819ef61a126b87400167352a4c 100644
--- a/src/SURFEX/diag_isba_initn.F90
+++ b/src/SURFEX/diag_isba_initn.F90
@@ -124,7 +124,7 @@ TYPE(DIAG_EVAP_ISBA_t) :: YDE
TYPE(DIAG_MISC_ISBA_t) :: YDM
TYPE(ISBA_P_t), POINTER :: PK
REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK
-LOGICAL :: GCUMUL, GDIM
+LOGICAL :: GCUMUL, GDIM, GDIM2
INTEGER :: JP
INTEGER :: IVERSION, IBUG
INTEGER :: IRESP ! IRESP : return-code if a problem appears
@@ -448,7 +448,9 @@ IF ( GCUMUL ) THEN
CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
CALL READ_SURF(HPROGRAM,'BUG ',IBUG,IRESP)
!
- GDIM = (IVERSION>8 .OR. IVERSION==8 .AND. IBUG>0)
+ GDIM2 = (IVERSION>8 .OR. IVERSION==8 .AND. IBUG>0)
+ GDIM = GDIM2
+ IF (GDIM2) CALL READ_SURF(HPROGRAM,'SPLIT_PATCH',GDIM,IRESP)
!
#ifdef SFX_OL
IF(DE%LWATER_BUDGET .OR. (LRESTART .AND. .NOT.DGO%LRESET_BUDGETC))THEN
diff --git a/src/SURFEX/e_budget_meb.F90 b/src/SURFEX/e_budget_meb.F90
index ffb942c2a7a178f6239b1652a877e589d94ac0c4..092705bc67ff92e59b850704b546e11aebd4d4e3 100644
--- a/src/SURFEX/e_budget_meb.F90
+++ b/src/SURFEX/e_budget_meb.F90
@@ -80,7 +80,7 @@
!! -------------
!! Original 22/01/11
!! 10/10/14 (A. Boone) Removed understory vegetation
-!!
+!! 13/09/18 (A. Boone) Add litter layer option to test-Tg computation
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -92,14 +92,14 @@ USE MODD_DIAG_n, ONLY : DIAG_t
USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
!
-USE MODD_CSTS, ONLY : XLVTT, XLSTT, XTT, XCPD, XCPV, XCL, &
+USE MODD_CSTS, ONLY : XLVTT, XLSTT, XTT, XCPD, XCPV, XCL, &
XDAY, XPI, XLMTT, XRHOLW
USE MODD_SURF_ATM, ONLY : LCPL_ARP
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_SNOW_METAMO, ONLY : XSNOWDZMIN
-!
+
USE MODE_THERMOS
-USE MODE_MEB, ONLY : SFC_HEATCAP_VEG
+USE MODE_MEB, ONLY : SFC_HEATCAP_VEG, MEBLITTER_THRM
USE MODE_SNOW3L, ONLY : SNOW3LHOLD
!
USE MODI_TRIDIAG_GROUND_RM_COEFS
@@ -308,7 +308,7 @@ REAL, DIMENSION(SIZE(DMK%XSNOWDZ,1),SIZE(DMK%XSNOWDZ,2)):: ZSNOW_COEF_A, ZSNOW_C
!
REAL, DIMENSION(SIZE(DMK%XSNOWDZ,1),SIZE(DMK%XSNOWDZ,2)):: ZWHOLDMAX
!
-REAL, DIMENSION(SIZE(PD_G,1),SIZE(PD_G,2)+SIZE(DMK%XSNOWDZ,2)) :: ZD, ZT, ZHCAPZ, ZCONDZ, &
+REAL, DIMENSION(SIZE(PD_G,1),SIZE(PD_G,2)+SIZE(DMK%XSNOWDZ,2)+1) :: ZD, ZT, ZHCAPZ, ZCONDZ, &
ZCOEF_A, ZCOEF_B, ZSOURCE
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -343,8 +343,15 @@ ZSOIL_COEF_A(:,:) = 0.0
ZSOIL_COEF_B(:,:) = 0.0
ZSNOW_COEF_A(:,:) = 0.0
ZSNOW_COEF_B(:,:) = 0.0
-
-!-------------------------------------------------------------------------------
+!
+ZD(:,:) = 0.0
+ZT(:,:) = 0.0
+ZHCAPZ(:,:) = 0.0
+ZCONDZ(:,:) = 0.0
+ZSOURCE(:,:) = 0.0
+ZCOEF_A(:,:) = 0.0
+ZCOEF_B(:,:) = 0.0
+!
!
!* 1. Some variables/coefficients needed for coupling or solution
! -----------------------------------------------------------
@@ -429,7 +436,7 @@ IF(IO%CISBA == 'DIF')THEN
! quite robust. Note, this only corresponds to the snow-covered part of grid box,
! so it is more accurate as the snow fraction approaches unity.
! Starting from snowpack surface downward to base of ground:
-!
+!
JL = 1
ZD(:,JL) = DMK%XSNOWDZ(:,1)
ZT(:,JL) = ZTNO(:,1)
@@ -446,6 +453,13 @@ IF(IO%CISBA == 'DIF')THEN
ZSOURCE(JJ,JL) = DEK%XSWNET_NS(JJ)*(PTAU_N(JJ,JK-1)-PTAU_N(JJ,JK))
ENDDO
ENDDO
+ IF(IO%LMEB_LITTER)THEN
+ JL = JL + 1
+ ZD(:,JL) = PEK%XGNDLITTER(:)
+ ZT(:,JL) = PEK%XTL(:)
+ CALL MEBLITTER_THRM(PEK%XWRL,PEK%XWRLI,PEK%XGNDLITTER,ZHCAPZ(:,JL),ZCONDZ(:,JL))
+ ZSOURCE(:,JL) = 0.
+ ENDIF
JL = JL + 1
ZD(:,JL) = PD_G(:,1)
ZT(:,JL) = ZTGO(:,1)
@@ -465,8 +479,9 @@ IF(IO%CISBA == 'DIF')THEN
!
! Get coefficients from upward sweep (starting from soil base to snow surface):
!
- CALL TRIDIAG_GROUND_RM_COEFS(PTSTEP, ZD, ZT, ZHCAPZ, ZCONDZ, ZSOURCE, &
- PTDEEP_A, KK%XTDEEP, ZTCONDA_DELZ_N, ZCOEF_A, ZCOEF_B)
+ CALL TRIDIAG_GROUND_RM_COEFS(PTSTEP, ZD(:,1:JL), ZT(:,1:JL), ZHCAPZ(:,1:JL), ZCONDZ(:,1:JL), &
+ ZSOURCE(:,1:JL),PTDEEP_A, KK%XTDEEP, ZTCONDA_DELZ_N, &
+ ZCOEF_A(:,1:JL), ZCOEF_B(:,1:JL))
!
ZSNOW_COEF_A(:,2) = ZCOEF_A(:,2)
ZSNOW_COEF_B(:,2) = ZCOEF_B(:,2)
diff --git a/src/SURFEX/ini_var_from_data.F90 b/src/SURFEX/ini_var_from_data.F90
index 755b57888ba78c96d104fa660cd1b0c80967befa..c57f2c1a8c7f641d817d671137831236a1761aba 100644
--- a/src/SURFEX/ini_var_from_data.F90
+++ b/src/SURFEX/ini_var_from_data.F90
@@ -195,7 +195,8 @@ IF (HFTYP(1)=='DIRTYP') THEN
ELSE
- IF (.NOT.ALL(LEN_TRIM(HFNAM(:))/=0) .AND. .NOT.ALL(LEN_TRIM(HFNAM(2:))==0)) THEN
+
+ IF (.NOT.ALL(LEN_TRIM(HFNAM(:))/=0) .AND. COUNT(LEN_TRIM(HFNAM(:))/=0)>1) THEN
DO JV=1,SIZE(PFIELD,2)
IF (LEN_TRIM(HFNAM(JV))==0) THEN
DO JV2=JV-1,1,-1
diff --git a/src/SURFEX/isba_meb.F90 b/src/SURFEX/isba_meb.F90
index 40b95a3cae7d8f72d21f3bfa0447227573e318e2..eaf29e0ff3c40ac0fc94f348fb69bbcc1a89e6b4 100644
--- a/src/SURFEX/isba_meb.F90
+++ b/src/SURFEX/isba_meb.F90
@@ -627,13 +627,15 @@ WHERE(PSW_RAD(:) > ZSWRAD_MIN) ! Sun is up...approx
!
ELSEWHERE
-! Sun is down:
-
- DK%XALBT(:) = 1.0
- ZSWUP(:) = PSW_RAD(:)
+! Sun is down: (below threshold)
+! radiation amounts quite small, so make a simple approximation here:
+
+ DK%XALBT(:) = ZALBV(:)
+ ZSWUP(:) = DK%XALBT(:)*PSW_RAD(:)
+
DEK%XSWDOWN_GN(:) = 0.
DEK%XSWNET_G(:) = 0.
- DEK%XSWNET_V(:) = 0.
+ DEK%XSWNET_V(:) = (1.-DK%XALBT(:))*PSW_RAD(:)
DEK%XSWNET_N(:) = 0.
DEK%XSWNET_NS(:) = 0.
ZTAU_N(:,SIZE(PEK%TSNOW%WSNOW,2)) = 0.
@@ -918,7 +920,7 @@ ZVEGFACT(:) = ZSIGMA_F(:)*(1.0-PPALPHAN(:)*PEK%XPSN(:))
! snowpack and part falling onto snow-free understory.
!
!
- CALL HYDRO_VEG(IO%CRAIN, PTSTEP, KK%XMUF, ZRR, DEK%XLEV_CV, DEK%XLETR_CV, &
+ CALL HYDRO_VEG(IO%CRAIN, PTSTEP, KK%XMUF, ZRR, DEK%XLEV_CV, DEK%XLETR_CV, &
ZVEGFACT, ZPSNCV, PEK%XWR, ZWRMAX, ZRRSFC, DEK%XDRIP, DEK%XRRVEG, &
PK%XLVTT )
!
@@ -930,7 +932,7 @@ ZVEGFACT(:) = ZSIGMA_F(:)*(1.0-PPALPHAN(:)*PEK%XPSN(:))
IF (PRESENT(PBLOWSNW_FLUX)) THEN
CALL SNOW3L_ISBA(IO, G, PK, PEK, DK, DEK, DMK, OMEB, HIMPLICIT_WIND, &
TPTIME, PTSTEP, PK%XVEGTYPE_PATCH, ZTGL, ZCTSFC, &
- ZSOILHCAPZ, ZSOILCONDZ(:,1), PPS, PTA, PSW_RAD, PQA, &
+ ZSOILHCAPZ, ZSOILCONDZ(:,1), PPS, PEK%XTC, DEK%XSWDOWN_GN, PEK%XQC,&
PVMOD, PLW_RAD, ZRRSFC, DEK%XSR_GN, PRHOA, ZUREF, PEXNS, &
PEXNA, PDIRCOSZW, ZZREF, ZALBG, ZD_G, ZDZG, PPEW_A_COEF, &
PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
@@ -941,7 +943,7 @@ ZVEGFACT(:) = ZSIGMA_F(:)*(1.0-PPALPHAN(:)*PEK%XPSN(:))
ELSE
CALL SNOW3L_ISBA(IO, G, PK, PEK, DK, DEK, DMK, OMEB, HIMPLICIT_WIND, &
TPTIME, PTSTEP, PK%XVEGTYPE_PATCH, ZTGL, ZCTSFC, &
- ZSOILHCAPZ, ZSOILCONDZ(:,1), PPS, PTA, PSW_RAD, PQA, &
+ ZSOILHCAPZ, ZSOILCONDZ(:,1), PPS, PEK%XTC, DEK%XSWDOWN_GN, PEK%XQC, &
PVMOD, PLW_RAD, ZRRSFC, DEK%XSR_GN, PRHOA, ZUREF, PEXNS, &
PEXNA, PDIRCOSZW, ZZREF, ZALBG, ZD_G, ZDZG, PPEW_A_COEF, &
PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
@@ -1641,8 +1643,11 @@ SUBROUTINE PREP_MEB_SOIL(OMEB_LITTER,PSOILHCAPZ,PSOILCONDZ,KK,PK,PEK,PD_GL,&
PDZGL,PTGL,PSOILHCAPL,PSOILCONDL,PWSATL,PWFCL,PWSFC,&
PWISFC,PCTSFC,PCT,PFROZEN1,PFROZEN1SFC)
!
-USE MODD_CSTS, ONLY : XRHOLW,XRHOLI, XCL, XCI
-USE MODD_ISBA_PAR, ONLY : XWGMIN, XOMSPH
+USE MODD_CSTS, ONLY : XRHOLW, XCL
+USE MODD_ISBA_PAR, ONLY : XWGMIN
+USE MODD_MEB_PAR, ONLY : XLITTER_HYD_Z4, XLITTER_HYD_Z5
+!
+USE MODE_MEB, ONLY : MEBLITTER_THRM
!
IMPLICIT NONE
!
@@ -1675,16 +1680,6 @@ INTEGER :: INJ, INL, JJ, JL
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-!* 0.3 declarations of local parameters
-!
-REAL, PARAMETER :: Z1 = 45.0 !litter bulk density (kg/m3)
-REAL, PARAMETER :: Z2 = 0.1 !coeff for litter conductivity (W/(mK))
-REAL, PARAMETER :: Z3 = 0.03 !coeff for litter conductivity
-REAL, PARAMETER :: Z4 = 0.95 !litter porosity (m3/m3)
-REAL, PARAMETER :: Z5 = 0.12 !litter field capacity (m3/m3)
-!
-REAL, DIMENSION(SIZE(PEK%XWG,1)) :: ZWORK
-!
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('ISBA_MEB:PREP_MEB_SOIL',0,ZHOOK_HANDLE)
@@ -1692,14 +1687,11 @@ IF (LHOOK) CALL DR_HOOK('ISBA_MEB:PREP_MEB_SOIL',0,ZHOOK_HANDLE)
INJ = SIZE(PK%XDG,1)
INL = SIZE(PK%XDG,2)
!
-ZWORK(:) = 0.0
IF(OMEB_LITTER)THEN
PTGL(:,1) = PEK%XTL(:)
- ZWORK(:) = PEK%XWRL(:)/(XRHOLW*PEK%XGNDLITTER(:))
- PSOILHCAPL(:,1) = XOMSPH*Z1 + (XCL*XRHOLW)*ZWORK(:) + (XCI*XRHOLI/XRHOLW)*PEK%XWRLI(:)/PEK%XGNDLITTER(:)
- PSOILCONDL(:,1) = Z2 + Z3 * ZWORK(:)
- PWSATL(:,1) = Z4
- PWFCL(:,1) = Z5
+ CALL MEBLITTER_THRM(PEK%XWRL,PEK%XWRLI,PEK%XGNDLITTER,PSOILHCAPL(:,1),PSOILCONDL(:,1))
+ PWSATL(:,1) = XLITTER_HYD_Z4
+ PWFCL(:,1) = XLITTER_HYD_Z5
PD_GL(:,1) = PEK%XGNDLITTER(:)
PDZGL(:,1) = PEK%XGNDLITTER(:)
PCTSFC(:) = 1. / (PSOILHCAPL(:,1) * PEK%XGNDLITTER(:))
diff --git a/src/SURFEX/modd_meb_par.F90 b/src/SURFEX/modd_meb_par.F90
index 3a0909f7152da8b903b7a8202302002490bdd70d..17169f4c2afc11c73abb94da48ae185a344b3ac3 100644
--- a/src/SURFEX/modd_meb_par.F90
+++ b/src/SURFEX/modd_meb_par.F90
@@ -24,6 +24,8 @@
!! MODIFICATIONS
!! -------------
!! Original 09/2013
+!! 13/09/18 (A. Boone) Added Litter thermal and hydrological parameters
+!! herein
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -56,6 +58,15 @@ REAL, PARAMETER :: XSW_WGHT_VIS = 0.48
!
REAL, PARAMETER :: XSW_WGHT_NIR = 0.52
!
+! Litter thermal (THRM) and hydrological (HYD) properties
+! -------------------------------------------------------
+!
+REAL, PARAMETER :: XLITTER_THRM_Z1 = 45.00 !litter bulk density (kg/m3)
+REAL, PARAMETER :: XLITTER_THRM_Z2 = 0.10 !coeff for litter conductivity (W/(mK))
+REAL, PARAMETER :: XLITTER_THRM_Z3 = 0.03 !coeff for litter conductivity
+REAL, PARAMETER :: XLITTER_HYD_Z4 = 0.95 !litter porosity (m3/m3)
+REAL, PARAMETER :: XLITTER_HYD_Z5 = 0.12 !litter field capacity (m3/m3)
+!
!-------------------------------------------------------------------------------
!
END MODULE MODD_MEB_PAR
diff --git a/src/SURFEX/mode_meb.F90 b/src/SURFEX/mode_meb.F90
index 8665dd58adc64845058437da69ace5fc47b5db6f..68bb4fa2f29a69118ba992ad2c369f96e8ebba9e 100644
--- a/src/SURFEX/mode_meb.F90
+++ b/src/SURFEX/mode_meb.F90
@@ -32,6 +32,7 @@
!! MODIFICATIONS
!! -------------
!! Original 18/01/11
+!! 13/09/18 Added litter thermal computations here
!-----------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -68,11 +69,224 @@ INTERFACE MEB_SHIELD_FACTOR
MODULE PROCEDURE MEB_SHIELD_FACTOR_0D
END INTERFACE
!
+INTERFACE MEBLITTER_THRM
+ MODULE PROCEDURE MEBLITTER_THRM_2D
+ MODULE PROCEDURE MEBLITTER_THRM_1D
+ MODULE PROCEDURE MEBLITTER_THRM_0D
+END INTERFACE
+!
!-------------------------------------------------------------------------------
CONTAINS
!
!####################################################################
!####################################################################
+!####################################################################
+ SUBROUTINE MEBLITTER_THRM_2D(PWRL,PWRLI,PGNDLITTER,PHCAP,PCOND)
+!
+!! PURPOSE
+!! -------
+! Calculation of litter thermal properties (based on Napoly et al., 2017)
+!
+!! REFERENCE
+!! ---------
+!! Napoly et al., 2017: GMD
+!!
+!! AUTHOR
+!! ------
+!!! A. Boone * Meteo-France/CNRS *
+!!!
+!! MODIFICATIONS
+!! -------------
+!! Original 13/09/18
+!
+!-----------------------------------------------------------------------------
+!
+USE MODD_MEB_PAR, ONLY : XLITTER_THRM_Z1, XLITTER_THRM_Z2, &
+ XLITTER_THRM_Z3
+USE MODD_ISBA_PAR, ONLY : XOMSPH
+USE MODD_CSTS, ONLY : XRHOLW, XRHOLI, XCI, XCL
+
+
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PWRL, PWRLI, PGNDLITTER
+! PWRL = litter liquid water content (kg/m2)
+! PWRLI = litter liquid water equivalent ice content (kg/m2)
+! PGNDLITTER = litter layer thickness (m)
+!
+REAL, DIMENSION(:,:), INTENT(OUT) :: PHCAP, PCOND
+! PHCAP = litter heat capacity [J/(m3 K)]
+! PCOND = litter thermal conductivity [W/(m K)]
+!
+!* 0.2 declaration of local variables
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+REAL, DIMENSION(SIZE(PGNDLITTER,1),SIZE(PGNDLITTER,2)) :: ZWORK
+!
+!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('MODE_MEB:MEBLITTER_THRM_2D',0,ZHOOK_HANDLE)
+!
+ZWORK(:,:) = PWRL(:,:)/(XRHOLW*PGNDLITTER(:,:))
+!
+! Litter heat capacity:
+!
+PHCAP(:,:) = XOMSPH*XLITTER_THRM_Z1 + ( (XCL*XRHOLW)*ZWORK(:,:) + &
+ (XCI*XRHOLI/XRHOLW)*PWRLI(:,:)/PGNDLITTER(:,:) )
+!
+! Litter thermal conductivity:
+!
+PCOND(:,:) = XLITTER_THRM_Z2 + ( XLITTER_THRM_Z3 * ZWORK(:,:) )
+!
+IF (LHOOK) CALL DR_HOOK('MODE_MEB:MEBLITTER_THRM_2D',1,ZHOOK_HANDLE)
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE MEBLITTER_THRM_2D
+!####################################################################
+!####################################################################
+!####################################################################
+ SUBROUTINE MEBLITTER_THRM_1D(PWRL,PWRLI,PGNDLITTER,PHCAP,PCOND)
+!
+!! PURPOSE
+!! -------
+! Calculation of litter thermal properties (based on Napoly et al., 2017)
+!
+!! REFERENCE
+!! ---------
+!! Napoly et al., 2017: GMD
+!!
+!! AUTHOR
+!! ------
+!!! A. Boone * Meteo-France/CNRS *
+!!!
+!! MODIFICATIONS
+!! -------------
+!! Original 13/09/18
+!
+!-----------------------------------------------------------------------------
+!
+USE MODD_MEB_PAR, ONLY : XLITTER_THRM_Z1, XLITTER_THRM_Z2, &
+ XLITTER_THRM_Z3
+USE MODD_ISBA_PAR, ONLY : XOMSPH
+USE MODD_CSTS, ONLY : XRHOLW, XRHOLI, XCI, XCL
+
+
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+REAL, DIMENSION(:), INTENT(IN) :: PWRL, PWRLI, PGNDLITTER
+! PWRL = litter liquid water content (kg/m2)
+! PWRLI = litter liquid water equivalent ice content (kg/m2)
+! PGNDLITTER = litter layer thickness (m)
+!
+REAL, DIMENSION(:), INTENT(OUT) :: PHCAP, PCOND
+! PHCAP = litter heat capacity [J/(m3 K)]
+! PCOND = litter thermal conductivity [W/(m K)]
+!
+!* 0.2 declaration of local variables
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+REAL, DIMENSION(SIZE(PGNDLITTER)) :: ZWORK
+!
+!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('MODE_MEB:MEBLITTER_THRM_1D',0,ZHOOK_HANDLE)
+!
+ZWORK(:) = PWRL(:)/(XRHOLW*PGNDLITTER(:))
+!
+! Litter heat capacity:
+!
+PHCAP(:) = XOMSPH*XLITTER_THRM_Z1 + ( (XCL*XRHOLW)*ZWORK(:) + &
+ (XCI*XRHOLI/XRHOLW)*PWRLI(:)/PGNDLITTER(:) )
+!
+! Litter thermal conductivity:
+!
+PCOND(:) = XLITTER_THRM_Z2 + ( XLITTER_THRM_Z3 * ZWORK(:) )
+!
+IF (LHOOK) CALL DR_HOOK('MODE_MEB:MEBLITTER_THRM_1D',1,ZHOOK_HANDLE)
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE MEBLITTER_THRM_1D
+!####################################################################
+!####################################################################
+!####################################################################
+ SUBROUTINE MEBLITTER_THRM_0D(PWRL,PWRLI,PGNDLITTER,PHCAP,PCOND)
+!
+!! PURPOSE
+!! -------
+! Calculation of litter thermal properties (based on Napoly et al., 2017)
+!
+!! REFERENCE
+!! ---------
+!! Napoly et al., 2017: GMD
+!!
+!! AUTHOR
+!! ------
+!!! A. Boone * Meteo-France/CNRS *
+!!!
+!! MODIFICATIONS
+!! -------------
+!! Original 13/09/18
+!
+!-----------------------------------------------------------------------------
+!
+USE MODD_MEB_PAR, ONLY : XLITTER_THRM_Z1, XLITTER_THRM_Z2, &
+ XLITTER_THRM_Z3
+USE MODD_ISBA_PAR, ONLY : XOMSPH
+USE MODD_CSTS, ONLY : XRHOLW, XRHOLI, XCI, XCL
+
+
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+REAL, INTENT(IN) :: PWRL, PWRLI, PGNDLITTER
+! PWRL = litter liquid water content (kg/m2)
+! PWRLI = litter liquid water equivalent ice content (kg/m2)
+! PGNDLITTER = litter layer thickness (m)
+!
+REAL, INTENT(OUT) :: PHCAP, PCOND
+! PHCAP = litter heat capacity [J/(m3 K)]
+! PCOND = litter thermal conductivity [W/(m K)]
+!
+!* 0.2 declaration of local variables
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+REAL :: ZWORK
+!
+!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('MODE_MEB:MEBLITTER_THRM_0D',0,ZHOOK_HANDLE)
+!
+ZWORK = PWRL/(XRHOLW*PGNDLITTER)
+!
+! Litter heat capacity:
+!
+PHCAP = XOMSPH*XLITTER_THRM_Z1 + (XCL*XRHOLW)*ZWORK + &
+ (XCI*XRHOLI/XRHOLW)*PWRLI/PGNDLITTER
+!
+! Litter thermal conductivity:
+!
+PCOND = XLITTER_THRM_Z2 + XLITTER_THRM_Z3 * ZWORK
+!
+IF (LHOOK) CALL DR_HOOK('MODE_MEB:MEBLITTER_THRM_0D',1,ZHOOK_HANDLE)
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE MEBLITTER_THRM_0D
+!####################################################################
+!####################################################################
!####################################################################
FUNCTION MEBPALPHAN_3D(PSNOWDEPTH,PH_VEG) RESULT(PPALPHAN)
!
diff --git a/src/SURFEX/prep_snow_extern.F90 b/src/SURFEX/prep_snow_extern.F90
index 43f669649b1f9b1dc3daab7b746c7ca1e2183104..8b69ea59c204364ce632b6e9b90efe18dc85de10 100644
--- a/src/SURFEX/prep_snow_extern.F90
+++ b/src/SURFEX/prep_snow_extern.F90
@@ -151,6 +151,12 @@ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'FULL ')
CALL READ_SURF(HFILEPGDTYPE,'VERSION',IVERSION_PGD,IRESP,HDIR='-')
CALL READ_SURF(HFILEPGDTYPE,'BUG',IBUGFIX_PGD,IRESP,HDIR='-')
GOLD_NAME=(IVERSION_PGD<7 .OR. (IVERSION_PGD==7 .AND. IBUGFIX_PGD<3))
+!
+!
+!-------------------------------------------------------------------------------------
+!
+!* 2. Reading of grid
+! ---------------
!
CALL PREP_GRID_EXTERN(GCP,HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
!
@@ -160,6 +166,8 @@ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
!
CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,YMASK)
!
+IF (NRANK/=NPIO) INI = 0
+!
ALLOCATE(ZMASK(INI))
IF (IVERSION_PGD>=7) THEN
IF (YAREA(1:4)=='VEG ') THEN
@@ -199,13 +207,6 @@ END IF
!
!-------------------------------------------------------------------------------------
!
-!* 2. Reading of grid
-! ---------------
-!
-IF (NRANK/=NPIO) INI = 0
-!
-!-------------------------------------------------------------------------------------
-!
!* 4. Reading of snow data
! ---------------------
!
@@ -242,6 +243,7 @@ DO JP = 1,IPATCH
IF (NRANK==NPIO) THEN
!
SELECT CASE (HSURF(1:3))
+
CASE ('WWW')
IF (OSNOW_IDEAL) THEN
IF (JP<=1) ALLOCATE(PFIELD(INI,KLAYER,IPATCH))
@@ -260,125 +262,132 @@ DO JP = 1,IPATCH
!* 6. Albedo
! ------
!
- CASE ('ALB')
- IF (JP<=1) ALLOCATE(PFIELD(INI,1,IPATCH))
- PFIELD(:,1,JP) = TZSNOW%ALB(:)
+ CASE ('ALB')
+ IF (JP<=1) ALLOCATE(PFIELD(INI,1,IPATCH))
+ PFIELD(:,1,JP) = TZSNOW%ALB(:)
!
!-------------------------------------------------------------------------------------
!
!* 7. Total depth to snow grid
! ------------------------
!
- CASE ('DEP')
- IF (OSNOW_IDEAL) THEN
- IF (JP<=1) ALLOCATE(PFIELD(INI,KLAYER,IPATCH))
- PFIELD(:,:,JP) = TZSNOW%WSNOW(:,1:KLAYER)/TZSNOW%RHO(:,1:KLAYER)
- WHERE(TZSNOW%WSNOW(:,1:KLAYER)==XUNDEF) PFIELD(:,:,JP)=XUNDEF
- ELSE
- ALLOCATE(ZD(INI))
- ZD(:) = 0.0
- DO JL=1,TZSNOW%NLAYER
- WHERE (TZSNOW%WSNOW(:,JL)/=XUNDEF)
- ZD(:) = ZD(:) + TZSNOW%WSNOW(:,JL)/TZSNOW%RHO(:,JL)
- ENDWHERE
- END DO
- IF (JP<=1) ALLOCATE(PFIELD(INI,1,IPATCH))
- PFIELD(:,1,JP) = ZD(:)
- DEALLOCATE(ZD)
- ENDIF
+ CASE ('DEP')
+ IF (OSNOW_IDEAL) THEN
+ IF (JP<=1) ALLOCATE(PFIELD(INI,KLAYER,IPATCH))
+ PFIELD(:,:,JP) = TZSNOW%WSNOW(:,1:KLAYER)/TZSNOW%RHO(:,1:KLAYER)
+ WHERE(TZSNOW%WSNOW(:,1:KLAYER)==XUNDEF) PFIELD(:,:,JP)=XUNDEF
+ ELSE
+ ALLOCATE(ZD(INI))
+ ZD(:) = 0.0
+ DO JL=1,TZSNOW%NLAYER
+ WHERE (TZSNOW%WSNOW(:,JL)/=XUNDEF)
+ ZD(:) = ZD(:) + TZSNOW%WSNOW(:,JL)/TZSNOW%RHO(:,JL)
+ ENDWHERE
+ END DO
+ IF (JP<=1) ALLOCATE(PFIELD(INI,1,IPATCH))
+ PFIELD(:,1,JP) = ZD(:)
+ DEALLOCATE(ZD)
+ ENDIF
!
!-------------------------------------------------------------------------------------
!
!* 8. Density or heat profile
! -----------------------
!
- CASE ('RHO','HEA','SG1','SG2','HIS','AGE')
+ CASE ('RHO','HEA','SG1','SG2','HIS','AGE')
!
- SELECT CASE (TZSNOW%SCHEME)
- CASE ('D95','1-L','EBA')
- IF (JP<=1) ALLOCATE(PFIELD(INI,1,IPATCH))
- !* computes output physical variable
- IF (HSURF(1:3)=='RHO') PFIELD(:,1,JP) = TZSNOW%RHO(:,1)
- IF (HSURF(1:3)=='HEA') THEN
- IF (TZSNOW%SCHEME=='D95'.OR.TZSNOW%SCHEME=='EBA') PFIELD(:,1,JP) = XTT-2.
- IF (TZSNOW%SCHEME=='1-L') PFIELD(:,1,JP) = TZSNOW%T(:,1)
- END IF
- IF (HSURF(1:3)=='SG1') PFIELD(:,1,JP) = -20.0
- IF (HSURF(1:3)=='SG2') PFIELD(:,1,JP) = 80.0
- IF (HSURF(1:3)=='HIS') PFIELD(:,1,JP) = 0.0
- IF (HSURF(1:3)=='AGE') PFIELD(:,1,JP) = 3.0
+ SELECT CASE (TZSNOW%SCHEME)
- CASE ('3-L','CRO')
- ALLOCATE(ZFIELD(INI,TZSNOW%NLAYER))
- !* input physical variable
- IF (HSURF(1:3)=='RHO') ZFIELD(:,:) = TZSNOW%RHO (:,1:TZSNOW%NLAYER)
- IF (HSURF(1:3)=='AGE') ZFIELD(:,:) = TZSNOW%AGE(:,1:TZSNOW%NLAYER)
- IF (TZSNOW%SCHEME=='CRO')THEN
- IF (HSURF(1:3)=='SG1') ZFIELD(:,:) = TZSNOW%GRAN1(:,1:TZSNOW%NLAYER)
- IF (HSURF(1:3)=='SG2') ZFIELD(:,:) = TZSNOW%GRAN2(:,1:TZSNOW%NLAYER)
- IF (HSURF(1:3)=='HIS') ZFIELD(:,:) = TZSNOW%HIST(:,1:TZSNOW%NLAYER)
- ELSE
- IF (HSURF(1:3)=='SG1') ZFIELD(:,:) = -20.0
- IF (HSURF(1:3)=='SG2') ZFIELD(:,:) = 80.0
- IF (HSURF(1:3)=='HIS') ZFIELD(:,:) = 0.0
- ENDIF
- !
- IF ( HSURF(1:3)=='HEA') THEN
- ALLOCATE(ZHEAT(INI,TZSNOW%NLAYER))
- ZHEAT(:,:) = TZSNOW%HEAT(:,1:TZSNOW%NLAYER)
- CALL SNOW_HEAT_TO_T_WLIQ(ZHEAT,TZSNOW%RHO,ZFIELD)
- WHERE (ZFIELD>XTT.AND.ZFIELD/=XUNDEF) ZFIELD = XTT
- DEALLOCATE(ZHEAT)
- ENDIF
- !
- IF (OSNOW_IDEAL) THEN
- IF (JP<=1) ALLOCATE(PFIELD(INI,KLAYER,IPATCH))
- PFIELD(:,:,JP) = ZFIELD(:,:)
- ELSE
- !
- IF (JP<=1) ALLOCATE(PFIELD(INI,NGRID_LEVEL,IPATCH))
- !* input snow layer thickness
- ALLOCATE(ZDEPTH(INI,TZSNOW%NLAYER))
- ZDEPTH(:,:) = TZSNOW%WSNOW(:,:)/TZSNOW%RHO(:,:)
+ CASE ('D95','1-L','EBA')
+ IF (JP<=1) ALLOCATE(PFIELD(INI,1,IPATCH))
+ !* computes output physical variable
+ IF (HSURF(1:3)=='RHO') PFIELD(:,1,JP) = TZSNOW%RHO(:,1)
+ IF (HSURF(1:3)=='HEA') THEN
+ IF (TZSNOW%SCHEME=='D95'.OR.TZSNOW%SCHEME=='EBA') PFIELD(:,1,JP) = XTT-2.
+ IF (TZSNOW%SCHEME=='1-L') PFIELD(:,1,JP) = TZSNOW%T(:,1)
+ END IF
+ IF (HSURF(1:3)=='SG1') PFIELD(:,1,JP) = -20.0
+ IF (HSURF(1:3)=='SG2') PFIELD(:,1,JP) = 80.0
+ IF (HSURF(1:3)=='HIS') PFIELD(:,1,JP) = 0.0
+ IF (HSURF(1:3)=='AGE') PFIELD(:,1,JP) = 3.0
+
+ CASE ('3-L','CRO')
+ ALLOCATE(ZFIELD(INI,TZSNOW%NLAYER))
+ !* input physical variable
+ IF (HSURF(1:3)=='RHO') ZFIELD(:,:) = TZSNOW%RHO (:,1:TZSNOW%NLAYER)
+ IF (HSURF(1:3)=='AGE') ZFIELD(:,:) = TZSNOW%AGE(:,1:TZSNOW%NLAYER)
+ IF (TZSNOW%SCHEME=='CRO')THEN
+ IF (HSURF(1:3)=='SG1') ZFIELD(:,:) = TZSNOW%GRAN1(:,1:TZSNOW%NLAYER)
+ IF (HSURF(1:3)=='SG2') ZFIELD(:,:) = TZSNOW%GRAN2(:,1:TZSNOW%NLAYER)
+ IF (HSURF(1:3)=='HIS') ZFIELD(:,:) = TZSNOW%HIST(:,1:TZSNOW%NLAYER)
+ ELSE
+ IF (HSURF(1:3)=='SG1') ZFIELD(:,:) = -20.0
+ IF (HSURF(1:3)=='SG2') ZFIELD(:,:) = 80.0
+ IF (HSURF(1:3)=='HIS') ZFIELD(:,:) = 0.0
+ ENDIF
!
- !* total depth
- ALLOCATE(ZD(INI))
- ZD(:) = 0.
- DO JL=1,TZSNOW%NLAYER
- ZD(:) = ZD(:) + ZDEPTH(:,JL)
- ENDDO
+ IF ( HSURF(1:3)=='HEA') THEN
+ ALLOCATE(ZHEAT(INI,TZSNOW%NLAYER))
+ ZHEAT(:,:) = TZSNOW%HEAT(:,1:TZSNOW%NLAYER)
+ CALL SNOW_HEAT_TO_T_WLIQ(ZHEAT,TZSNOW%RHO,ZFIELD)
+ WHERE (ZFIELD>XTT.AND.ZFIELD/=XUNDEF) ZFIELD = XTT
+ DEALLOCATE(ZHEAT)
+ ENDIF
!
- !* input normalized grid
- ALLOCATE(ZGRID(INI,TZSNOW%NLAYER))
- DO JI=1,INI
- IF(ZD(JI)==0.0)THEN
- DO JL = 1,TZSNOW%NLAYER
- ZGRID(JI,JL)=REAL(JL)/REAL(TZSNOW%NLAYER)
- ENDDO
- ELSE
- DO JL = 1,TZSNOW%NLAYER
- IF(JL==1)THEN
- ZGRID(JI,JL)=ZDEPTH(JI,JL)/ ZD(JI)
- ELSE
- ZGRID(JI,JL) = ZGRID(JI,JL-1) + ZDEPTH(JI,JL)/ZD(JI)
- ENDIF
- ENDDO
- ENDIF
- ENDDO
- DEALLOCATE(ZDEPTH)
- DEALLOCATE(ZD)
- !
- ! * interpolation of profile onto fine normalized snow grid
- CALL INTERP_GRID_NAT(ZGRID(:,:),ZFIELD(:,:), &
- XGRID_SNOW(:), PFIELD(:,:,JP))
- DEALLOCATE(ZGRID)
- ENDIF
- DEALLOCATE(ZFIELD)
+ IF (OSNOW_IDEAL) THEN
+
+ IF (JP<=1) ALLOCATE(PFIELD(INI,KLAYER,IPATCH))
+ PFIELD(:,:,JP) = ZFIELD(:,:)
+
+ ELSE
+ !
+ IF (JP<=1) ALLOCATE(PFIELD(INI,NGRID_LEVEL,IPATCH))
+ !* input snow layer thickness
+ ALLOCATE(ZDEPTH(INI,TZSNOW%NLAYER))
+ ZDEPTH(:,:) = TZSNOW%WSNOW(:,:)/TZSNOW%RHO(:,:)
+ !
+ !* total depth
+ ALLOCATE(ZD(INI))
+ ZD(:) = 0.
+ DO JL=1,TZSNOW%NLAYER
+ ZD(:) = ZD(:) + ZDEPTH(:,JL)
+ ENDDO
+ !
+ !* input normalized grid
+ ALLOCATE(ZGRID(INI,TZSNOW%NLAYER))
+ DO JI=1,INI
+ IF(ZD(JI)==0.0)THEN
+ DO JL = 1,TZSNOW%NLAYER
+ ZGRID(JI,JL)=REAL(JL)/REAL(TZSNOW%NLAYER)
+ ENDDO
+ ELSE
+ DO JL = 1,TZSNOW%NLAYER
+ IF(JL==1)THEN
+ ZGRID(JI,JL)=ZDEPTH(JI,JL)/ ZD(JI)
+ ELSE
+ ZGRID(JI,JL) = ZGRID(JI,JL-1) + ZDEPTH(JI,JL)/ZD(JI)
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDDO
+ DEALLOCATE(ZDEPTH)
+ DEALLOCATE(ZD)
+ !
+ ! * interpolation of profile onto fine normalized snow grid
+ CALL INTERP_GRID_NAT(ZGRID(:,:),ZFIELD(:,:),XGRID_SNOW(:), PFIELD(:,:,JP))
+ DEALLOCATE(ZGRID)
+
+ ENDIF
+ DEALLOCATE(ZFIELD)
END SELECT
- !* put field form patch to all vegtypes
+ !* put field form patch to all vegtypes
END SELECT
!
+ ELSE
+ !
+ ALLOCATE(PFIELD(0,0,0))
+ !
ENDIF
!
CALL DEALLOC_GR_SNOW(TZSNOW)
diff --git a/src/SURFEX/prep_teb_extern.F90 b/src/SURFEX/prep_teb_extern.F90
index 99da5d3b121432fde259094d8ef90ff349ad0d5a..bdcacd7a4eb6e38644e19fa4f4dcc748e420039f 100644
--- a/src/SURFEX/prep_teb_extern.F90
+++ b/src/SURFEX/prep_teb_extern.F90
@@ -128,8 +128,12 @@ IF (NRANK/=NPIO) INI = 0
CALL TOWN_PRESENCE(HFILEPGDTYPE,GTEB,HDIR='-')
!
ALLOCATE(ZMASK(INI))
-IF (IVERSION_PGD>=7.AND.GTEB) THEN
- YRECFM='FRAC_TOWN'
+IF (IVERSION_PGD>=7) THEN
+ IF (GTEB) THEN
+ YRECFM='FRAC_TOWN'
+ ELSE
+ YRECFM='FRAC_NATURE'
+ END IF
CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZMASK,IRESP,HDIR='A')
ELSE
ZMASK(:) = 1.
diff --git a/src/SURFEX/read_gr_snow.F90 b/src/SURFEX/read_gr_snow.F90
index c0d6330bc8e8ecffe1645ca6c257aeecc336a1bc..19e93845761813b7738bb2fe14425b0b11c8fc7c 100644
--- a/src/SURFEX/read_gr_snow.F90
+++ b/src/SURFEX/read_gr_snow.F90
@@ -135,7 +135,7 @@ GVERSION = (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3)
! -------------------
!
ISURFTYPE_LEN=LEN_TRIM(HSURFTYPE)
-!
+!
IF (KPATCH<=1) THEN
IF (IVERSION <=2 .OR. (IVERSION==3 .AND. IBUGFIX<=4)) THEN
@@ -225,8 +225,8 @@ IF (IVERSION >= 7 .AND. HSURFTYPE=='VEG'.AND.KPATCH==1) &
!-------------------------------------------------------------------------------
!
!
-!* 5. Snow reservoir
-! --------------
+!* 5. Snow reservoir and Snow density
+! -------------------------------
!
ALLOCATE(ZWORK(KLU,INPATCH))
!
@@ -243,7 +243,7 @@ IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' &
CALL READ_LAYERS(GVERSION,TPSNOW%NLAYER,YDIR,HPREFIX,YFMT,"WSNOW",HSURFTYPE,TPSNOW%WSNOW)
CALL READ_LAYERS(GVERSION,TPSNOW%NLAYER,YDIR,HPREFIX,YFMT,"RSNOW",HSURFTYPE,TPSNOW%RHO)
!
- !* 7. Snow temperature
+ !* 6. Snow temperature
! ----------------
!
IF (TPSNOW%SCHEME=='1-L') THEN
@@ -252,19 +252,23 @@ IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' &
!
ENDIF
!
- !* 8. Heat content
+ !* 7. Heat content
! ------------
!
IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN
!
CALL READ_LAYERS(GVERSION,TPSNOW%NLAYER,YDIR,HPREFIX,YFMT,"HSNOW",HSURFTYPE,TPSNOW%HEAT)
!
+ !
+ !* 8. Historical parameter
+ ! -------------------
+
IF (TPSNOW%SCHEME=='CRO') THEN
!
CALL READ_LAYERS(GVERSION,TPSNOW%NLAYER,YDIR,HPREFIX,YFMT,"SHIST",HSURFTYPE,TPSNOW%HIST)
!
- !* 9. Snow Gran1
- ! ------------
+ !* 9. Snow Gran1 and Snow Gran2
+ ! ----------------------------
!
IF (GVERSION) THEN
YFMT = "(A2,A1"//YFMT0//')'
@@ -277,10 +281,10 @@ IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' &
!
ENDIF
!
+ !* 10. Age parameter
+ ! -------------------
+ !
IF ((TPSNOW%SCHEME=='3-L'.AND.IVERSION>=8) .OR. TPSNOW%SCHEME=='CRO') THEN
- !* 12. Age parameter
- ! -------------------
- !
IF (GVERSION) THEN
YFMT = "(A3"//YFMT0//')'
ELSE
@@ -303,8 +307,15 @@ IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' &
!
ENDIF
!
- WRITE(YFMT,'(A5,I1,A2,I1,A1)') '(A4,A',ISURFTYPE_LEN,',A',IPAT_LEN,')'
- WRITE(YRECFM,YFMT) 'ASN_',ADJUSTL(HSURFTYPE(:LEN_TRIM(HSURFTYPE))),ADJUSTL(YPAT)
+ !* 11. Albedo
+ ! --------
+ IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
+ WRITE(YFMT,'(A5,I1,A2,I1,A1)') '(A6,A',ISURFTYPE_LEN,',A',IPAT_LEN,')'
+ WRITE(YRECFM,YFMT) 'ASNOW_',ADJUSTL(HSURFTYPE(:LEN_TRIM(HSURFTYPE))),ADJUSTL(YPAT)
+ ELSE
+ WRITE(YFMT,'(A5,I1,A2,I1,A1)') '(A4,A',ISURFTYPE_LEN,',A',IPAT_LEN,')'
+ WRITE(YRECFM,YFMT) 'ASN_',ADJUSTL(HSURFTYPE(:LEN_TRIM(HSURFTYPE))),ADJUSTL(YPAT)
+ ENDIF
IF (GVERSION) YRECFM=ADJUSTL(HPREFIX//YRECFM)
IF (GDIM2) THEN
CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,1),IRESP,HDIR=YDIR)
@@ -313,7 +324,6 @@ IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' &
CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HDIR=YDIR)
CALL PACK_SAME_RANK(KMASK_P,ZWORK(:,MAX(1,KPATCH)),TPSNOW%ALB(:))
ENDIF
-! IF (KLU>0) print*,YRECFM,minval(TPSNOW%ALB(:)),maxval(TPSNOW%ALB(:))
!
ENDIF
!
diff --git a/src/SURFEX/read_isban.F90 b/src/SURFEX/read_isban.F90
index 8af417896027ac21554691310abaf94ea52071fe..a25ae69149f430380a601e404c5603dc7918f596 100644
--- a/src/SURFEX/read_isban.F90
+++ b/src/SURFEX/read_isban.F90
@@ -679,7 +679,7 @@ IF (IO%CRESPSL=='CNT') THEN
YRECFM='LIGN_STR'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YRECFM, ZWORK)
DO JP = 1,IO%NPATCH
- CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NPE%AL(JP)%XSOILCARB(:,JNLITTLEVS))
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NPE%AL(JP)%XLIGNIN_STRUC(:,JNLITTLEVS))
ENDDO
END DO
!
diff --git a/src/SURFEX/read_nam_pgd_isba.F90 b/src/SURFEX/read_nam_pgd_isba.F90
index 85b23f284ab955d6b17bbfc4dabb3891e2cbd93d..9b90444d55c9adcb49c0f0fe30a26b954ff204a5 100644
--- a/src/SURFEX/read_nam_pgd_isba.F90
+++ b/src/SURFEX/read_nam_pgd_isba.F90
@@ -234,7 +234,7 @@ YPERMFILETYPE = ' '
YRUNOFFBFILETYPE = ' '
YWDRAINFILETYPE = ' '
YPHFILETYPE = ' '
-YPHFILETYPE = ' '
+YFERTFILETYPE = ' '
!
LIMP_CLAY = .FALSE.
LIMP_SAND = .FALSE.
diff --git a/src/SURFEX/read_nam_pgd_isba_meb.F90 b/src/SURFEX/read_nam_pgd_isba_meb.F90
index 0cf00afaa9e7b9450dfb1548b237f8d0fdf297bc..7ccdfd3ea17cb8dc10c3d0300842d186d78f2e0a 100644
--- a/src/SURFEX/read_nam_pgd_isba_meb.F90
+++ b/src/SURFEX/read_nam_pgd_isba_meb.F90
@@ -43,7 +43,7 @@
USE MODI_OPEN_NAMELIST
USE MODI_CLOSE_NAMELIST
!
-USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE_ECOSG
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
!
USE MODE_POS_SURF
!
@@ -75,7 +75,7 @@ LOGICAL :: GFOUND ! flag when namelist is present
!* 0.3 Declaration of namelists
! ------------------------
!
-LOGICAL, DIMENSION(NVEGTYPE_ECOSG) :: LMEB_PATCH
+LOGICAL, DIMENSION(NVEGTYPE) :: LMEB_PATCH
LOGICAL :: LFORC_MEASURE
LOGICAL :: LMEB_LITTER
LOGICAL :: LMEB_GNDRES
diff --git a/src/SURFEX/read_pgd_isba_parn.F90 b/src/SURFEX/read_pgd_isba_parn.F90
index a54f1248d00e74112b5c94eaab5512336259f4ec..9926e7698acfecef17758b18dd9c14654fb37e2f 100644
--- a/src/SURFEX/read_pgd_isba_parn.F90
+++ b/src/SURFEX/read_pgd_isba_parn.F90
@@ -496,15 +496,17 @@ IF (.NOT.OLAND_USE) THEN
ENDIF
ENDIF
GTIME(:) = .FALSE.
- DO JT = 1,SIZE(GTIME)
- IF (JT_BEG==JT_END .AND. TPDATE_END%YEAR==TPDATE_BEG%YEAR+1) THEN
- GTIME(JT) = .TRUE.
- ELSEIF (JT_BEG<=JT_END .AND. JT>=JT_BEG .AND. JT<=JT_END) THEN
- GTIME(JT) = .TRUE.
- ELSEIF (JT_BEG>JT_END .AND. (JT>=JT_BEG .OR. JT<=JT_END)) THEN
- GTIME(JT) = .TRUE.
- ENDIF
- ENDDO
+ IF (TPDATE_END%YEAR>=TPDATE_BEG%YEAR+2) THEN ! if the run contains one whole year
+ GTIME(:) = .TRUE. ! all periods must be read
+ ELSEIF (TPDATE_END%YEAR==TPDATE_BEG%YEAR+1) THEN ! if the run passes one year
+ DO JT = 1,SIZE(GTIME)
+ IF (JT>=JT_BEG .OR. JT<=JT_END) GTIME(JT) = .TRUE. ! all periods after JT_BEG and before JT_END are read
+ ENDDO
+ ELSE ! if the run stays in one only year
+ DO JT = 1,SIZE(GTIME)
+ IF (JT>=JT_BEG .AND. JT<=JT_END) GTIME(JT) = .TRUE. ! all periods between JT_BEG and JT_END are read
+ ENDDO
+ ENDIF
!
!
IF (DTI%LDATA_VEGTYPE) THEN
diff --git a/src/SURFEX/snow3l.F90 b/src/SURFEX/snow3l.F90
index 938ae4091ff2ece19d9bd85c4a8893e066237dcc..6d6771c3fd9944015b2b56019e195974d76f3199 100644
--- a/src/SURFEX/snow3l.F90
+++ b/src/SURFEX/snow3l.F90
@@ -545,7 +545,7 @@ ZSNOWTEMPO1(:) = ZSNOWTEMP(:,1) ! save surface snow temperature before update
!
ZGRNDFLUXI(:) = ZGRNDFLUX(:)
!
- CALL SNOW3LSOLVT(OMEB,PTSTEP,XSNOWDZMIN,PSNOWDZ,ZSCOND,ZSCAP,PTG, &
+CALL SNOW3LSOLVT(OMEB,PTSTEP,XSNOWDZMIN,PSNOWDZ,ZSCOND,ZSCAP,PTG, &
PSOILCOND,PD_G,ZRADSINK,ZCT,ZTSTERM1,ZTSTERM2, &
ZPET_A_COEF_T,ZPEQ_A_COEF_T,ZPET_B_COEF_T,ZPEQ_B_COEF_T, &
ZTA_IC,ZQA_IC,ZGRNDFLUX,ZGRNDFLUXO,ZSNOWTEMP,PSNOWFLUX )
@@ -1117,8 +1117,8 @@ IF(OMEB)THEN
! Diagnose surface layer coef (should be very close/identical to ZCOEF(:,1) computed above)
- ZCOEF(:,1) = 1.0 - PSWNETSNOWS(:)/MAX(1.E-4,PSWNETSNOW(:))
-
+ ZCOEF(:,1) = (PSWNETSNOW(:)-PSWNETSNOWS(:))/MAX(1.E-4,PSW_RAD(:))
+
ELSE
! Consider 3 bands:
diff --git a/src/SURFEX/treat_field.F90 b/src/SURFEX/treat_field.F90
index 8e52f043d0a8c12454420a3a61894a7ce9f2c90f..b2d01b9aa52903e69c9aadd2e24f19f2ac29707a 100644
--- a/src/SURFEX/treat_field.F90
+++ b/src/SURFEX/treat_field.F90
@@ -491,7 +491,7 @@ SELECT CASE (HSUBROUTINE)
ELSE
- ALLOCATE(XSUMVAL(U%NSIZE_FULL,1))
+ ALLOCATE(XSUMVAL(U%NSIZE_FULL,SIZE(NSIZE,2)))
IF (HFILETYPE=='DIRECT' .AND. NPROC>1) THEN
CALL ABOR1_SFX("TREAT_FIELD: MAJ is not possible with DIRECT filetype and NPROC>1")
ELSE
diff --git a/src/SURFEX/write_diag_pgd_isban.F90 b/src/SURFEX/write_diag_pgd_isban.F90
index 70928be6bcfd4929fbbbf754e283a5bfbe6b4e7a..96417bb19f3c71c32751e2ec36ab05c108c3f79f 100644
--- a/src/SURFEX/write_diag_pgd_isban.F90
+++ b/src/SURFEX/write_diag_pgd_isban.F90
@@ -299,9 +299,9 @@ IF(IO%CISBA=='DIF')THEN
!* Root fraction for each patch
!
ALLOCATE(ZWORK1(ILU))
- DO JP = 1,IO%NPATCH
- PK => NP%AL(JP)
- DO JL=1,SIZE(PK%XROOTFRAC,2)
+ DO JL=1,SIZE(PK%XROOTFRAC,2)
+ DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
IF (JL<10) THEN
WRITE(YRECFM,FMT='(A8,I1)') 'ROOTFRAC',JL
ELSE
diff --git a/src/SURFEX/write_field_1d_patch.F90 b/src/SURFEX/write_field_1d_patch.F90
index 2907ca95fbde04fab4b0d09c58ee902d832ee090..b398135ba5fb11c7ebca37617dad971b84b957ae 100644
--- a/src/SURFEX/write_field_1d_patch.F90
+++ b/src/SURFEX/write_field_1d_patch.F90
@@ -29,7 +29,7 @@ REAL, DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: PWORK_WR
REAL, DIMENSION(KSIZE,1) :: ZWORK
CHARACTER(LEN=LEN_HREC) :: YRECFM
CHARACTER(LEN=2) :: YPAT
-INTEGER :: IRESP
+INTEGER :: IRESP, ILEN
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('WRITE_FIELD_1D_PATCH',0,ZHOOK_HANDLE)
@@ -47,6 +47,8 @@ IF (LSPLIT_PATCH) THEN
!
ELSE
!
+ ILEN = LEN_TRIM(YRECFM)
+ IF (YRECFM(ILEN:ILEN)=="_") YRECFM = ADJUSTL(YRECFM(:LEN_TRIM(YRECFM)))//'P'
IF (KP/=0) THEN
PWORK_WR(:,KP) = ZWORK(:,1)
IF ( KP==SIZE(PWORK_WR,2) ) THEN
diff --git a/src/SURFEX/write_field_2d_patch.F90 b/src/SURFEX/write_field_2d_patch.F90
index f296a11cd0f930e9a90ba39ee54f90f5130b5cf6..830ff1a9a2742a6bb2485dc7913bcaa07fa1cd1a 100644
--- a/src/SURFEX/write_field_2d_patch.F90
+++ b/src/SURFEX/write_field_2d_patch.F90
@@ -33,7 +33,7 @@ REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PWORK_WR
REAL, DIMENSION(KSIZE,SIZE(PFIELD_IN,2)) :: ZWORK
CHARACTER(LEN=LEN_HREC) :: YRECFM
CHARACTER(LEN=2) :: YPAT
-INTEGER :: IRESP
+INTEGER :: IRESP, ILEN
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('WRITE_FIELD_2D_PATCH',0,ZHOOK_HANDLE)
@@ -51,6 +51,8 @@ IF (LSPLIT_PATCH) THEN
!
ELSE
!
+ ILEN = LEN_TRIM(YRECFM)
+ IF (YRECFM(ILEN:ILEN)=="_") YRECFM = ADJUSTL(YRECFM(:LEN_TRIM(YRECFM)))//'P'
IF (KP/=0) THEN
PWORK_WR(:,:,KP) = ZWORK(:,:)
IF ( KP==SIZE(PWORK_WR,3) ) THEN
diff --git a/src/SURFEX/zoom_pgd_surf_atm.F90 b/src/SURFEX/zoom_pgd_surf_atm.F90
index c3be1abc61fb729cc36f1071175c6e3a83ac6bed..7d82452cce2b3e3430c0cbdd9021c77b1a670737 100644
--- a/src/SURFEX/zoom_pgd_surf_atm.F90
+++ b/src/SURFEX/zoom_pgd_surf_atm.F90
@@ -112,6 +112,7 @@ IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_SURF_ATM',0,ZHOOK_HANDLE)
CALL READ_SURF(HINIFILETYPE,'NATURE',YSC%U%CNATURE,IRESP)
CALL READ_SURF(HINIFILETYPE,'WATER', YSC%U%CWATER, IRESP)
CALL READ_SURF(HINIFILETYPE,'TOWN', YSC%U%CTOWN, IRESP)
+ CALL READ_SURF(HINIFILETYPE,'ECOSG', YSC%U%LECOSG, IRESP)
CALL READ_COVER_GARDEN(HINIFILETYPE,YSC%U%LGARDEN)
CALL INIT_READ_DATA_COVER(HPROGRAM)
CALL INI_DATA_COVER(YSC%DTCO, YSC%U)
diff --git a/src/configure b/src/configure
index fd3e433cb9c4837b0996769c0d68120b0417dfb6..9c617901170e15571a6073f9ab6b228ff0c650c9 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 VERSION_ECRAD=${VERSION_ECRAD:-"1.4.0"}
+export VER_ECRAD=${VERSION_ECRAD//./}
export LEN_HREC=${LEN_HREC:-16}
@@ -54,6 +53,7 @@ case "$TARG" in
export VER_CDF=${VER_CDF:-CDFAUTO}
export MNHENV=${MNHENV:-"
module purge
+module load cmake/3.18.0
module load intel-compilers/19.1.3
module load intel-mpi/2019.9
ulimit -s unlimited
@@ -73,6 +73,7 @@ conda activate climate_science
export MNHENV=${MNHENV:-"
ulimit -s unlimited
module purge
+module load cmake/3.16.1
module load intel/19.4 intelmpi/2019.4.243
export SLURM_CPU_BIND=none
export I_MPI_PIN_PROCESSOR_LIST=all:map=spread
@@ -135,8 +136,9 @@ module load ncl_ncarg/6.3.0
export VER_CDF=${VER_CDF:-CDFAUTO}
export MNHENV=${MNHENV:-"
module purge
-module load intel/18.0.3.222
-module load mpi/openmpi/2.0.4
+module load cmake/3.18.1
+module load intel/19.0.5.281
+module load mpi/openmpi/4.0.2
export SLURM_CPU_BIND=none
"}
;;
@@ -150,6 +152,7 @@ export SLURM_CPU_BIND=none
export VERSION_XYZ="${VERSION_XYZ}-AMD"
export MNHENV=${MNHENV:-"
module purge
+module load cmake/3.18.1
module load intel/19.0.5.281
module load mpi/openmpi/4.0.2
export SLURM_CPU_BIND=none
@@ -175,6 +178,7 @@ export ARMCI_SHR_BUF_METHOD=COPY
export NEED_TOOLS=YES
export MNHENV=${MNHENV:-"
module purge
+module load python/3.7.6
module load intel/2019.5.281
module load openmpi/intel/4.0.2.2
module load cmake/3.15.4
@@ -384,6 +388,7 @@ export I_MPI_PIN_PROCESSOR_LIST=all:map=spread
export VER_CDF=${VER_CDF:-CDFAUTO}
export MNHENV=${MNHENV:-"
module purge
+module load cmake/3.13.0
module load intel/20.0.015 intelmpi/20.0.015
export SLURM_CPU_BIND=none
export I_MPI_PIN_PROCESSOR_LIST=all:map=spread
@@ -500,7 +505,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
@@ -560,6 +565,12 @@ if [ "x${MNH_GRIBAPI}" == "xyes" ] ; then
else
( cd $LOCAL/src/LIB ; [ ! -d eccodes-${VERSION_ECCODES}-Source ] && [ -f eccodes-${VERSION_ECCODES}-Source.tar.gz ] && gunzip -c eccodes-${VERSION_ECCODES}-Source.tar.gz |tar -xvf - )
fi
+#
+# Install ECRAD 1.4.0 if MNH_ECRAD=1 & VERSION_ECRAD=1.4.0
+#
+if [ "x${MNH_ECRAD}" == "x1" ] && [ "x${VERSION_ECRAD}" == "x1.4.0" ] ; then
+( cd $LOCAL/src/LIB/RAD ; [ ! -d ecrad-1.4.0 ] && tar xvfz ecrad-1.4.0.tar.gz )
+fi
##########################################################
# #
# RESUME #